1 (* Title: Interpret/lucas-interpreter.sml
2 Author: Walther Neuper 2019
3 (c) due to copyright terms
6 signature COMPUTER_ALGEBRA_SYSTEM_COMMAND =
9 val input : term -> (Ctree.ctree * SpecificationC.T) option
10 val is_from: TermC.as_string -> Formalise.T -> bool
12 val input_: References.T -> (term * term list) list ->
13 Problem.id * I_Model.T * MethodC.id * I_Model.T * Pre_Conds.T * Proof.context
15 val dtss2itm_: Model_Pattern.T -> term * term list ->
16 int list * bool * string * I_Model.feedback (*I_Model.single'*)
17 val flattup2: 'a * ('b * 'c * 'd * 'e) -> 'a * 'b * 'c * 'd * 'e
22 structure CAS_Cmd(**): COMPUTER_ALGEBRA_SYSTEM_COMMAND(**) =
26 type T = CAS_Def.T; (*(term * (References_Def.T * generate_fn))*)
28 fun dtss2itm_ model (d, ts) =
30 val (f, (d, id)) = the (find_first ((curry op= d) o
31 (#1: (term * term) -> term) o
32 (#2: Model_Pattern.single -> (term * term))) model)
34 ([1], true, f, I_Model.Cor ((d, ts), (id, ts)))
37 fun flattup2 (a, (b ,c, d, e)) = (a, b, c, d, e)
39 fun is_from (hdf : TermC.as_string) ((fmz_, spec) : Formalise.T) =
40 hdf <> "" andalso fmz_ = [] andalso spec = References.empty
42 fun input_ ((dI, pI, mI): References.T) dtss = (*WN110515 reconsider thy..ctxt*)
44 val thy = ThyC.get_theory dI
45 val ctxt = Proof_Context.init_global thy
46 val {model, ...} = Problem.from_store ctxt pI
47 val its_ = map (dtss2itm_ model) dtss (*([1],true,"#Given",Cor (...))*)
48 val its = O_Model.add_enumerate its_
49 val pits = map flattup2 its
54 case Refine.problem thy pI pits of
55 SOME (pI, _) => (pI, (hd o #solve_mets o Problem.from_store ctxt) pI)
56 | NONE => (pI, (hd o #solve_mets o Problem.from_store ctxt) pI)
57 val {model, where_, where_rls, ...} = MethodC.from_store ctxt mI
58 val its_ = map (dtss2itm_ model) dtss (*([1],true,"#Given",Cor (...))*)
59 val its = O_Model.add_enumerate its_
60 val mits = map flattup2 its
61 val (_, where_) = Pre_Conds.check ctxt where_rls where_ mits 0
62 val ctxt = Proof_Context.init_global thy
63 in (pI, pits, mI, mits, where_, ctxt) end;
65 (* check if the input term is a CAScmd and return a ctree with a _complete_ calchead *)
68 val (h, argl) = strip_comb hdt
70 case get_cas_global h of
72 | SOME (spec as (dI,_,_), argl2dtss) =>
74 val dtss = argl2dtss argl
75 val (pI, pits, mI, mits, where_, ctxt) = input_ spec dtss
76 val spec = (dI, pI, mI)
77 val (pt,_) = Ctree.cappend_problem Ctree.e_ctree [] (Istate_Def.empty, ContextC.empty)
78 ([], References.empty) ([], References.empty, hdt, ctxt)
79 val pt = Ctree.update_spec pt [] spec
80 val pt = Ctree.update_pbl pt [] pits
81 val pt = Ctree.update_met pt [] mits
83 SOME (pt, (true, Pos.Met, hdt, mits, where_, spec) : SpecificationC.T)
92 val parse_theory = Problem.parse_item_name \<^keyword>\<open>Theory_Ref\<close> "Isac_Knowledge";
93 val parse_problem = Problem.parse_item \<^keyword>\<open>Problem_Ref\<close> Parse.name;
94 val parse_method = Problem.parse_item_name \<^keyword>\<open>Method_Ref\<close> "no_met";
99 Outer_Syntax.command \<^command_keyword>\<open>cas\<close>
100 "prepare ISAC Computer-Algebra System and register it to Knowledge Store"
101 (Parse.term -- (\<^keyword>\<open>=\<close> |--
102 Parse.!!! (Parse.ML_source -- parse_theory -- parse_problem -- parse_method))
103 >> (fn (term, (((source, thry), pbl), met)) => Toplevel.theory (fn thy =>
105 val t = TermC.parse (Proof_Context.init_global thy) term;
106 val pblID = References_Def.explode_id pbl;
107 val metID = References_Def.explode_id met;
109 ML_Context.expression (Input.pos_of source)
110 (ml "Theory.setup (CAS_Def.set_data (" @ ML_Lex.read_source source @ ml "))")
111 |> Context.theory_map;
112 val data = CAS_Def.the_data (set_data thy);
113 in Know_Store.add_cass [(t, ((thry, pblID, metID), data))] thy end)));