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