src/Tools/isac/Specify/cas-command.sml
author wneuper <Walther.Neuper@jku.at>
Mon, 12 Sep 2022 17:46:32 +0200
changeset 60550 dbdcfd4dccb3
parent 60547 99328169539a
child 60556 486223010ea8
permissions -rw-r--r--
eliminate KEStore_Elems.get_thes, add_thes 2: get_cas 1: Test_Isac ok
     1 (* Title:  Interpret/lucas-interpreter.sml
     2    Author: Walther Neuper 2019
     3    (c) due to copyright terms
     4 *)
     5 
     6 signature COMPUTER_ALGEBRA_SYSTEM_COMMAND =
     7 sig
     8   type T = CAS_Def.T
     9   val input : term -> (Ctree.ctree * SpecificationC.T) option
    10   val is_from: TermC.as_string -> Formalise.T -> bool
    11 \<^isac_test>\<open>
    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
    14 
    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
    18 \<close>
    19 end
    20 
    21 (**)
    22 structure CAS_Cmd(**): COMPUTER_ALGEBRA_SYSTEM_COMMAND(**) =
    23 struct
    24 (**)
    25 
    26 type T = CAS_Def.T; (*(term * (References_Def.T * generate_fn))*)
    27 
    28 fun dtss2itm_ ppc (d, ts) =
    29   let
    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))) ppc)
    33   in
    34     ([1], true, f, I_Model.Cor ((d, ts), (id, ts)))
    35   end
    36 
    37 fun flattup2 (a, (b ,c, d, e)) = (a, b, c, d, e)
    38 
    39 fun is_from (hdf : TermC.as_string) ((fmz_, spec) : Formalise.T) =
    40   hdf <> "" andalso fmz_ = [] andalso spec = References.empty
    41 
    42 fun input_ ((dI, pI, mI): References.T) dtss = (*WN110515 reconsider thy..ctxt*)
    43   let
    44     val thy = ThyC.get_theory dI
    45 	  val {ppc, ...} = Problem.from_store pI
    46 	  val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
    47 	  val its = O_Model.add_enumerate its_
    48 	  val pits = map flattup2 its
    49 	  val (pI, mI) =
    50       if mI <> ["no_met"]
    51       then (pI, mI)
    52 		  else
    53         case Refine.problem thy pI pits of
    54 			    SOME (pI,_) => (pI, (hd o #met o Problem.from_store) pI)
    55 			  | NONE => (pI, (hd o #met o Problem.from_store) pI)
    56 	  val {ppc, pre, prls, ...} = MethodC.from_store mI
    57 	  val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
    58 	  val its = O_Model.add_enumerate its_
    59 	  val mits = map flattup2 its
    60 	  val (_, pre) = Pre_Conds.check prls pre mits 0
    61     val ctxt = Proof_Context.init_global thy
    62   in (pI, pits, mI, mits, pre, ctxt) end;
    63 
    64 (* check if the input term is a CAScmd and return a ctree with a _complete_ calchead *)
    65 fun input hdt =
    66   let
    67     val (h, argl) = strip_comb hdt
    68   in
    69     case get_cas_global h of
    70       NONE => NONE
    71     | SOME (spec as (dI,_,_), argl2dtss) =>
    72 	      let
    73           val dtss = argl2dtss argl
    74 	        val (pI, pits, mI, mits, pre, ctxt) = input_ spec dtss
    75 	        val spec = (dI, pI, mI)
    76 	        val (pt,_) = Ctree.cappend_problem Ctree.e_ctree [] (Istate_Def.empty, ContextC.empty)
    77 		        ([], References.empty) ([], References.empty, hdt, ctxt)
    78 	        val pt = Ctree.update_spec pt [] spec
    79 	        val pt = Ctree.update_pbl pt [] pits
    80 	        val pt = Ctree.update_met pt [] mits
    81 	      in
    82 	        SOME (pt, (true, Pos.Met, hdt, mits, pre, spec) : SpecificationC.T)
    83 	      end
    84   end
    85 
    86 
    87 (** Isar command **)
    88 
    89 local
    90 
    91 val parse_theory = Problem.parse_item_name \<^keyword>\<open>Theory_Ref\<close> "Isac_Knowledge";
    92 val parse_problem = Problem.parse_item \<^keyword>\<open>Problem_Ref\<close> Parse.name;
    93 val parse_method = Problem.parse_item_name \<^keyword>\<open>Method_Ref\<close> "no_met";
    94 
    95 val ml = ML_Lex.read;
    96 
    97 val _ =
    98   Outer_Syntax.command \<^command_keyword>\<open>cas\<close>
    99     "prepare ISAC Computer-Algebra System and register it to Knowledge Store"
   100     (Parse.term -- (\<^keyword>\<open>=\<close> |--
   101       Parse.!!! (Parse.ML_source -- parse_theory -- parse_problem -- parse_method))
   102       >> (fn (term, (((source, thry), pbl), met)) => Toplevel.theory (fn thy =>
   103         let
   104           val t = TermC.parse_strict thy term;
   105           val pblID = References_Def.explode_id pbl;
   106           val metID = References_Def.explode_id met;
   107           val set_data =
   108             ML_Context.expression (Input.pos_of source)
   109               (ml "Theory.setup (CAS_Def.set_data (" @ ML_Lex.read_source source @ ml "))")
   110             |> Context.theory_map;
   111           val data = CAS_Def.the_data (set_data thy);
   112         in KEStore_Elems.add_cass [(t, ((thry, pblID, metID), data))] thy end)));
   113 
   114 in end;
   115 
   116 (**)end(**)