src/Tools/isac/MathEngBasic/method.sml
author wneuper <walther.neuper@jku.at>
Wed, 28 Apr 2021 12:38:13 +0200
changeset 60265 9c9d61fed195
parent 60223 740ebee5948b
child 60303 815b0dc8b589
permissions -rw-r--r--
eliminate "handle _ => ..." by \<^try>CARTOUCHE in src/*
     1 (* Title:  Interpret/lucas-interpreter.sml
     2    Author: Walther Neuper 2019
     3    (c) due to copyright terms
     4 *)
     5 
     6 signature METHOD =
     7 sig
     8   type T = Meth_Def.T
     9   val empty: T
    10 
    11   type id = Meth_Def.id
    12   val id_empty: id
    13   val id_to_string: id -> string
    14 
    15   type input
    16   (* TODO: ------------- remove always empty --- vvvvvvvvvvv -- vvv*)
    17   val prep_input : theory ->  Check_Unique.id -> string list -> id ->
    18      id * Problem.model_input * input * thm -> T * id
    19 
    20   val from_store: id -> T
    21   val from_store': theory -> id -> T
    22 end
    23 
    24 (**)
    25 structure MethodC(**): METHOD(**) =
    26 struct
    27 (**)
    28 
    29 type T = Meth_Def.T;
    30 val empty = Meth_Def.empty;
    31 
    32 type id = Meth_Def.id;
    33 val id_empty = Meth_Def.id_empty;
    34 val id_to_string = Meth_Def.id_to_string;
    35 
    36 
    37 (** prepare MethodC for Store **)
    38 
    39 (* a subset of MethodC.T record's fields *)
    40 type input = 
    41   {calc: Rule_Def.calc list, crls: Rule_Set.T, errpats: Error_Pattern_Def.T list, nrls: Rule_Set.T,
    42     prls: Rule_Set.T, rew_ord': Rewrite_Ord.rew_ord', rls': Rule_Set.T, srls: Rule_Set.T}
    43 
    44 fun prep_input thy guh maa init
    45 	    (metID, ppc,
    46         {rew_ord' = ro, rls' = rls, srls = srls, prls = prls, calc = _(*scr_isa_fns*), crls = cr,
    47           errpats = ep, nrls = nr}, scr) =
    48     let
    49       fun eq f (f', _) = f = f';
    50       val gi = filter (eq "#Given") ppc;
    51       val gi = (case gi of
    52 		    [] => (writeln ("prep_input: in " ^ guh ^ " #Given is empty ?!?"); [])
    53 		  | ((_, gi') :: []) => 
    54         (case \<^try>\<open> map (Problem.split_did o Thm.term_of o the o (TermC.parse thy)) gi'\<close> of
    55           SOME x => x
    56         | NONE => raise ERROR ("prep_pbt: syntax raise ERROR in '#Given' of " ^ strs2str metID))
    57 		  | _ => raise ERROR ("prep_pbt: more than one '#Given' in " ^ strs2str metID));
    58 		  val gi = map (pair "#Given") gi;
    59 
    60 		  val fi = filter (eq "#Find") ppc;
    61 		  val fi = (case fi of
    62 		    [] => (writeln ("prep_input: in " ^ guh ^ " #Find is empty ?!?"); [])
    63 		  | ((_, fi') :: []) => 
    64         (case \<^try>\<open> map (Problem.split_did o Thm.term_of o the o (TermC.parse thy)) fi'\<close> of
    65           SOME x => x
    66         | NONE => raise ERROR ("prep_pbt: syntax raise ERROR in '#Find' of " ^ strs2str metID))
    67 		  | _ => raise ERROR ("prep_pbt: more than one '#Find' in " ^ strs2str metID));
    68 		  val fi = map (pair "#Find") fi;
    69 
    70 		  val re = filter (eq "#Relate") ppc;
    71 		  val re = (case re of
    72 		    [] => (writeln ("prep_input: in " ^ guh ^ " #Relate is empty ?!?"); [])
    73 		  | ((_,re') :: []) =>
    74         (case \<^try>\<open> map (Problem.split_did o Thm.term_of o the o (TermC.parse thy)) re'\<close> of
    75           SOME x => x
    76         | NONE => raise ERROR ("prep_pbt: syntax raise ERROR in '#Relate' of " ^ strs2str metID))
    77 		  | _ => raise ERROR ("prep_pbt: more than one '#Relate' in " ^ strs2str metID));
    78 		  val re = map (pair "#Relate") re;
    79 
    80 		  val wh = filter (eq "#Where") ppc;
    81 		  val wh = (case wh of
    82 		    [] => (writeln ("prep_input: in " ^ guh ^ " #Where is empty ?!?"); [])
    83 		  | ((_, wh') :: []) => 
    84         (case \<^try>\<open> map (TermC.parse_patt thy) wh'\<close> of
    85           SOME x => x
    86         | NONE => raise ERROR ("prep_pbt: syntax raise ERROR in '#Where' of " ^ strs2str metID))
    87 		  | _ => raise ERROR ("prep_pbt: more than one '#Where' in " ^ strs2str metID));
    88 		  val sc = Program.prep_program scr
    89 		  val calc = if Thm.eq_thm (scr, @{thm refl}) then [] else Auto_Prog.get_calcs thy sc
    90     in
    91        ({guh = guh, mathauthors = maa, init = init, ppc = gi @ fi @ re, pre = wh, rew_ord' = ro,
    92          erls = rls, srls = srls, prls = prls, calc = calc,
    93          crls = cr, errpats = ep, nrls = nr, scr = Rule.Prog sc}, metID)
    94     end;
    95 
    96 
    97 (** get MethodC from Store **)
    98 
    99 (* TODO: throws exn 'get_pbt not found: ' ... confusing !! take 'ketype' as an argument *)
   100 fun from_store metID = Store.get (get_mets ()) metID metID;
   101 fun from_store' thy metID = Store.get (KEStore_Elems.get_mets thy) metID metID;
   102 
   103 (**)end(**)