(* Title:  Interpret/lucas-interpreter.sml

    Author: Walther Neuper 2019

    (c) due to copyright terms

 *)

 signature METHOD =

 sig

   type T = Meth_Def.T

   val empty: T

   type id = Meth_Def.id

   val id_empty: id

   val id_to_string: id -> string

   type input

   (* TODO: ------------- remove always empty --- vvvvvvvvvvv -- vvv*)

   val prep_input : theory ->  Check_Unique.id -> string list -> id ->

      id * Problem.model_input * input * thm -> T * id

   val set_input: input -> theory -> theory

   val the_input: theory -> input

   val from_store: id -> T

   val from_store': theory -> id -> T

 end

 (**)

 structure MethodC(**): METHOD(**) =

 struct

 (**)

 type T = Meth_Def.T;

 val empty = Meth_Def.empty;

 type id = Meth_Def.id;

 val id_empty = Meth_Def.id_empty;

 val id_to_string = Meth_Def.id_to_string;

 (** prepare MethodC for Store **)

 (* a subset of MethodC.T record's fields *)

 type input = 

   {calc: Rule_Def.calc list, crls: Rule_Set.T, errpats: Error_Pattern_Def.T list, nrls: Rule_Set.T,

     prls: Rule_Set.T, rew_ord': Rewrite_Ord.rew_ord', rls': Rule_Set.T, srls: Rule_Set.T}

 fun prep_input thy guh (mathauthors: string list) (init: References_Def.id)

 	    (metID, ppc,

         {rew_ord' = ro, rls' = rls, srls = srls, prls = prls, calc = _(*scr_isa_fns*), crls = cr,

           errpats = ep, nrls = nr}, scr) =

     let

       fun eq f (f', _) = f = f';

       val gi = filter (eq "#Given") ppc;

       val gi = (case gi of

 		    [] => (writeln ("prep_input: in " ^ guh ^ " #Given is empty ?!?"); [])

 		  | ((_, gi') :: []) => 

         (case \<^try>\<open> map (Problem.split_did o Thm.term_of o the o (TermC.parse thy)) gi'\<close> of

           SOME x => x

         | NONE => raise ERROR ("prep_pbt: syntax raise ERROR in '#Given' of " ^ strs2str metID))

 		  | _ => raise ERROR ("prep_pbt: more than one '#Given' in " ^ strs2str metID));

 		  val gi = map (pair "#Given") gi;

 		  val fi = filter (eq "#Find") ppc;

 		  val fi = (case fi of

 		    [] => (writeln ("prep_input: in " ^ guh ^ " #Find is empty ?!?"); [])

 		  | ((_, fi') :: []) => 

         (case \<^try>\<open> map (Problem.split_did o Thm.term_of o the o (TermC.parse thy)) fi'\<close> of

           SOME x => x

         | NONE => raise ERROR ("prep_pbt: syntax raise ERROR in '#Find' of " ^ strs2str metID))

 		  | _ => raise ERROR ("prep_pbt: more than one '#Find' in " ^ strs2str metID));

 		  val fi = map (pair "#Find") fi;

 		  val re = filter (eq "#Relate") ppc;

 		  val re = (case re of

 		    [] => (writeln ("prep_input: in " ^ guh ^ " #Relate is empty ?!?"); [])

 		  | ((_,re') :: []) =>

         (case \<^try>\<open> map (Problem.split_did o Thm.term_of o the o (TermC.parse thy)) re'\<close> of

           SOME x => x

         | NONE => raise ERROR ("prep_pbt: syntax raise ERROR in '#Relate' of " ^ strs2str metID))

 		  | _ => raise ERROR ("prep_pbt: more than one '#Relate' in " ^ strs2str metID));

 		  val re = map (pair "#Relate") re;

 		  val wh = filter (eq "#Where") ppc;

 		  val wh = (case wh of

 		    [] => (writeln ("prep_input: in " ^ guh ^ " #Where is empty ?!?"); [])

 		  | ((_, wh') :: []) => 

         (case \<^try>\<open> map (TermC.parse_patt thy) wh'\<close> of

           SOME x => x

         | NONE => raise ERROR ("prep_pbt: syntax raise ERROR in '#Where' of " ^ strs2str metID))

 		  | _ => raise ERROR ("prep_pbt: more than one '#Where' in " ^ strs2str metID));

 		  val sc = Program.prep_program scr

 		  val calc = if Thm.eq_thm (scr, @{thm refl}) then [] else Auto_Prog.get_calcs thy sc

     in

        ({guh = guh, mathauthors = mathauthors, init = init, ppc = gi @ fi @ re, pre = wh,

          rew_ord' = ro, erls = rls, srls = srls, prls = prls, calc = calc,

          crls = cr, errpats = ep, nrls = nr, scr = Rule.Prog sc}, metID)

     end;

 (** Isar command **)

 structure Data = Theory_Data

 (

   type T = input option;

   val empty = NONE;

   val extend = I;

   fun merge _ = NONE;

 );

 val set_input = Data.put o SOME;

 val the_input = the o Data.get;

 local

 fun parse_item keyword parse = (keyword -- Args.colon) |-- Parse.!!! parse;

 val parse_authors =

   Scan.optional (parse_item \<^keyword>\<open>Author\<close> (Scan.repeat1 Parse.name)) [];

 val parse_program =

   Scan.option (parse_item \<^keyword>\<open>Program\<close> (Parse.position Parse.name));

 fun parse_terms keyword (tag: string) =

   Scan.optional (parse_item keyword (Scan.repeat Parse.term) >> (fn ts => [(tag, ts)])) [];

 val parse_ppc =

   parse_terms \<^keyword>\<open>Given\<close> "#Given" @@@

   parse_terms \<^keyword>\<open>Where\<close> "#Where" @@@

   parse_terms \<^keyword>\<open>Find\<close> "#Find" @@@

   parse_terms \<^keyword>\<open>Relate\<close> "#Relate";

 val ml = ML_Lex.read;

 val _ =

   Outer_Syntax.command \<^command_keyword>\<open>method\<close>

     "prepare ISAC method and register it to Knowledge Store"

     (Parse.name -- Parse.!!! (\<^keyword>\<open>:\<close> |-- Parse.name --

       Parse.!!! (\<^keyword>\<open>=\<close> |-- Parse.ML_source -- parse_authors -- parse_program -- parse_ppc)) >>

       (fn (name, (id, (((source, mathauthors), simp), ppc))) => Toplevel.theory (fn thy =>

         let

           val metID = References_Def.explode_id id;

           val eval_input =

             ML_Context.expression (Input.pos_of source)

               (ml "Theory.setup (MethodC.set_input (" @ ML_Lex.read_source source @ ml "))")

             |> Context.theory_map;

           val input = the_input (eval_input thy);

           val thm =

             (case simp of

               NONE => @{thm refl}

             | SOME a => Global_Theory.get_thm thy (Global_Theory.check_fact thy a));

           val arg = prep_input thy name mathauthors id_empty (metID, ppc, input, thm);

         in KEStore_Elems.add_mets [arg] thy end)))

 in end;

 (** get MethodC from Store **)

 (* TODO: throws exn 'get_pbt not found: ' ... confusing !! take 'ketype' as an argument *)

 fun from_store metID = Store.get (get_mets ()) metID metID;

 fun from_store' thy metID = Store.get (KEStore_Elems.get_mets thy) metID metID;

 (**)end(**)