1.1 --- a/src/Tools/isac/Frontend/interface.sml Tue Mar 13 15:04:27 2018 +0100
1.2 +++ b/src/Tools/isac/Frontend/interface.sml Thu Mar 15 10:17:44 2018 +0100
1.3 @@ -11,51 +11,51 @@
1.4
1.5 signature KERNEL =
1.6 sig
1.7 - val appendFormula : calcID -> cterm' -> XML.tree (*unit future*)
1.8 - val autoCalculate : calcID -> Solve.auto -> XML.tree (*unit future*)
1.9 - val applyTactic : calcID -> Ctree.pos' -> Tac.tac -> XML.tree
1.10 + val appendFormula : Celem.calcID -> Celem.cterm' -> XML.tree (*unit future*)
1.11 + val autoCalculate : Celem.calcID -> Solve.auto -> XML.tree (*unit future*)
1.12 + val applyTactic : Celem.calcID -> Ctree.pos' -> Tac.tac -> XML.tree
1.13 val CalcTree : Selem.fmz list -> XML.tree
1.14 - val checkContext : calcID -> Ctree.pos' -> guh -> XML.tree
1.15 - val DEconstrCalcTree : calcID -> XML.tree
1.16 - val fetchApplicableTactics : calcID -> int -> Ctree.pos' -> XML.tree
1.17 - val fetchProposedTactic : calcID -> XML.tree
1.18 - val findFillpatterns : calcID -> errpatID -> XML.tree
1.19 - val getAccumulatedAsms : calcID -> Ctree.pos' -> XML.tree
1.20 - val getActiveFormula : calcID -> XML.tree
1.21 - val getAssumptions : calcID -> Ctree.pos' -> XML.tree
1.22 - val getFormulaeFromTo : calcID -> Ctree.pos' -> Ctree.pos' -> int -> bool -> XML.tree
1.23 - val getTactic : calcID -> Ctree.pos' -> XML.tree
1.24 - val initContext : calcID -> ketype -> Ctree.pos' -> XML.tree
1.25 - val inputFillFormula: calcID -> string -> XML.tree
1.26 - val interSteps : calcID -> Ctree.pos' -> XML.tree
1.27 - val Iterator : calcID -> XML.tree
1.28 - val IteratorTEST : calcID -> iterID
1.29 - val modelProblem : calcID -> XML.tree
1.30 - val modifyCalcHead : calcID -> Inform.icalhd -> XML.tree
1.31 - val moveActiveCalcHead : calcID -> XML.tree
1.32 - val moveActiveDown : calcID -> XML.tree
1.33 - val moveActiveFormula : calcID -> Ctree.pos' -> XML.tree
1.34 - val moveActiveLevelDown : calcID -> XML.tree
1.35 - val moveActiveLevelUp : calcID -> XML.tree
1.36 - val moveActiveRoot : calcID -> XML.tree
1.37 - val moveActiveRootTEST : calcID -> XML.tree
1.38 - val moveActiveUp : calcID -> XML.tree
1.39 - val moveCalcHead : calcID -> Ctree.pos' -> XML.tree
1.40 - val moveDown : calcID -> Ctree.pos' -> XML.tree
1.41 - val moveLevelDown : calcID -> Ctree.pos' -> XML.tree
1.42 - val moveLevelUp : calcID -> Ctree.pos' -> XML.tree
1.43 - val moveRoot : calcID -> XML.tree
1.44 - val moveUp : calcID -> Ctree.pos' -> XML.tree
1.45 - val refFormula : calcID -> Ctree.pos' -> XML.tree
1.46 - val refineProblem : calcID -> Ctree.pos' -> guh -> XML.tree
1.47 - val replaceFormula : calcID -> cterm' -> XML.tree
1.48 - val requestFillformula : calcID -> errpatID * fillpatID -> XML.tree
1.49 - val resetCalcHead : calcID -> XML.tree
1.50 - val setContext : calcID -> Ctree.pos' -> guh -> XML.tree
1.51 - val setMethod : calcID -> metID -> XML.tree
1.52 - val setNextTactic : calcID -> Tac.tac -> XML.tree
1.53 - val setProblem : calcID -> pblID -> XML.tree
1.54 - val setTheory : calcID -> thyID -> XML.tree
1.55 + val checkContext : Celem.calcID -> Ctree.pos' -> Celem.guh -> XML.tree
1.56 + val DEconstrCalcTree : Celem.calcID -> XML.tree
1.57 + val fetchApplicableTactics : Celem.calcID -> int -> Ctree.pos' -> XML.tree
1.58 + val fetchProposedTactic : Celem.calcID -> XML.tree
1.59 + val findFillpatterns : Celem.calcID -> Celem.errpatID -> XML.tree
1.60 + val getAccumulatedAsms : Celem.calcID -> Ctree.pos' -> XML.tree
1.61 + val getActiveFormula : Celem.calcID -> XML.tree
1.62 + val getAssumptions : Celem.calcID -> Ctree.pos' -> XML.tree
1.63 + val getFormulaeFromTo : Celem.calcID -> Ctree.pos' -> Ctree.pos' -> int -> bool -> XML.tree
1.64 + val getTactic : Celem.calcID -> Ctree.pos' -> XML.tree
1.65 + val initContext : Celem.calcID -> Celem.ketype -> Ctree.pos' -> XML.tree
1.66 + val inputFillFormula: Celem.calcID -> string -> XML.tree
1.67 + val interSteps : Celem.calcID -> Ctree.pos' -> XML.tree
1.68 + val Iterator : Celem.calcID -> XML.tree
1.69 + val IteratorTEST : Celem.calcID -> Celem.iterID
1.70 + val modelProblem : Celem.calcID -> XML.tree
1.71 + val modifyCalcHead : Celem.calcID -> Inform.icalhd -> XML.tree
1.72 + val moveActiveCalcHead : Celem.calcID -> XML.tree
1.73 + val moveActiveDown : Celem.calcID -> XML.tree
1.74 + val moveActiveFormula : Celem.calcID -> Ctree.pos' -> XML.tree
1.75 + val moveActiveLevelDown : Celem.calcID -> XML.tree
1.76 + val moveActiveLevelUp : Celem.calcID -> XML.tree
1.77 + val moveActiveRoot : Celem.calcID -> XML.tree
1.78 + val moveActiveRootTEST : Celem.calcID -> XML.tree
1.79 + val moveActiveUp : Celem.calcID -> XML.tree
1.80 + val moveCalcHead : Celem.calcID -> Ctree.pos' -> XML.tree
1.81 + val moveDown : Celem.calcID -> Ctree.pos' -> XML.tree
1.82 + val moveLevelDown : Celem.calcID -> Ctree.pos' -> XML.tree
1.83 + val moveLevelUp : Celem.calcID -> Ctree.pos' -> XML.tree
1.84 + val moveRoot : Celem.calcID -> XML.tree
1.85 + val moveUp : Celem.calcID -> Ctree.pos' -> XML.tree
1.86 + val refFormula : Celem.calcID -> Ctree.pos' -> XML.tree
1.87 + val refineProblem : Celem.calcID -> Ctree.pos' -> Celem.guh -> XML.tree
1.88 + val replaceFormula : Celem.calcID -> Celem.cterm' -> XML.tree
1.89 + val requestFillformula : Celem.calcID -> Celem.errpatID * Celem.fillpatID -> XML.tree
1.90 + val resetCalcHead : Celem.calcID -> XML.tree
1.91 + val setContext : Celem.calcID -> Ctree.pos' -> Celem.guh -> XML.tree
1.92 + val setMethod : Celem.calcID -> Celem.metID -> XML.tree
1.93 + val setNextTactic : Celem.calcID -> Tac.tac -> XML.tree
1.94 + val setProblem : Celem.calcID -> Celem.pblID -> XML.tree
1.95 + val setTheory : Celem.calcID -> Celem.thyID -> XML.tree
1.96 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
1.97 (* NONE *)
1.98 ( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
1.99 @@ -90,10 +90,10 @@
1.100 WN.0411: only 'Iterator 1' is stored,
1.101 all others are just calculated on the fly
1.102 TODO: adapt Iterator, add_user(= add_iterator!),etc. accordingly .*)
1.103 -fun Iterator (cI:calcID) = (*returned ID unnecessary after WN.0411*)
1.104 - (adduserOK2xml cI (add_user (cI:calcID)))
1.105 +fun Iterator cI = (*returned ID unnecessary after WN.0411*)
1.106 + (adduserOK2xml cI (add_user cI ))
1.107 handle _ => sysERROR2xml cI "error in kernel 1";
1.108 -fun IteratorTEST (cI:calcID) = add_user (cI:calcID);
1.109 +fun IteratorTEST cI = add_user cI;
1.110
1.111 (*.create a calc-tree; for calls from java: thus ^^^ decoded to ^;
1.112 compare "fun CalcTreeTEST" which does NOT decode.*)
1.113 @@ -105,10 +105,10 @@
1.114 handle _ => sysERROR2xml 0 "error in kernel 2")
1.115 | CalcTree [] = error "CalcTree: called with []"
1.116
1.117 -fun DEconstrCalcTree (cI:calcID) = deconstructcalctreeOK2xml (del_calc cI);
1.118 -fun getActiveFormula (cI:calcID) = iteratorOK2xml cI (get_pos cI 1);
1.119 +fun DEconstrCalcTree cI = deconstructcalctreeOK2xml (del_calc cI);
1.120 +fun getActiveFormula cI = iteratorOK2xml cI (get_pos cI 1);
1.121
1.122 -fun moveActiveFormula (cI:calcID) (p:pos') =
1.123 +fun moveActiveFormula cI p =
1.124 let val ((pt,_),_) = get_calc cI
1.125 in
1.126 if existpt' p pt
1.127 @@ -119,7 +119,7 @@
1.128 (*. set the next tactic to be applied: dont't change the calc-tree,
1.129 but remember the envisaged changes for fun autoCalculate;
1.130 compare force NextTactic .*)
1.131 -fun setNextTactic (cI:calcID) tac =
1.132 +fun setNextTactic cI tac =
1.133 let
1.134 val ((pt, _), _) = get_calc cI (* retrieve calcstate from states *)
1.135 val ip = get_pos cI 1 (* retrieve position from states *)
1.136 @@ -136,7 +136,7 @@
1.137
1.138 (*. apply a tactic at a position and update the calc-tree if applicable .*)
1.139 (*WN080226 java-code is missing, errors smltest/Knowledge/polyminus.sml*)
1.140 -fun applyTactic (cI:calcID) ip tac =
1.141 +fun applyTactic cI ip tac =
1.142 let
1.143 val ((pt, _), _) = get_calc cI
1.144 val p = get_pos cI 1
1.145 @@ -157,7 +157,7 @@
1.146 | (str, _) => autocalculateERROR2xml cI ("applyTactic: locatetac returns " ^ str)
1.147 end;
1.148
1.149 -fun fetchProposedTactic (cI:calcID) =
1.150 +fun fetchProposedTactic cI =
1.151 (case Math_Engine.step (get_pos cI 1) (get_calc cI) of
1.152 ("ok", (tacis, _, _)) =>
1.153 let
1.154 @@ -170,7 +170,7 @@
1.155 fetchproposedtacticERROR2xml cI "end-of-calculation")
1.156 handle _ => sysERROR2xml cI "error in kernel 3";
1.157
1.158 -fun autoCalculate (cI:calcID) auto = (*Future.fork
1.159 +fun autoCalculate cI auto = (*Future.fork
1.160 (fn () => (( *)let
1.161 val pold = get_pos cI 1
1.162 val x = Math_Engine.autocalc [] pold (get_calc cI) auto
1.163 @@ -314,7 +314,7 @@
1.164 while the buttons on these browsers <To Worksheet> <Try Refine> have no
1.165 code in isac-java (and only partial, untested code in isabisac).
1.166 *)
1.167 -fun setContext cI (ip as (_,p_):pos') (guh:guh) =
1.168 +fun setContext cI (ip as (_,p_)) guh =
1.169 case (implode o (take_fromto 1 4) o Symbol.explode) guh of
1.170 "thy_" =>
1.171 if member op = [Pbl, Met] p_
1.172 @@ -344,7 +344,7 @@
1.173 let
1.174 val ctxt = get_ctxt pt pold
1.175 val (p, c, _, pt) =
1.176 - Generate.generate1 (assoc_thy "Isac") m (Selem.Uistate, ctxt) ip pt
1.177 + Generate.generate1 (Celem.assoc_thy "Isac") m (Selem.Uistate, ctxt) ip pt
1.178 in upd_calc cI ((pt, p), []);
1.179 autocalculateOK2xml cI pold (if null c then pold else last_elem c) p
1.180 end)
1.181 @@ -433,7 +433,7 @@
1.182 handle _ => sysERROR2xml cI "error in kernel 16";
1.183
1.184 (* append a formula to the calculation *)
1.185 -fun appendFormula' cI (ifo:cterm') =
1.186 +fun appendFormula' cI (ifo: Celem.cterm') =
1.187 (let
1.188 val cs = get_calc cI
1.189 val pos = get_pos cI 1
1.190 @@ -455,7 +455,7 @@
1.191 fun appendFormula cI ifo = (*Future.fork (fn () => *)appendFormula' cI ifo(* ) *);
1.192
1.193 (* replace a formula with_in_ a calculation; this applies for initial CAS-commands, too *)
1.194 -fun replaceFormula cI (ifo:cterm') =
1.195 +fun replaceFormula cI ifo =
1.196 (let
1.197 val ((pt, _), _) = get_calc cI
1.198 val p = get_pos cI 1
1.199 @@ -670,10 +670,10 @@
1.200 val fillforms = Inform.find_fillpatterns (pt, pos) errpatID
1.201 in
1.202 case filter ((curry op = fillpatID) o
1.203 - (#1: (fillpatID * term * thm * (Selem.subs option) -> fillpatID))) fillforms of
1.204 + (#1: (Celem.fillpatID * term * thm * (Selem.subs option) -> Celem.fillpatID))) fillforms of
1.205 (_, fillform, thm, sube_opt) :: _ =>
1.206 let
1.207 - val (pt, pos') = Generate.generate_inconsistent_rew (sube_opt, thm''_of_thm thm)
1.208 + val (pt, pos') = Generate.generate_inconsistent_rew (sube_opt, Celem.thm''_of_thm thm)
1.209 fillform (get_loc pt pos) pos pt
1.210 in
1.211 (upd_calc cI ((pt, pos'), []); (*upd_ipos cI 1 pos';*)
2.1 --- a/src/Tools/isac/Frontend/states.sml Tue Mar 13 15:04:27 2018 +0100
2.2 +++ b/src/Tools/isac/Frontend/states.sml Thu Mar 15 10:17:44 2018 +0100
2.3 @@ -140,9 +140,9 @@
2.4
2.5 (* holds calculations; these are read/updated from the java-frontend at each interaction*)
2.6 val states = Synchronized.var "isac_states" ([] :
2.7 - (calcID * (* the id unique for a calculation *)
2.8 + (Celem.calcID * (* the id unique for a calculation *)
2.9 (Chead.calcstate * (* the interpreter state *)
2.10 - (iterID * (* 1 sets the 'active formula': a calc. can have several visitors*)
2.11 + (Celem.iterID * (* 1 sets the 'active formula': a calc. can have several visitors*)
2.12 Ctree.pos' (* for iterator of a user *)
2.13 (* TODO iterID * pos' should go to java-frontend *)
2.14 ) list)) list);
2.15 @@ -183,11 +183,11 @@
2.16 val it = 1 : calcID
2.17 *)
2.18 (* add users to a calcstate *)
2.19 -fun get_iterID (cI:calcID)
2.20 - (p:(calcID * (Chead.calcstate * (iterID * Ctree.pos') list)) list) =
2.21 +fun get_iterID (cI: Celem.calcID)
2.22 + (p: (Celem.calcID * (Chead.calcstate * (Celem.iterID * Ctree.pos') list)) list) =
2.23 case assoc (p, cI) of
2.24 NONE => error ("get_iterID: no iterID " ^ (string_of_int cI))
2.25 - | SOME (_, us) => (new_key us 1):iterID;
2.26 + | SOME (_, us) => (new_key us 1): Celem.iterID;
2.27 (* get_iterID 3 (!states);
2.28 val it = 2 : iterID*)
2.29
2.30 @@ -207,11 +207,11 @@
2.31 fun get_state (uI:iterID) (pI:calcID) = get_cal uI pI (!states);
2.32 fun get_calc (uI:iterID) (pI:calcID) = (snd o (get_cal uI pI)) (!states);
2.33 *)
2.34 -fun get_calc (cI:calcID) =
2.35 +fun get_calc (cI: Celem.calcID) =
2.36 case assoc (Synchronized.value states, cI) of
2.37 NONE => error ("get_calc "^(string_of_int cI)^" not existent")
2.38 | SOME (c, _) => c;
2.39 -fun get_pos (cI:calcID) (uI:iterID) =
2.40 +fun get_pos (cI: Celem.calcID) (uI: Celem.iterID) =
2.41 case assoc (Synchronized.value states, cI) of
2.42 NONE => error ("get_pos: calc " ^ (string_of_int cI)
2.43 ^ " not existent")
2.44 @@ -249,7 +249,7 @@
2.45 > !states;
2.46 val it = [(4,[(#,#)]),(1,[(#,#)])] : states
2.47 *)
2.48 -fun del_assoc2 (cI:calcID) (uI:iterID) ps =
2.49 +fun del_assoc2 (cI: Celem.calcID) (uI: Celem.iterID) ps =
2.50 case assoc (ps, cI) of
2.51 NONE => ps
2.52 | SOME (cs, us) =>
2.53 @@ -267,7 +267,7 @@
2.54 handle _ => error ("overwrite2 " ^ (string_of_int uI) ^
2.55 " " ^ (string_of_int pI) ^ " not existent")
2.56 end;*)
2.57 -fun overwrite2 (ps, (((cI:calcID), (uI:iterID)), p)) =
2.58 +fun overwrite2 (ps, (((cI: Celem.calcID), (uI: Celem.iterID)), p)) =
2.59 case assoc (ps, cI) of
2.60 NONE =>
2.61 error ("overwrite2: calc " ^ (string_of_int uI) ^" not existent")
2.62 @@ -281,7 +281,7 @@
2.63 | SOME (_, us) =>
2.64 Synchronized.change states (fn s => overwrite ...)
2.65 *)
2.66 -fun upd_calc (cI:calcID) cs = Synchronized.change states
2.67 +fun upd_calc (cI: Celem.calcID) cs = Synchronized.change states
2.68 (fn s => case assoc (s, cI) of
2.69 NONE => error ("upd_calc " ^ (string_of_int cI) ^ " not existent")
2.70 | SOME (_, us) => overwrite (s, (cI, (cs, us))));
2.71 @@ -301,7 +301,7 @@
2.72 let val (p, (ptp,_)) = get_state uI pI
2.73 in states:=
2.74 overwrite2 ((!states), ((uI, pI), (p, (ptp, tacis)))) end;*)
2.75 -fun upd_tacis (cI:calcID) tacis = Synchronized.change states
2.76 +fun upd_tacis (cI: Celem.calcID) tacis = Synchronized.change states
2.77 (fn s => case assoc (s, cI) of
2.78 NONE =>
2.79 error ("upd_tacis: calctree " ^ (string_of_int cI) ^ " not existent")
2.80 @@ -310,7 +310,7 @@
2.81 fun upd_ipos (uI:iterID) (pI:calcID) (ip:pos') =
2.82 let val (_, calc) = get_state uI pI
2.83 in states:= overwrite2 ((!states), ((uI, pI), (ip, calc))) end;*)
2.84 -fun upd_ipos (cI:calcID) (uI:iterID) (ip: Ctree.pos') = Synchronized.change states
2.85 +fun upd_ipos (cI: Celem.calcID) (uI: Celem.iterID) (ip: Ctree.pos') = Synchronized.change states
2.86 (fn s => case assoc (s, cI) of
2.87 NONE =>
2.88 error ("upd_ipos: calctree " ^ (string_of_int cI) ^ " not existent")
2.89 @@ -343,19 +343,19 @@
2.90 let val (new_calcID, new_calcs) = add_pID uI s (!states)
2.91 in states:= new_calcs;
2.92 new_calcID end; *)
2.93 -fun add_user (cI:calcID) = Synchronized.change_result states
2.94 +fun add_user (cI: Celem.calcID) = Synchronized.change_result states
2.95 (fn s => case assoc (s, cI) of
2.96 NONE =>
2.97 error ("add_user: calctree " ^ (string_of_int cI) ^ " not existent")
2.98 | SOME (cs, us) =>
2.99 let
2.100 val new_uI = new_key us 1
2.101 - in (new_uI:iterID, overwrite2 (s, ((cI, new_uI), Ctree.e_pos'))) end);
2.102 + in (new_uI: Celem.iterID, overwrite2 (s, ((cI, new_uI), Ctree.e_pos'))) end);
2.103
2.104 (*///10.10.
2.105 fun del_calc (uI:iterID) (pI:calcID) =
2.106 (states:= del_assoc2 uI pI (!states); pI);*)
2.107 -fun del_user (cI:calcID) (uI:iterID) =
2.108 +fun del_user (cI: Celem.calcID) (uI: Celem.iterID) =
2.109 Synchronized.change_result states (fn s => (uI, del_assoc2 cI uI s));
2.110
2.111
2.112 @@ -366,14 +366,14 @@
2.113 fun add_calc (cs: Chead.calcstate) = Synchronized.change_result states
2.114 (fn s =>
2.115 let val new_cI = new_key s 1
2.116 - in (new_cI:calcID, s @ [(new_cI, (cs, []))]) end);
2.117 + in (new_cI: Celem.calcID, s @ [(new_cI, (cs, []))]) end);
2.118
2.119 (* delete doesn't report non existing elements *)
2.120 (*///7.10
2.121 fun del_user (uI:userID) =
2.122 (states:= del_assoc (!states, uI); uI);*)
2.123 -fun del_calc (cI:calcID) = Synchronized.change_result states
2.124 - (fn s => (cI:calcID, del_assoc (s, cI)));
2.125 +fun del_calc (cI: Celem.calcID) = Synchronized.change_result states
2.126 + (fn s => (cI: Celem.calcID, del_assoc (s, cI)));
2.127
2.128 (* -------------- test all exported funs --------------
2.129 ///7.10
3.1 --- a/src/Tools/isac/Interpret/appl.sml Tue Mar 13 15:04:27 2018 +0100
3.2 +++ b/src/Tools/isac/Interpret/appl.sml Thu Mar 15 10:17:44 2018 +0100
3.3 @@ -21,13 +21,13 @@
3.4 (**)
3.5 open Ctree
3.6
3.7 -fun rew_info (Rls {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
3.8 +fun rew_info (Celem.Rls {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
3.9 (rew_ord', erls, ca)
3.10 - | rew_info (Seq {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
3.11 + | rew_info (Celem.Seq {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
3.12 (rew_ord', erls, ca)
3.13 - | rew_info (Rrls {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
3.14 + | rew_info (Celem.Rrls {erls, rew_ord = (rew_ord', _), calc = ca, ...}) =
3.15 (rew_ord', erls, ca)
3.16 - | rew_info rls = error ("rew_info called with '" ^ rls2str rls ^ "'");
3.17 + | rew_info rls = error ("rew_info called with '" ^ Celem.rls2str rls ^ "'");
3.18
3.19 (*FIXME.3.4.03:re-organize from_pblobj_or_detail_thm after rls' --> rls*)
3.20 fun from_pblobj_or_detail_thm _ p pt =
3.21 @@ -60,7 +60,7 @@
3.22 in
3.23 case opt of
3.24 SOME isa_fn => ("OK", thy', isa_fn)
3.25 - | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", e_evalfn))
3.26 + | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", Celem.e_evalfn))
3.27 end
3.28 else
3.29 let
3.30 @@ -69,14 +69,14 @@
3.31 in
3.32 case assoc (scr_isa_fns, scrop) of
3.33 SOME isa_fn => ("OK",thy',isa_fn)
3.34 - | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", e_evalfn))
3.35 + | NONE => ("applicable_in Calculate: unknown '" ^ scrop ^ "'", "", ("", Celem.e_evalfn))
3.36 end
3.37 end;
3.38
3.39 (*for Check_elementwise in applicable_in: [x=1,..] Assumptions -> (x,0<=x&..)*)
3.40 -fun mk_set _(*thy*) _ _ (Const ("List.list.Nil", _)) _ = (e_term, [])
3.41 +fun mk_set _(*thy*) _ _ (Const ("List.list.Nil", _)) _ = (Celem.e_term, [])
3.42 | mk_set _ pt p (Const ("Tools.UniversalList", _)) pred =
3.43 - (e_term, if pred <> Const ("Script.Assumptions", HOLogic.boolT)
3.44 + (Celem.e_term, if pred <> Const ("Script.Assumptions", HOLogic.boolT)
3.45 then [pred]
3.46 else get_assumptions_ pt (p, Res))
3.47 | mk_set _ pt p (Const ("List.list.Cons",_) $ eq $ _) pred =
3.48 @@ -87,7 +87,7 @@
3.49 else get_assumptions_ pt (p, Res)
3.50 in (bdv, pred) end
3.51 | mk_set _ _ _ l _ =
3.52 - error ("check_elementwise: no set " ^ term2str l);
3.53 + error ("check_elementwise: no set " ^ Celem.term2str l);
3.54
3.55 (* check a list (/set) of constants [c_1,..,c_n] for c_i:set (: in)*)
3.56 fun check_elementwise thy erls all_results (bdv, asm) =
3.57 @@ -142,7 +142,7 @@
3.58 in
3.59 case Specify.refine_ori oris pI of
3.60 SOME pblID =>
3.61 - Chead.Appl (Tac.Refine_Tacitly' (pI, pblID, e_domID, e_metID, [](*filled in specify*)))
3.62 + Chead.Appl (Tac.Refine_Tacitly' (pI, pblID, Celem.e_domID, Celem.e_metID, [](*filled in specify*)))
3.63 | NONE => Chead.Notappl ((Tac.tac2str (Tac.Refine_Tacitly pI)) ^ " not applicable")
3.64 end
3.65 | applicable_in (p, p_) pt (Tac.Refine_Problem pI) =
3.66 @@ -154,9 +154,9 @@
3.67 PblObj {origin= (_, (dI, _, _), _), spec= (dI', _, _), probl = itms, ...}
3.68 => (dI, dI', itms)
3.69 | _ => error "applicable_in Refine_Problem: uncovered case get_obj"
3.70 - val thy = if dI' = e_domID then dI else dI';
3.71 + val thy = if dI' = Celem.e_domID then dI else dI';
3.72 in
3.73 - case Specify.refine_pbl (assoc_thy thy) pI itms of
3.74 + case Specify.refine_pbl (Celem.assoc_thy thy) pI itms of
3.75 NONE => Chead.Notappl ((Tac.tac2str (Tac.Refine_Problem pI)) ^ " not applicable")
3.76 | SOME (rf as (pI', _)) =>
3.77 if pI' = pI
3.78 @@ -202,9 +202,9 @@
3.79 PblObj {origin = (oris, (dI, pI, _), _), spec = (dI', pI', _), probl = itms, ...}
3.80 => (oris, dI, pI, dI', pI', itms)
3.81 | _ => error "applicable_in Specify_Problem: uncovered case get_obj"
3.82 - val thy = assoc_thy (if dI' = e_domID then dI else dI');
3.83 + val thy = Celem.assoc_thy (if dI' = Celem.e_domID then dI else dI');
3.84 val {ppc, where_, prls, ...} = Specify.get_pbt pID;
3.85 - val pbl = if pI' = e_pblID andalso pI = e_pblID
3.86 + val pbl = if pI' = Celem.e_pblID andalso pI = Celem.e_pblID
3.87 then (false, (Generate.init_pbl ppc, []))
3.88 else Specify.match_itms_oris thy itms (ppc, where_, prls) oris;
3.89 in
3.90 @@ -225,7 +225,7 @@
3.91 val {where_, ...} = Specify.get_pbt pI
3.92 val pres = map (Model.mk_env probl |> subst_atomic) where_
3.93 val ctxt = if is_e_ctxt ctxt
3.94 - then assoc_thy dI |> Proof_Context.init_global |> Stool.insert_assumptions pres
3.95 + then Celem.assoc_thy dI |> Proof_Context.init_global |> Stool.insert_assumptions pres
3.96 else ctxt
3.97 (*TODO.WN110416 here do evalprecond according to fun check_preconds'
3.98 and then decide on Chead.Notappl/Appl accordingly once more.
3.99 @@ -237,7 +237,7 @@
3.100 | applicable_in (p, p_) _ (Tac.Check_Postcond pI) =
3.101 if member op = [Pbl, Met] p_
3.102 then Chead.Notappl ((Tac.tac2str (Tac.Check_Postcond pI)) ^ " not for pos " ^ pos'2str (p, p_))
3.103 - else Chead.Appl (Tac.Check_Postcond' (pI, (e_term, [(*fun solve assigns returnvalue of scr*)])))
3.104 + else Chead.Appl (Tac.Check_Postcond' (pI, (Celem.e_term, [(*fun solve assigns returnvalue of scr*)])))
3.105 | applicable_in _ _ (Tac.Take str) = Chead.Appl (Tac.Take' (TermC.str2term str)) (* always applicable ?*)
3.106 | applicable_in _ _ (Tac.Free_Solve) = Chead.Appl (Tac.Free_Solve') (* always applicable *)
3.107 | applicable_in (p, p_) pt (m as Tac.Rewrite_Inst (subs, thm'')) =
3.108 @@ -246,8 +246,8 @@
3.109 else
3.110 let
3.111 val pp = par_pblobj pt p;
3.112 - val thy' = (get_obj g_domID pt pp): theory';
3.113 - val thy = assoc_thy thy';
3.114 + val thy' = get_obj g_domID pt pp;
3.115 + val thy = Celem.assoc_thy thy';
3.116 val {rew_ord' = ro', erls = erls, ...} = Specify.get_met (get_obj g_metID pt pp);
3.117 val (f, _) = case p_ of (*p 12.4.00 unnecessary*)
3.118 Frm => (get_obj g_form pt p, p)
3.119 @@ -257,7 +257,7 @@
3.120 let
3.121 val subst = Selem.subs2subst thy subs;
3.122 in
3.123 - case Rewrite.rewrite_inst_ thy (assoc_rew_ord ro') erls false subst (snd thm'') f of
3.124 + case Rewrite.rewrite_inst_ thy (Celem.assoc_rew_ord ro') erls false subst (snd thm'') f of
3.125 SOME (f',asm) =>
3.126 Chead.Appl (Tac.Rewrite_Inst' (thy', ro', erls, false, subst, thm'', f, (f', asm)))
3.127 | NONE => Chead.Notappl ((fst thm'')^" not applicable")
3.128 @@ -270,7 +270,7 @@
3.129 else
3.130 let
3.131 val (msg, thy', ro, rls', _)= from_pblobj_or_detail_thm thm'' p pt;
3.132 - val thy = assoc_thy thy';
3.133 + val thy = Celem.assoc_thy thy';
3.134 val f = case p_ of
3.135 Frm => get_obj g_form pt p
3.136 | Res => (fst o (get_obj g_result pt)) p
3.137 @@ -278,7 +278,7 @@
3.138 in
3.139 if msg = "OK"
3.140 then
3.141 - case Rewrite.rewrite_ thy (assoc_rew_ord ro) rls' false (snd thm'') f of
3.142 + case Rewrite.rewrite_ thy (Celem.assoc_rew_ord ro) rls' false (snd thm'') f of
3.143 SOME (f',asm) => Chead.Appl (Tac.Rewrite' (thy', ro, rls', false, thm'', f, (f', asm)))
3.144 | NONE => Chead.Notappl ("'" ^ fst thm'' ^"' not applicable")
3.145 else Chead.Notappl msg
3.146 @@ -289,15 +289,15 @@
3.147 else
3.148 let
3.149 val pp = par_pblobj pt p;
3.150 - val thy' = (get_obj g_domID pt pp):theory';
3.151 - val thy = assoc_thy thy';
3.152 + val thy' = get_obj g_domID pt pp;
3.153 + val thy = Celem.assoc_thy thy';
3.154 val {rew_ord'=ro',erls=erls,...} = Specify.get_met (get_obj g_metID pt pp);
3.155 val (f, _) = case p_ of
3.156 Frm => (get_obj g_form pt p, p)
3.157 | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
3.158 | _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
3.159 in
3.160 - case Rewrite.rewrite_ thy (assoc_rew_ord ro') erls false (snd thm'') f of
3.161 + case Rewrite.rewrite_ thy (Celem.assoc_rew_ord ro') erls false (snd thm'') f of
3.162 SOME (f',asm) => Chead.Appl (Tac.Rewrite' (thy', ro', erls, false, thm'', f, (f', asm)))
3.163 | NONE => Chead.Notappl ("'" ^ fst thm'' ^ "' not applicable") end
3.164 | applicable_in (p, p_) pt (m as Tac.Detail_Set_Inst (subs, rls)) =
3.165 @@ -307,7 +307,7 @@
3.166 let
3.167 val pp = par_pblobj pt p;
3.168 val thy' = get_obj g_domID pt pp;
3.169 - val thy = assoc_thy thy';
3.170 + val thy = Celem.assoc_thy thy';
3.171 val f = case p_ of Frm => get_obj g_form pt p
3.172 | Res => (fst o (get_obj g_result pt)) p
3.173 | _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
3.174 @@ -326,7 +326,7 @@
3.175 let
3.176 val pp = par_pblobj pt p;
3.177 val thy' = get_obj g_domID pt pp;
3.178 - val thy = assoc_thy thy';
3.179 + val thy = Celem.assoc_thy thy';
3.180 val (f, _) = case p_ of
3.181 Frm => (get_obj g_form pt p, p)
3.182 | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
3.183 @@ -351,7 +351,7 @@
3.184 | Res => ((fst o (get_obj g_result pt)) p, lev_on p)
3.185 | _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
3.186 in
3.187 - case Rewrite.rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
3.188 + case Rewrite.rewrite_set_ (Celem.assoc_thy thy') false (assoc_rls rls) f of
3.189 SOME (f', asm)
3.190 => Chead.Appl (Tac.Rewrite_Set' (thy', false, assoc_rls rls, f, (f', asm)))
3.191 | NONE => Chead.Notappl (rls ^ " not applicable")
3.192 @@ -368,7 +368,7 @@
3.193 | Res => (fst o (get_obj g_result pt)) p
3.194 | _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
3.195 in
3.196 - case Rewrite.rewrite_set_ (assoc_thy thy') false (assoc_rls rls) f of
3.197 + case Rewrite.rewrite_set_ (Celem.assoc_thy thy') false (assoc_rls rls) f of
3.198 SOME (f',asm) => Chead.Appl (Tac.Detail_Set' (thy', false, assoc_rls rls, f, (f', asm)))
3.199 | NONE => Chead.Notappl (rls^" not applicable")
3.200 end
3.201 @@ -386,9 +386,9 @@
3.202 in
3.203 if msg = "OK"
3.204 then
3.205 - case Rewrite.calculate_ (assoc_thy thy') isa_fn f of
3.206 + case Rewrite.calculate_ (Celem.assoc_thy thy') isa_fn f of
3.207 SOME (f', (id, thm))
3.208 - => Chead.Appl (Tac.Calculate' (thy', op_, f, (f', (id, string_of_thmI thm))))
3.209 + => Chead.Appl (Tac.Calculate' (thy', op_, f, (f', (id, Celem.string_of_thmI thm))))
3.210 | NONE => Chead.Notappl ("'calculate "^op_^"' not applicable")
3.211 else Chead.Notappl msg
3.212 end
3.213 @@ -401,7 +401,7 @@
3.214 else
3.215 let
3.216 val pp = par_pblobj pt p
3.217 - val thy = assoc_thy (get_obj g_domID pt pp)
3.218 + val thy = Celem.assoc_thy (get_obj g_domID pt pp)
3.219 val f = case p_ of
3.220 Frm => get_obj g_form pt p
3.221 | Res => (fst o (get_obj g_result pt)) p
3.222 @@ -409,7 +409,7 @@
3.223 val {rew_ord',erls,...} = Specify.get_met (get_obj g_metID pt pp)
3.224 val subte = Selem.sube2subte sube
3.225 val subst = Selem.sube2subst thy sube
3.226 - val ro = assoc_rew_ord rew_ord'
3.227 + val ro = Celem.assoc_rew_ord rew_ord'
3.228 in
3.229 if foldl and_ (true, map TermC.contains_Var subte)
3.230 then (*1*)
3.231 @@ -433,12 +433,12 @@
3.232 then (*maybe Apply_Method has already been done FIXME.WN150511: declare_constraints*)
3.233 case get_obj g_env pt p of
3.234 SOME _ =>
3.235 - Chead.Appl (Tac.Subproblem' ((domID, pblID, e_metID), [],
3.236 - e_term, [], Selem.e_ctxt(*FIXME.WN150511*), LTool.subpbl domID pblID))
3.237 + Chead.Appl (Tac.Subproblem' ((domID, pblID, Celem.e_metID), [],
3.238 + Celem.e_term, [], Selem.e_ctxt(*FIXME.WN150511*), LTool.subpbl domID pblID))
3.239 | NONE => Chead.Notappl ((Tac.tac2str m)^" not for pos "^(pos'2str (p,p_)))
3.240 else (*somewhere later in the script*)
3.241 - Chead.Appl (Tac.Subproblem' ((domID, pblID, e_metID), [],
3.242 - e_term, [], Selem.e_ctxt, LTool.subpbl domID pblID))
3.243 + Chead.Appl (Tac.Subproblem' ((domID, pblID, Celem.e_metID), [],
3.244 + Celem.e_term, [], Selem.e_ctxt, LTool.subpbl domID pblID))
3.245 | applicable_in _ _ (Tac.End_Subproblem) =
3.246 error ("applicable_in: not impl. for " ^ Tac.tac2str Tac.End_Subproblem)
3.247 | applicable_in _ _ (Tac.CAScmd ct') =
3.248 @@ -458,7 +458,7 @@
3.249 | Res => ((fst o (get_obj g_result pt)) p, (lev_on o lev_dn o lev_on) p)
3.250 | _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
3.251 in (Chead.Appl (Tac.Begin_Trans' f))
3.252 - handle _ => error ("applicable_in: Begin_Trans finds syntaxerror in '" ^ term2str f ^ "'")
3.253 + handle _ => error ("applicable_in: Begin_Trans finds syntaxerror in '" ^ Celem.term2str f ^ "'")
3.254 end
3.255 | applicable_in (p, p_) pt (Tac.End_Trans) = (*TODO: check parent branches*)
3.256 if p_ = Res
3.257 @@ -478,15 +478,15 @@
3.258 else
3.259 let
3.260 val pp = par_pblobj pt p;
3.261 - val thy' = (get_obj g_domID pt pp):theory';
3.262 - val thy = assoc_thy thy'
3.263 + val thy' = get_obj g_domID pt pp;
3.264 + val thy = Celem.assoc_thy thy'
3.265 val metID = (get_obj g_metID pt pp)
3.266 val {crls,...} = Specify.get_met metID
3.267 val (f, asm) = case p_ of
3.268 Frm => (get_obj g_form pt p , [])
3.269 | Res => get_obj g_result pt p
3.270 | _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
3.271 - val vp = (thy2ctxt thy, pred) |-> TermC.parseNEW |> the |> mk_set thy pt p f;
3.272 + val vp = (Celem.thy2ctxt thy, pred) |-> TermC.parseNEW |> the |> mk_set thy pt p f;
3.273 in case f of
3.274 Const ("List.list.Cons",_) $ _ $ _ =>
3.275 Chead.Appl (Tac.Check_elementwise' (f, pred, check_elementwise thy crls f vp))
3.276 @@ -494,7 +494,7 @@
3.277 Chead.Appl (Tac.Check_elementwise' (f, pred, (f,asm)))
3.278 | Const ("List.list.Nil",_) =>
3.279 Chead.Appl (Tac.Check_elementwise' (f, pred, (f, asm)))
3.280 - | _ => Chead.Notappl ("Check_elementwise not appl.: " ^ term2str f ^ " should be constants")
3.281 + | _ => Chead.Notappl ("Check_elementwise not appl.: " ^ Celem.term2str f ^ " should be constants")
3.282 end
3.283 | applicable_in (p, p_) pt Tac.Or_to_List =
3.284 if member op = [Pbl, Met] p_
3.285 @@ -507,7 +507,7 @@
3.286 | _ => error ("applicable_in: call by " ^ pos'2str (p, p_));
3.287 in (let val ls = or2list f
3.288 in Chead.Appl (Tac.Or_to_List' (f, ls)) end)
3.289 - handle _ => Chead.Notappl ("'Or_to_List' not applicable to "^(term2str f))
3.290 + handle _ => Chead.Notappl ("'Or_to_List' not applicable to " ^ Celem.term2str f)
3.291 end
3.292 | applicable_in _ _ Tac.Collect_Trues =
3.293 error ("applicable_in: not impl. for " ^ Tac.tac2str Tac.Collect_Trues)
3.294 @@ -515,8 +515,8 @@
3.295 | applicable_in (p, p_) pt (Tac.Tac id) =
3.296 let
3.297 val pp = par_pblobj pt p;
3.298 - val thy' = (get_obj g_domID pt pp):theory';
3.299 - val thy = assoc_thy thy';
3.300 + val thy' = get_obj g_domID pt pp;
3.301 + val thy = Celem.assoc_thy thy';
3.302 val f = case p_ of
3.303 Frm => get_obj g_form pt p
3.304 | Pbl => error "applicable_in (p,Pbl) pt (Tac id): not at Pbl"
3.305 @@ -525,18 +525,18 @@
3.306 in case id of
3.307 "subproblem_equation_dummy" =>
3.308 if TermC.is_expliceq f
3.309 - then Chead.Appl (Tac.Tac_ (thy, term2str f, id, "subproblem_equation_dummy (" ^ term2str f ^ ")"))
3.310 + then Chead.Appl (Tac.Tac_ (thy, Celem.term2str f, id, "subproblem_equation_dummy (" ^ Celem.term2str f ^ ")"))
3.311 else Chead.Notappl "applicable only to equations made explicit"
3.312 | "solve_equation_dummy" =>
3.313 - let val (id', f') = split_dummy (term2str f);
3.314 + let val (id', f') = split_dummy (Celem.term2str f);
3.315 in
3.316 if id' <> "subproblem_equation_dummy"
3.317 then Chead.Notappl "no subproblem"
3.318 - else if (thy2ctxt thy, f') |-> TermC.parseNEW |> the |> TermC.is_expliceq
3.319 - then Chead.Appl (Tac.Tac_ (thy, term2str f, id, "[" ^ f' ^ "]"))
3.320 + else if (Celem.thy2ctxt thy, f') |-> TermC.parseNEW |> the |> TermC.is_expliceq
3.321 + then Chead.Appl (Tac.Tac_ (thy, Celem.term2str f, id, "[" ^ f' ^ "]"))
3.322 else error ("applicable_in: f= " ^ f')
3.323 end
3.324 - | _ => Chead.Appl (Tac.Tac_ (thy, term2str f, id, term2str f))
3.325 + | _ => Chead.Appl (Tac.Tac_ (thy, Celem.term2str f, id, Celem.term2str f))
3.326 end
3.327 | applicable_in _ _ Tac.End_Proof' = Chead.Appl Tac.End_Proof''
3.328 | applicable_in _ _ m = error ("applicable_in called for " ^ Tac.tac2str m);
4.1 --- a/src/Tools/isac/Interpret/calchead.sml Tue Mar 13 15:04:27 2018 +0100
4.2 +++ b/src/Tools/isac/Interpret/calchead.sml Thu Mar 15 10:17:44 2018 +0100
4.3 @@ -13,29 +13,29 @@
4.4 val specify : Tac.tac_ -> Ctree.pos' -> Ctree.cid -> Ctree.ctree ->
4.5 Ctree.pos' * (Ctree.pos' * Selem.istate) * Generate.mout * Tac.tac * Selem.safe * Ctree.ctree
4.6 val nxt_specif : Tac.tac -> Ctree.state -> calcstate'
4.7 - val nxt_spec : Ctree.pos_ -> bool -> Model.ori list -> spec -> Model.itm list * Model.itm list ->
4.8 - (string * (term * 'a)) list * (string * (term * 'b)) list -> spec -> Ctree.pos_ * Tac.tac
4.9 + val nxt_spec : Ctree.pos_ -> bool -> Model.ori list -> Celem.spec -> Model.itm list * Model.itm list ->
4.10 + (string * (term * 'a)) list * (string * (term * 'b)) list -> Celem.spec -> Ctree.pos_ * Tac.tac
4.11
4.12 val reset_calchead : Ctree.state -> Ctree.state
4.13 val get_ocalhd : Ctree.state -> Ctree.ocalhd
4.14 - val ocalhd_complete : Model.itm list -> (bool * term) list -> domID * pblID * metID -> bool
4.15 + val ocalhd_complete : Model.itm list -> (bool * term) list -> Celem.domID * Celem.pblID * Celem.metID -> bool
4.16 val all_modspec : Ctree.state -> Ctree.state
4.17
4.18 - val complete_metitms : Model.ori list -> Model.itm list -> Model.itm list -> pat list -> Model.itm list
4.19 + val complete_metitms : Model.ori list -> Model.itm list -> Model.itm list -> Celem.pat list -> Model.itm list
4.20 val insert_ppc' : Model.itm -> Model.itm list -> Model.itm list
4.21
4.22 val complete_mod : Ctree.state -> Ctree.state
4.23 val is_complete_mod : Ctree.state -> bool
4.24 val complete_spec : Ctree.state -> Ctree.state
4.25 val is_complete_spec : Ctree.state -> bool
4.26 - val some_spec : spec -> spec -> spec
4.27 + val some_spec : Celem.spec -> Celem.spec -> Celem.spec
4.28 (* these could go to Ctree ..*)
4.29 val show_pt : Ctree.ctree -> unit
4.30 val pt_extract : Ctree.state -> Ctree.ptform * Tac.tac option * term list
4.31 val get_interval : Ctree.pos' -> Ctree.pos' -> int -> Ctree.ctree -> (Ctree.pos' * term) list
4.32
4.33 - val match_ags : theory -> pat list -> term list -> Model.ori list
4.34 - val match_ags_msg : pblID -> term -> term list -> unit
4.35 + val match_ags : theory -> Celem.pat list -> term list -> Model.ori list
4.36 + val match_ags_msg : Celem.pblID -> term -> term list -> unit
4.37 val oris2fmz_vals : Model.ori list -> string list * term list
4.38 val vars_of_pbl_' : ('a * ('b * term)) list -> term list
4.39 val is_known : Proof.context -> string -> Model.ori list -> term -> string * Model.ori * term list
4.40 @@ -115,30 +115,30 @@
4.41 fun ocalhd_complete its pre (dI, pI, mI) =
4.42 foldl and_ (true, map #3 its) andalso
4.43 foldl and_ (true, map #1 pre) andalso
4.44 - dI<>e_domID andalso pI<>e_pblID andalso mI<>e_metID
4.45 + dI <> Celem.e_domID andalso pI <> Celem.e_pblID andalso mI <> Celem.e_metID
4.46
4.47 (* ["BOOL (1+x=2)","REAL x"] --match_ags--> oris
4.48 --oris2fmz_vals--> ["equality (1+x=2)","boundVariable x","solutions L"] *)
4.49 fun oris2fmz_vals oris =
4.50 let fun ori2fmz_vals (_, _, _, dsc, ts) =
4.51 - ((term2str o Model.comp_dts') (dsc, ts), last_elem ts)
4.52 - handle _ => error ("ori2fmz_env called with " ^ terms2str ts)
4.53 + ((Celem.term2str o Model.comp_dts') (dsc, ts), last_elem ts)
4.54 + handle _ => error ("ori2fmz_env called with " ^ Celem.terms2str ts)
4.55 in (split_list o (map ori2fmz_vals)) oris end
4.56
4.57 (* make a term 'typeless' for comparing with another 'typeless' term;
4.58 'type-less' usually is illtyped *)
4.59 -fun typeless (Const (s, _)) = (Const (s, e_type))
4.60 - | typeless (Free (s, _)) = (Free (s, e_type))
4.61 - | typeless (Var (n, _)) = (Var (n, e_type))
4.62 +fun typeless (Const (s, _)) = (Const (s, Celem.e_type))
4.63 + | typeless (Free (s, _)) = (Free (s, Celem.e_type))
4.64 + | typeless (Var (n, _)) = (Var (n, Celem.e_type))
4.65 | typeless (Bound i) = (Bound i)
4.66 - | typeless (Abs (s, _,t)) = Abs(s, e_type, typeless t)
4.67 + | typeless (Abs (s, _,t)) = Abs(s, Celem.e_type, typeless t)
4.68 | typeless (t1 $ t2) = (typeless t1) $ (typeless t2)
4.69
4.70 (* to an input (d,ts) find the according ori and insert the ts)
4.71 WN.11.03: + dont take first inter<>[] *)
4.72 fun seek_oridts ctxt sel (d, ts) [] =
4.73 ("seek_oridts: input ('" ^
4.74 - (term_to_string' ctxt (Model.comp_dts (d, ts))) ^ "') not found in oris (typed)",
4.75 + (Celem.term_to_string' ctxt (Model.comp_dts (d, ts))) ^ "') not found in oris (typed)",
4.76 (0, [], sel, d, ts),
4.77 [])
4.78 | seek_oridts ctxt sel (d, ts) ((id, vat, sel', d', ts') :: oris) =
4.79 @@ -148,14 +148,14 @@
4.80
4.81 (* to an input (_,ts) find the according ori and insert the ts *)
4.82 fun seek_orits ctxt _ ts [] =
4.83 - ("seek_orits: input (_, '" ^ strs2str (map (term_to_string' ctxt) ts) ^
4.84 + ("seek_orits: input (_, '" ^ strs2str (map (Celem.term_to_string' ctxt) ts) ^
4.85 "') not found in oris (typed)", Model.e_ori, [])
4.86 | seek_orits ctxt sel ts ((id, vat, sel', d, ts') :: oris) =
4.87 if sel = sel' andalso (inter op = ts ts') <> []
4.88 then
4.89 if sel = sel'
4.90 then ("", (id, vat, sel, d, inter op = ts ts'), ts')
4.91 - else (((strs2str' o map (term_to_string' ctxt)) ts) ^ " not for " ^ sel, Model.e_ori, [])
4.92 + else (((strs2str' o map (Celem.term_to_string' ctxt)) ts) ^ " not for " ^ sel, Model.e_ori, [])
4.93 else seek_orits ctxt sel ts oris
4.94
4.95 (* find_first item with #1 equal to id *)
4.96 @@ -213,13 +213,13 @@
4.97
4.98 (* get the first term in ts from ori *)
4.99 fun getr_ct thy (_, _, fd, d, ts) =
4.100 - (fd, ((term_to_string''' thy) o Model.comp_dts) (d,[hd ts]) : cterm')
4.101 + (fd, ((Celem.term_to_string''' thy) o Model.comp_dts) (d,[hd ts]))
4.102
4.103 (* get a term from ori, notyet input in itm.
4.104 the term from ori is thrown back to a string in order to reuse
4.105 machinery for immediate input by the user. *)
4.106 fun geti_ct thy (_, _, _, d, ts) (_, _, _, fd, itm_) =
4.107 - (fd, ((term_to_string''' thy) o Model.comp_dts) (d, subtract op = (Model.ts_in itm_) ts) : cterm')
4.108 + (fd, ((Celem.term_to_string''' thy) o Model.comp_dts) (d, subtract op = (Model.ts_in itm_) ts))
4.109
4.110 (* in FE dsc, not dat: this is in itms ...*)
4.111 fun is_untouched (_, _, false, _, Model.Inc ((_, []), _)) = true
4.112 @@ -240,7 +240,7 @@
4.113 case find_first (test_d d) itms of SOME _ => true | NONE => false
4.114 in
4.115 case filter_out (is_elem itms) pbt of
4.116 - (f, (d, _)) :: _ => SOME (f : string, ((term_to_string''' thy) o Model.comp_dts) (d, []) : cterm')
4.117 + (f, (d, _)) :: _ => SOME (f, ((Celem.term_to_string''' thy) o Model.comp_dts) (d, []))
4.118 | _ => NONE
4.119 end
4.120 | nxt_add thy oris _ itms =
4.121 @@ -293,36 +293,36 @@
4.122 (pbt, mpc) problem type, guard of method
4.123 *)
4.124 fun nxt_spec Pbl preok oris (dI', pI', mI') (pbl, met) (pbt, mpc) (dI, pI, mI) =
4.125 - (if dI' = e_domID andalso dI = e_domID then (Pbl, Tac.Specify_Theory dI')
4.126 - else if pI' = e_pblID andalso pI = e_pblID then (Pbl, Tac.Specify_Problem pI')
4.127 + (if dI' = Celem.e_domID andalso dI = Celem.e_domID then (Pbl, Tac.Specify_Theory dI')
4.128 + else if pI' = Celem.e_pblID andalso pI = Celem.e_pblID then (Pbl, Tac.Specify_Problem pI')
4.129 else
4.130 case find_first (is_error o #5) pbl of
4.131 SOME (_, _, _, fd, itm_) =>
4.132 - (Pbl, mk_delete (assoc_thy (if dI = e_domID then dI' else dI)) fd itm_)
4.133 + (Pbl, mk_delete (Celem.assoc_thy (if dI = Celem.e_domID then dI' else dI)) fd itm_)
4.134 | NONE =>
4.135 - (case nxt_add (assoc_thy (if dI = e_domID then dI' else dI)) oris pbt pbl of
4.136 + (case nxt_add (Celem.assoc_thy (if dI = Celem.e_domID then dI' else dI)) oris pbt pbl of
4.137 SOME (fd,ct') => (Pbl, mk_additem fd ct')
4.138 | NONE => (*pbl-items complete*)
4.139 if not preok then (Pbl, Tac.Refine_Problem pI')
4.140 - else if dI = e_domID then (Pbl, Tac.Specify_Theory dI')
4.141 - else if pI = e_pblID then (Pbl, Tac.Specify_Problem pI')
4.142 - else if mI = e_metID then (Pbl, Tac.Specify_Method mI')
4.143 + else if dI = Celem.e_domID then (Pbl, Tac.Specify_Theory dI')
4.144 + else if pI = Celem.e_pblID then (Pbl, Tac.Specify_Problem pI')
4.145 + else if mI = Celem.e_metID then (Pbl, Tac.Specify_Method mI')
4.146 else
4.147 case find_first (is_error o #5) met of
4.148 - SOME (_, _, _, fd, itm_) => (Met, mk_delete (assoc_thy dI) fd itm_)
4.149 + SOME (_, _, _, fd, itm_) => (Met, mk_delete (Celem.assoc_thy dI) fd itm_)
4.150 | NONE =>
4.151 - (case nxt_add (assoc_thy dI) oris mpc met of
4.152 + (case nxt_add (Celem.assoc_thy dI) oris mpc met of
4.153 SOME (fd, ct') => (Met, mk_additem fd ct') (*30.8.01: pre?!?*)
4.154 | NONE => (Met, Tac.Apply_Method mI))))
4.155 | nxt_spec Met preok oris (dI', pI', _) (_, met) (_ ,mpc) (dI, pI, mI) =
4.156 (case find_first (is_error o #5) met of
4.157 - SOME (_,_,_,fd,itm_) => (Met, mk_delete (assoc_thy (if dI=e_domID then dI' else dI)) fd itm_)
4.158 + SOME (_,_,_,fd,itm_) => (Met, mk_delete (Celem.assoc_thy (if dI = Celem.e_domID then dI' else dI)) fd itm_)
4.159 | NONE =>
4.160 - case nxt_add (assoc_thy (if dI=e_domID then dI' else dI))oris mpc met of
4.161 + case nxt_add (Celem.assoc_thy (if dI = Celem.e_domID then dI' else dI)) oris mpc met of
4.162 SOME (fd,ct') => (Met, mk_additem fd ct')
4.163 | NONE =>
4.164 - (if dI = e_domID then (Met, Tac.Specify_Theory dI')
4.165 - else if pI = e_pblID then (Met, Tac.Specify_Problem pI')
4.166 + (if dI = Celem.e_domID then (Met, Tac.Specify_Theory dI')
4.167 + else if pI = Celem.e_pblID then (Met, Tac.Specify_Problem pI')
4.168 else if not preok then (Met, Tac.Specify_Method mI)
4.169 else (Met, Tac.Apply_Method mI)))
4.170 | nxt_spec p _ _ _ _ _ _ = error ("nxt_spec: uncovered case with " ^ pos_2str p)
4.171 @@ -377,19 +377,19 @@
4.172 let val ts' = inter op = (Model.ts_in itm_) ts
4.173 in
4.174 if subset op = (ts, ts')
4.175 - then (((strs2str' o map (term_to_string' ctxt)) ts') ^ " already input", Model.e_itm) (*2*)
4.176 + then (((strs2str' o map (Celem.term_to_string' ctxt)) ts') ^ " already input", Model.e_itm) (*2*)
4.177 else ("", ori_2itm itm_ pid all (i,v,f,d, subtract op = ts' ts)) (*3,4*)
4.178 end
4.179 - | NONE => ("", ori_2itm (Model.Inc ((e_term, []), (pid, []))) pid all (i, v, f, d, ts))) (*1*)
4.180 - | NONE => ("", ori_2itm (Model.Sup (d, ts)) e_term all (i, v, f, d, ts))
4.181 + | NONE => ("", ori_2itm (Model.Inc ((Celem.e_term, []), (pid, []))) pid all (i, v, f, d, ts))) (*1*)
4.182 + | NONE => ("", ori_2itm (Model.Sup (d, ts)) Celem.e_term all (i, v, f, d, ts))
4.183
4.184 fun test_types ctxt (d,ts) =
4.185 let
4.186 val opt = (try Model.comp_dts) (d, ts)
4.187 val msg = case opt of
4.188 SOME _ => ""
4.189 - | NONE => (term_to_string' ctxt d ^ " " ^
4.190 - (strs2str' o map (term_to_string' ctxt)) ts ^ " is illtyped")
4.191 + | NONE => (Celem.term_to_string' ctxt d ^ " " ^
4.192 + (strs2str' o map (Celem.term_to_string' ctxt)) ts ^ " is illtyped")
4.193 in msg end
4.194
4.195 (* is the input term t known in oris ?
4.196 @@ -397,7 +397,7 @@
4.197 return _all_ terms already input to this item (e.g. valuesFor a,b) *)
4.198 fun is_known ctxt sel ori t =
4.199 let
4.200 - val _ = tracing ("RM is_known: t=" ^ term2str t)
4.201 + val _ = tracing ("RM is_known: t=" ^ Celem.term2str t)
4.202 val ots = (distinct o flat o (map #5)) ori
4.203 val oids = ((map (fst o dest_Free)) o distinct o flat o (map TermC.vars)) ots
4.204 val (d, ts) = Model.split_dts t
4.205 @@ -406,10 +406,10 @@
4.206 if (subtract op = oids ids) <> []
4.207 then (("identifiers "^(strs2str' (subtract op = oids ids)) ^ " not in example"), Model.e_ori, [])
4.208 else
4.209 - if d = e_term
4.210 + if d = Celem.e_term
4.211 then
4.212 if not (subset op = (map typeless ts, map typeless ots))
4.213 - then ("terms '" ^ (strs2str' o (map (term_to_string' ctxt))) ts ^
4.214 + then ("terms '" ^ (strs2str' o (map (Celem.term_to_string' ctxt))) ts ^
4.215 "' not in example (typeless)", Model.e_ori, [])
4.216 else
4.217 (case seek_orits ctxt sel ts ori of
4.218 @@ -421,7 +421,7 @@
4.219 else
4.220 if member op = (map #4 ori) d
4.221 then seek_oridts ctxt sel (d, ts) ori
4.222 - else (term_to_string' ctxt d ^ " not in example", (0, [], sel, d, ts), [])
4.223 + else (Celem.term_to_string' ctxt d ^ " not in example", (0, [], sel, d, ts), [])
4.224 end
4.225
4.226
4.227 @@ -441,7 +441,7 @@
4.228 | SOME t =>
4.229 let val (d, ts) = Model.split_dts t
4.230 in
4.231 - if d = e_term
4.232 + if d = Celem.e_term
4.233 then Add (i, [], false, sel, Model.Mis (Specify.dsc_unknown, hd ts))
4.234 else
4.235 (case find_first (eq1 d) pbt of
4.236 @@ -497,7 +497,7 @@
4.237 (* split type-wrapper from scr-arg and build part of an ori;
4.238 an type-error is reported immediately, raises an exn,
4.239 subsequent handling of exn provides 2nd part of error message *)
4.240 -fun mtc thy ((str, (dsc, _)):pat) (ty $ var) =
4.241 +fun mtc thy (str, (dsc, _)) (ty $ var) =
4.242 ((Thm.global_cterm_of thy (dsc $ var);(*type check*)
4.243 SOME (([1], str, dsc, (*[var]*)
4.244 Model.split_dts' (dsc, var))) (*:ori without leading #*))
4.245 @@ -505,23 +505,23 @@
4.246 (tracing (dashs 70 ^ "\n"
4.247 ^ "*** ERROR while creating the items for the model of the ->problem\n"
4.248 ^ "*** from the ->stac with ->typeconstructor in arglist:\n"
4.249 - ^ "*** item (->description ->value): " ^ term2str dsc ^ " " ^ term2str var ^ "\n"
4.250 + ^ "*** item (->description ->value): " ^ Celem.term2str dsc ^ " " ^ Celem.term2str var ^ "\n"
4.251 ^ "*** description: " ^ TermC.term_detail2str dsc
4.252 ^ "*** value: " ^ TermC.term_detail2str var
4.253 ^ "*** typeconstructor in script: " ^ TermC.term_detail2str ty
4.254 - ^ "*** checked by theory: " ^ theory2str thy ^ "\n"
4.255 + ^ "*** checked by theory: " ^ Celem.theory2str thy ^ "\n"
4.256 ^ "*** " ^ dots 66);
4.257 writeln (@{make_string} e);
4.258 Exn.reraise e; (*raise ERROR "actual args do not match formal args";FIXXXME.WN100916*)
4.259 NONE))
4.260 - | mtc _ _ t = error ("mtc: uncovered case with" ^ term2str t)
4.261 + | mtc _ _ t = error ("mtc: uncovered case with" ^ Celem.term2str t)
4.262
4.263 (* match each pat of the model-pattern with an actual argument;
4.264 precondition: copy-named vars are filtered out *)
4.265 -fun matc _ ([]:pat list) _ oris = oris
4.266 +fun matc _ [] _ oris = oris
4.267 | matc _ pbt [] _ =
4.268 (tracing (dashs 70);
4.269 - error ("actual arg(s) missing for '" ^ pats2str pbt ^ "' i.e. should be 'copy-named' by '*_._'"))
4.270 + error ("actual arg(s) missing for '" ^ Celem.pats2str pbt ^ "' i.e. should be 'copy-named' by '*_._'"))
4.271 | matc thy ((p as (_, (_, t))) :: pbt) (a :: ags) oris =
4.272 (*del?..*)if (is_copy_named_idstr o TermC.free2str) t then oris
4.273 else(*..del?*)
4.274 @@ -536,7 +536,7 @@
4.275 by use of oris relating "v_v'i'" (is_copy_named!) to "v_v"
4.276 e.g. (v_v, x) & (v_v'i', ?) --> (v_v'i', x_i),
4.277 but leave is_copy_named_generating as is, e.t. ss''' *)
4.278 -fun cpy_nam (pbt: pat list) oris (p as (field, (dsc, t)): pat) =
4.279 +fun cpy_nam pbt oris (p as (field, (dsc, t))) =
4.280 (if is_copy_named_generating p
4.281 then (*WN051014 kept strange old code ...*)
4.282 let fun sel (_,_,d,ts) = Model.comp_ts (d, ts)
4.283 @@ -547,14 +547,14 @@
4.284 val cy_ext = (TermC.free2str o the) (assoc (vars' ~~ vals, cy')) ^ "_" ^ ext
4.285 in ([1], field, dsc, [TermC.mk_free (type_of t) cy_ext]) end
4.286 else ([1], field, dsc, [t])
4.287 - ) handle _ => error ("cpy_nam: for "^(term2str t))
4.288 + ) handle _ => error ("cpy_nam: for "^ Celem.term2str t)
4.289
4.290 (* match the actual arguments of a SubProblem with a model-pattern
4.291 and create an ori list (in root-pbl created from formalization).
4.292 expects ags:pats = 1:1, while copy-named are filtered out of pats;
4.293 if no 1:1 the exn raised by matc/mtc and handled at call.
4.294 copy-named pats are appended in order to get them into the model-items *)
4.295 -fun match_ags thy (pbt: pat list) ags =
4.296 +fun match_ags thy pbt ags =
4.297 let fun flattup (i,(var,bool,str,itm_)) = (i,var,bool,str,itm_)
4.298 val pbt' = filter_out is_copy_named pbt
4.299 val cy = filter is_copy_named pbt
4.300 @@ -567,11 +567,11 @@
4.301 fun match_ags_msg pI stac ags =
4.302 let
4.303 val pats = (#ppc o Specify.get_pbt) pI
4.304 - val msg = (dots 70^"\n"
4.305 - ^ "*** problem "^strs2str pI ^ " has the ...\n"
4.306 - ^ "*** model-pattern "^pats2str pats ^ "\n"
4.307 - ^ "*** stac '"^term2str stac ^ "' has the ...\n"
4.308 - ^ "*** arg-list "^terms2str ags ^ "\n"
4.309 + val msg = (dots 70 ^ "\n"
4.310 + ^ "*** problem " ^ strs2str pI ^ " has the ...\n"
4.311 + ^ "*** model-pattern " ^ Celem.pats2str pats ^ "\n"
4.312 + ^ "*** stac '" ^ Celem.term2str stac ^ "' has the ...\n"
4.313 + ^ "*** arg-list " ^ Celem.terms2str ags ^ "\n"
4.314 ^ dashs 70)
4.315 (*WN100921 ^^^^ expect TYPE errormsg below; lost with Isa09*)
4.316 in tracing msg end
4.317 @@ -585,7 +585,7 @@
4.318 fun overwrite_ppc thy itm ppc =
4.319 let
4.320 fun repl _ (_, _, _, _, itm_) [] =
4.321 - error ("overwrite_ppc: " ^ (Model.itm_2str_ (thy2ctxt thy) itm_) ^ " not found")
4.322 + error ("overwrite_ppc: " ^ (Model.itm_2str_ (Celem.thy2ctxt thy) itm_) ^ " not found")
4.323 | repl ppc' itm (p :: ppc) =
4.324 if (#1 itm) = (#1 p)
4.325 then ppc' @ [itm] @ ppc
4.326 @@ -611,7 +611,7 @@
4.327
4.328 (* output the headline to a ppc *)
4.329 fun header p_ pI mI =
4.330 - case p_ of Pbl => Generate.Problem (if pI = e_pblID then [] else pI)
4.331 + case p_ of Pbl => Generate.Problem (if pI = Celem.e_pblID then [] else pI)
4.332 | Met => Generate.Method mI
4.333 | pos => error ("header called with "^ pos_2str pos)
4.334
4.335 @@ -621,9 +621,9 @@
4.336 (PblObj {meth = met, origin = (oris, (dI', pI', mI'),_), probl = pbl, spec = (dI, pI, mI), ctxt, ...})
4.337 => (met, oris, dI', pI', mI', pbl, dI ,pI, mI, ctxt)
4.338 | _ => error "specify_additem: uncovered case of get_obj I pt p"
4.339 - val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI
4.340 - val cpI = if pI = e_pblID then pI' else pI
4.341 - val cmI = if mI = e_metID then mI' else mI
4.342 + val thy = if dI = Celem.e_domID then Celem.assoc_thy dI' else Celem.assoc_thy dI
4.343 + val cpI = if pI = Celem.e_pblID then pI' else pI
4.344 + val cmI = if mI = Celem.e_metID then mI' else mI
4.345 val {ppc, pre, prls, ...} = Specify.get_met cmI
4.346 in
4.347 case appl_add ctxt sel oris met ppc ct of
4.348 @@ -661,9 +661,9 @@
4.349 (PblObj {meth = met, origin = (oris, (dI', pI', mI'),_), probl = pbl, spec = (dI, pI, mI), ctxt, ...})
4.350 => (met, oris, dI', pI', mI', pbl, dI ,pI, mI, ctxt)
4.351 | _ => error "specify_additem Frm, Pbl: uncovered case of get_obj I pt p"
4.352 - val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI
4.353 - val cpI = if pI = e_pblID then pI' else pI
4.354 - val cmI = if mI = e_metID then mI' else mI
4.355 + val thy = if dI = Celem.e_domID then Celem.assoc_thy dI' else Celem.assoc_thy dI
4.356 + val cpI = if pI = Celem.e_pblID then pI' else pI
4.357 + val cmI = if mI = Celem.e_metID then mI' else mI
4.358 val {ppc, where_, prls, ...} = Specify.get_pbt cpI
4.359 in
4.360 case appl_add ctxt sel oris pbl ppc ct of
4.361 @@ -699,24 +699,24 @@
4.362
4.363 fun specify (Tac.Init_Proof' (fmz, spec' as (dI', pI', mI'))) _ _ _ =
4.364 let (* either """"""""""""""" all empty or complete *)
4.365 - val thy = assoc_thy dI'
4.366 + val thy = Celem.assoc_thy dI'
4.367 val (oris, ctxt) =
4.368 - if dI' = e_domID orelse pI' = e_pblID (*andalso? WN110511*)
4.369 + if dI' = Celem.e_domID orelse pI' = Celem.e_pblID (*andalso? WN110511*)
4.370 then ([], Selem.e_ctxt)
4.371 else pI' |> #ppc o Specify.get_pbt |> Specify.prep_ori fmz thy
4.372 val (pt, _) = cappend_problem e_ctree [] (Selem.e_istate, ctxt) (fmz, spec')
4.373 - (oris, (dI',pI',mI'), e_term)
4.374 + (oris, (dI',pI',mI'), Celem.e_term)
4.375 val pt = update_ctxt pt [] ctxt
4.376 val (pbl, pre) = ([], [])
4.377 in
4.378 case mI' of
4.379 ["no_met"] =>
4.380 (([], Pbl), (([], Pbl), Selem.Uistate),
4.381 - Generate.PpcKF (Generate.Problem [], Specify.itms2itemppc (assoc_thy dI') pbl pre),
4.382 + Generate.PpcKF (Generate.Problem [], Specify.itms2itemppc (Celem.assoc_thy dI') pbl pre),
4.383 Tac.Refine_Tacitly pI', Selem.Safe, pt)
4.384 | _ =>
4.385 (([], Pbl), (([], Pbl), Selem.Uistate),
4.386 - Generate.PpcKF (Generate.Problem [], Specify.itms2itemppc (assoc_thy dI') pbl pre),
4.387 + Generate.PpcKF (Generate.Problem [], Specify.itms2itemppc (Celem.assoc_thy dI') pbl pre),
4.388 Tac.Model_Problem, Selem.Safe, pt)
4.389 end
4.390 (* ONLY for STARTING modeling phase *)
4.391 @@ -726,8 +726,8 @@
4.392 PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, _, _), ctxt, ...} =>
4.393 (oris, dI',pI',mI', dI, ctxt)
4.394 | _ => error "specify (Model_Problem': uncovered case get_obj"
4.395 - val thy' = if dI = e_domID then dI' else dI
4.396 - val thy = assoc_thy thy'
4.397 + val thy' = if dI = Celem.e_domID then dI' else dI
4.398 + val thy = Celem.assoc_thy thy'
4.399 val {ppc, prls, where_, ...} = Specify.get_pbt pI'
4.400 val pre = Stool.check_preconds thy prls where_ pbl
4.401 val pb = foldl and_ (true, map fst pre)
4.402 @@ -737,7 +737,7 @@
4.403 (ppc,(#ppc o Specify.get_met) mI') (dI',pI',mI');
4.404 in
4.405 ((p, Pbl), ((p, p_), Selem.Uistate),
4.406 - Generate.PpcKF (Generate.Problem pI', Specify.itms2itemppc (assoc_thy dI') pbl pre),
4.407 + Generate.PpcKF (Generate.Problem pI', Specify.itms2itemppc (Celem.assoc_thy dI') pbl pre),
4.408 nxt, Selem.Safe, pt)
4.409 end
4.410 (* called only if no_met is specified *)
4.411 @@ -747,19 +747,19 @@
4.412 PblObj {origin= (_, (dI', _, _), _), ctxt, ...} => (dI', ctxt)
4.413 | _ => error "specify (Refine_Tacitly': uncovered case get_obj"
4.414 val {met, thy,...} = Specify.get_pbt pIre
4.415 - val (domID, metID) = (string_of_thy thy, if length met = 0 then e_metID else hd met)
4.416 + val (domID, metID) = (Celem.string_of_thy thy, if length met = 0 then Celem.e_metID else hd met)
4.417 val ((p,_), _, _, pt) =
4.418 Generate.generate1 thy (Tac.Refine_Tacitly' (pI, pIre, domID, metID, [(*pbl*)])) (Selem.Uistate, ctxt) pos pt
4.419 val (pbl, pre, _) = ([], [], false)
4.420 in ((p, Pbl), (pos, Selem.Uistate),
4.421 - Generate.PpcKF (Generate.Problem pIre, Specify.itms2itemppc (assoc_thy dI') pbl pre),
4.422 + Generate.PpcKF (Generate.Problem pIre, Specify.itms2itemppc (Celem.assoc_thy dI') pbl pre),
4.423 Tac.Model_Problem, Selem.Safe, pt)
4.424 end
4.425 | specify (Tac.Refine_Problem' rfd) pos _ pt =
4.426 let
4.427 val ctxt = get_ctxt pt pos
4.428 val (pos, _, _, pt) =
4.429 - Generate.generate1 (assoc_thy "Isac") (Tac.Refine_Problem' rfd) (Selem.Uistate, ctxt) pos pt
4.430 + Generate.generate1 (Celem.assoc_thy "Isac") (Tac.Refine_Problem' rfd) (Selem.Uistate, ctxt) pos pt
4.431 in
4.432 (pos(*p,Pbl*), (pos(*p,Pbl*), Selem.Uistate), Generate.RefinedKF rfd, Tac.Model_Problem, Selem.Safe, pt)
4.433 end
4.434 @@ -770,13 +770,13 @@
4.435 PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, _, mI), ctxt, meth = met, ...} =>
4.436 (oris, dI', pI', mI', dI, mI, ctxt, met)
4.437 | _ => error "specify (Specify_Problem': uncovered case get_obj"
4.438 - val thy = assoc_thy dI
4.439 + val thy = Celem.assoc_thy dI
4.440 val (p, pt) =
4.441 case Generate.generate1 thy (Tac.Specify_Problem' (pI, (ok, (itms, pre)))) (Selem.Uistate, ctxt) pos pt of
4.442 ((p, Pbl), _, _, pt) => (p, pt)
4.443 | _ => error "specify (Specify_Problem': uncovered case generate1 (WARNING WHY ?)"
4.444 - val dI'' = assoc_thy (if dI=e_domID then dI' else dI)
4.445 - val mI'' = if mI=e_metID then mI' else mI
4.446 + val dI'' = Celem.assoc_thy (if dI = Celem.e_domID then dI' else dI)
4.447 + val mI'' = if mI = Celem.e_metID then mI' else mI
4.448 val (_, nxt) = nxt_spec Pbl ok oris (dI', pI', mI') (itms, met) ((#ppc o Specify.get_pbt) pI,
4.449 (#ppc o Specify.get_met) mI'') (dI, pI, mI);
4.450 in
4.451 @@ -792,10 +792,10 @@
4.452 (oris, dI', pI', mI', dI, pI, pbl, met, ctxt)
4.453 | _ => error "specify (Specify_Problem': uncovered case get_obj"
4.454 val {ppc,pre,prls,...} = Specify.get_met mID
4.455 - val thy = assoc_thy dI
4.456 + val thy = Celem.assoc_thy dI
4.457 val oris = Specify.add_field' thy ppc oris
4.458 - val dI'' = if dI=e_domID then dI' else dI
4.459 - val pI'' = if pI = e_pblID then pI' else pI
4.460 + val dI'' = if dI = Celem.e_domID then dI' else dI
4.461 + val pI'' = if pI = Celem.e_pblID then pI' else pI
4.462 val met = if met = [] then pbl else met
4.463 val (_, (itms, pre')) = Specify.match_itms_oris thy met (ppc, pre, prls ) oris
4.464 val (pos, _, _, pt) =
4.465 @@ -804,7 +804,7 @@
4.466 ((#ppc o Specify.get_pbt) pI'', ppc) (dI'', pI'', mID)
4.467 in
4.468 (pos, (pos,Selem.Uistate),
4.469 - Generate.PpcKF (Generate.Method mID, Specify.itms2itemppc (assoc_thy dI'') itms pre'),
4.470 + Generate.PpcKF (Generate.Method mID, Specify.itms2itemppc (Celem.assoc_thy dI'') itms pre'),
4.471 nxt, Selem.Safe, pt)
4.472 end
4.473 | specify (Tac.Add_Given' ct) p c pt = specify_additem "#Given" ct p c pt
4.474 @@ -813,15 +813,15 @@
4.475 | specify (Tac.Specify_Theory' domID) (pos as (p,p_)) _ pt =
4.476 let
4.477 val p_ = case p_ of Met => Met | _ => Pbl
4.478 - val thy = assoc_thy domID
4.479 + val thy = Celem.assoc_thy domID
4.480 val (oris, dI', pI', mI', dI, pI, mI, pbl, met, ctxt) = case get_obj I pt p of
4.481 PblObj {origin= (oris, (dI', pI', mI'), _), spec= (dI, pI, mI), probl = pbl, meth = met, ctxt, ...} =>
4.482 (oris, dI', pI', mI', dI, pI, mI, pbl, met, ctxt)
4.483 | _ => error "specify (Specify_Theory': uncovered case get_obj"
4.484 val mppc = case p_ of Met => met | _ => pbl
4.485 - val cpI = if pI = e_pblID then pI' else pI
4.486 + val cpI = if pI = Celem.e_pblID then pI' else pI
4.487 val {prls = per, ppc, where_ = pwh, ...} = Specify.get_pbt cpI
4.488 - val cmI = if mI = e_metID then mI' else mI
4.489 + val cmI = if mI = Celem.e_metID then mI' else mI
4.490 val {prls = mer, ppc = mpc, pre= mwh, ...} = Specify.get_met cmI
4.491 val pre = case p_ of
4.492 Met => (Stool.check_preconds thy mer mwh met)
4.493 @@ -856,8 +856,8 @@
4.494 PblObj {origin = (oris, (dI', pI', _), _), spec = (dI, pI, _), probl = pbl, ctxt, ...} =>
4.495 (oris, dI', pI', dI, pI, pbl, ctxt)
4.496 | _ => error "specify (Specify_Theory': uncovered case get_obj"
4.497 - val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
4.498 - val cpI = if pI = e_pblID then pI' else pI;
4.499 + val thy = if dI = Celem.e_domID then Celem.assoc_thy dI' else Celem.assoc_thy dI;
4.500 + val cpI = if pI = Celem.e_pblID then pI' else pI;
4.501 in
4.502 case appl_add ctxt sel oris pbl ((#ppc o Specify.get_pbt) cpI) ct of
4.503 Add itm (*..union old input *) =>
4.504 @@ -876,7 +876,7 @@
4.505 end
4.506 | Err msg => (*TODO.WN03 pass error-msgs to the frontend..
4.507 FIXME ..and dont abuse a tactic for that purpose*)
4.508 - ([(Tac.Tac msg, Tac.Tac_ (Thy_Info_get_theory "Isac", msg,msg,msg),
4.509 + ([(Tac.Tac msg, Tac.Tac_ (Celem.Thy_Info_get_theory "Isac", msg,msg,msg),
4.510 (e_pos', (Selem.e_istate, Selem.e_ctxt)))], [], ptp)
4.511 end
4.512 | nxt_specif_additem sel ct (ptp as (pt, (p, Met))) =
4.513 @@ -885,8 +885,8 @@
4.514 PblObj {origin = (oris, (dI', _, mI'), _), spec = (dI, _, mI), meth = met,ctxt, ...} =>
4.515 (oris, dI', mI', dI, mI, met, ctxt)
4.516 | _ => error "nxt_specif_additem Met: uncovered case get_obj"
4.517 - val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
4.518 - val cmI = if mI = e_metID then mI' else mI;
4.519 + val thy = if dI = Celem.e_domID then Celem.assoc_thy dI' else Celem.assoc_thy dI;
4.520 + val cmI = if mI = Celem.e_metID then mI' else mI;
4.521 in
4.522 case appl_add ctxt sel oris met ((#ppc o Specify.get_met) cmI) ct of
4.523 Add itm (*..union old input *) =>
4.524 @@ -907,7 +907,7 @@
4.525 end
4.526 | nxt_specif_additem _ _ (_, p) = error ("nxt_specif_additem not impl. for" ^ pos'2str p)
4.527
4.528 -fun ori2Coritm (pbt : pat list) (i, v, f, d, ts) =
4.529 +fun ori2Coritm pbt (i, v, f, d, ts) =
4.530 (i, v, true, f, Model.Cor ((d,ts),((snd o snd o the o (find_first (eq1 d))) pbt,ts)))
4.531 handle _ => (i, v, true, f, Model.Cor ((d, ts), (d, ts)))
4.532 (*dsc in oris, but not in pbl pat list: keep this dsc*)
4.533 @@ -953,10 +953,10 @@
4.534 val mits = complete_metitms oris pits [] mpc
4.535 in (pits, mits) end
4.536
4.537 -fun some_spec ((odI, opI, omI) : spec) ((dI, pI, mI) : spec) =
4.538 - (if dI = e_domID then odI else dI,
4.539 - if pI = e_pblID then opI else pI,
4.540 - if mI = e_metID then omI else mI) : spec
4.541 +fun some_spec (odI, opI, omI) (dI, pI, mI) =
4.542 + (if dI = Celem.e_domID then odI else dI,
4.543 + if pI = Celem.e_pblID then opI else pI,
4.544 + if mI = Celem.e_metID then omI else mI)
4.545
4.546 (* find a next applicable tac (for calcstate) and update ctree
4.547 (for ev. finding several more tacs due to hide) *)
4.548 @@ -969,7 +969,7 @@
4.549 PblObj {origin = (oris, ospec, _), probl, spec, ctxt, ...} => (oris, ospec, probl, spec, ctxt)
4.550 | _ => error "nxt_specif Model_Problem; uncovered case get_obj"
4.551 val (dI, pI, mI) = some_spec ospec spec
4.552 - val thy = assoc_thy dI
4.553 + val thy = Celem.assoc_thy dI
4.554 val mpc = (#ppc o Specify.get_met) mI (* just for reuse complete_mod_ *)
4.555 val {cas, ppc, ...} = Specify.get_pbt pI
4.556 val pbl = Generate.init_pbl ppc (* fill in descriptions *)
4.557 @@ -998,8 +998,8 @@
4.558 let
4.559 val {met, ...} = Specify.get_pbt pI'
4.560 (*val pt = update_pbl pt p pbl ..done by Model_Problem*)
4.561 - val mI = if length met = 0 then e_metID else hd met
4.562 - val thy = assoc_thy dI
4.563 + val mI = if length met = 0 then Celem.e_metID else hd met
4.564 + val thy = Celem.assoc_thy dI
4.565 val (pos, c, _, pt) =
4.566 Generate.generate1 thy (Tac.Refine_Tacitly' (pI, pI', dI, mI,(*pbl*)[])) (Selem.Uistate, ctxt) pos pt
4.567 in
4.568 @@ -1014,13 +1014,13 @@
4.569 PblObj {origin= (_, (dI, _, _), _), spec = (dI', _, _), probl, ctxt, ...} =>
4.570 (dI, dI', probl, ctxt)
4.571 | _ => error "nxt_specif Refine_Problem: uncovered case get_obj"
4.572 - val thy = if dI' = e_domID then dI else dI'
4.573 + val thy = if dI' = Celem.e_domID then dI else dI'
4.574 in
4.575 - case Specify.refine_pbl (assoc_thy thy) pI probl of
4.576 + case Specify.refine_pbl (Celem.assoc_thy thy) pI probl of
4.577 NONE => ([], [], ptp)
4.578 | SOME rfd =>
4.579 let
4.580 - val (pos,c,_,pt) = Generate.generate1 (assoc_thy thy) (Tac.Refine_Problem' rfd) (Selem.Uistate, ctxt) pos pt
4.581 + val (pos,c,_,pt) = Generate.generate1 (Celem.assoc_thy thy) (Tac.Refine_Problem' rfd) (Selem.Uistate, ctxt) pos pt
4.582 in
4.583 ([(Tac.Refine_Problem pI, Tac.Refine_Problem' rfd, (pos, (Selem.Uistate, Selem.e_ctxt)))], c, (pt,pos))
4.584 end
4.585 @@ -1028,13 +1028,13 @@
4.586 | nxt_specif (Tac.Specify_Problem pI) (pt, pos as (p,_)) =
4.587 let
4.588 val (oris, dI, dI', pI', probl, ctxt) = case get_obj I pt p of
4.589 - PblObj {origin=(oris,(dI,_,_),_),spec=(dI',pI',_), probl, ctxt, ...} =>
4.590 + PblObj {origin = (oris, (dI,_,_),_), spec = (dI',pI',_), probl, ctxt, ...} =>
4.591 (oris, dI, dI', pI', probl, ctxt)
4.592 | _ => error ""
4.593 - val thy = assoc_thy (if dI' = e_domID then dI else dI');
4.594 + val thy = Celem.assoc_thy (if dI' = Celem.e_domID then dI else dI');
4.595 val {ppc,where_,prls,...} = Specify.get_pbt pI
4.596 val pbl =
4.597 - if pI' = e_pblID andalso pI = e_pblID
4.598 + if pI' = Celem.e_pblID andalso pI = Celem.e_pblID
4.599 then (false, (Generate.init_pbl ppc, []))
4.600 else Specify.match_itms_oris thy probl (ppc,where_,prls) oris
4.601 (*FIXXXME~~~~~~~~~~~~~~~: take pbl and compare with new pI WN.8.03*)
4.602 @@ -1053,7 +1053,7 @@
4.603 => (oris, pbl, dI, met, ctxt)
4.604 | _ => error "nxt_specif Specify_Method: uncovered case get_obj"
4.605 val {ppc,pre,prls,...} = Specify.get_met mID
4.606 - val thy = assoc_thy dI
4.607 + val thy = Celem.assoc_thy dI
4.608 val oris = Specify.add_field' thy ppc oris
4.609 val met = if met=[] then pbl else met (* WN0602 what if more itms in met? *)
4.610 val (_, (itms, _)) = Specify.match_itms_oris thy met (ppc,pre,prls ) oris
4.611 @@ -1066,7 +1066,7 @@
4.612 let
4.613 val ctxt = get_ctxt pt pos
4.614 val (pos, c, _, pt) =
4.615 - Generate.generate1 (assoc_thy "Isac") (Tac.Specify_Theory' dI) (Selem.Uistate, ctxt) pos pt
4.616 + Generate.generate1 (Celem.assoc_thy "Isac") (Tac.Specify_Theory' dI) (Selem.Uistate, ctxt) pos pt
4.617 in (*FIXXXME: check if pbl can still be parsed*)
4.618 ([(Tac.Specify_Theory dI, Tac.Specify_Theory' dI, (pos, (Selem.Uistate, ctxt)))], c,
4.619 (pt, pos))
4.620 @@ -1074,7 +1074,7 @@
4.621 | nxt_specif (Tac.Specify_Theory dI) (pt, pos as (_, Met)) =
4.622 let
4.623 val ctxt = get_ctxt pt pos
4.624 - val (pos, c, _, pt) = Generate.generate1 (assoc_thy "Isac") (Tac.Specify_Theory' dI) (Selem.Uistate, ctxt) pos pt
4.625 + val (pos, c, _, pt) = Generate.generate1 (Celem.assoc_thy "Isac") (Tac.Specify_Theory' dI) (Selem.Uistate, ctxt) pos pt
4.626 in (*FIXXXME: check if met can still be parsed*)
4.627 ([(Tac.Specify_Theory dI, Tac.Specify_Theory' dI, (pos, (Selem.Uistate, ctxt)))], c, (pt, pos))
4.628 end
4.629 @@ -1091,7 +1091,7 @@
4.630 then (* from pbl-browser or from CAS cmd with pI=[e_pblID] *)
4.631 let
4.632 val {cas, met, ppc, thy, ...} = Specify.get_pbt pI
4.633 - val dI = if dI = "" then theory2theory' thy else dI
4.634 + val dI = if dI = "" then Celem.theory2theory' thy else dI
4.635 val mI = if mI = [] then hd met else mI
4.636 val hdl = case cas of NONE => LTool.pblterm dI pI | SOME t => t
4.637 val (pt,_) = cappend_problem e_ctree [] (Selem.Uistate, Selem.e_ctxt) ([], (dI, pI, mI))
4.638 @@ -1107,7 +1107,7 @@
4.639 val {ppc, ...} = Specify.get_met mI
4.640 val dI = if dI = "" then "Isac" else dI
4.641 val (pt, _) =
4.642 - cappend_problem e_ctree [] (Selem.e_istate, Selem.e_ctxt) ([], (dI, pI, mI)) ([], (dI, pI, mI), e_term (*FIXME met*))
4.643 + cappend_problem e_ctree [] (Selem.e_istate, Selem.e_ctxt) ([], (dI, pI, mI)) ([], (dI, pI, mI), Celem.e_term (*FIXME met*))
4.644 val pt = update_spec pt [] (dI, pI, mI)
4.645 val mits = Generate.init_pbl' ppc
4.646 val pt = update_met pt [] mits
4.647 @@ -1115,11 +1115,11 @@
4.648 else (* new example, pepare for interactive modeling *)
4.649 let
4.650 val (pt, _) =
4.651 - cappend_problem e_ctree [] (Selem.e_istate, Selem.e_ctxt) ([], e_spec) ([], e_spec, e_term)
4.652 + cappend_problem e_ctree [] (Selem.e_istate, Selem.e_ctxt) ([], Celem.e_spec) ([], Celem.e_spec, Celem.e_term)
4.653 in ((pt, ([], Pbl)), []) end
4.654 | nxt_specify_init_calc (fmz, (dI, pI, mI)) =
4.655 let (* both """"""""""""""""""""""""" either empty or complete *)
4.656 - val thy = assoc_thy dI
4.657 + val thy = Celem.assoc_thy dI
4.658 val (pI, (pors, pctxt), mI) =
4.659 if mI = ["no_met"]
4.660 then
4.661 @@ -1131,7 +1131,7 @@
4.662 end
4.663 else (pI, Specify.get_pbt pI |> #ppc |> Specify.prep_ori fmz thy, mI)
4.664 val {cas, ppc, thy = thy', ...} = Specify.get_pbt pI (*take dI from _refined_ pbl*)
4.665 - val dI = theory2theory' (maxthy thy thy')
4.666 + val dI = Celem.theory2theory' (Celem.maxthy thy thy')
4.667 val hdl = case cas of
4.668 NONE => LTool.pblterm dI pI
4.669 | SOME t => subst_atomic ((vars_of_pbl_' ppc) ~~~ vals_of_oris pors) t
4.670 @@ -1149,8 +1149,8 @@
4.671 val gf = (head_of given) $ formal;
4.672 val _ = Thm.global_cterm_of thy gf
4.673 in gf end)
4.674 - handle _ => error ("calchead.tag_form: " ^ term_to_string''' thy given ^
4.675 - " .. " ^ term_to_string''' thy formal ^ " ..types do not match")
4.676 + handle _ => error ("calchead.tag_form: " ^ Celem.term_to_string''' thy given ^
4.677 + " .. " ^ Celem.term_to_string''' thy formal ^ " ..types do not match")
4.678
4.679 fun chktyps thy (fs, gs) = map (tag_form thy) (fs ~~ gs)
4.680
4.681 @@ -1213,7 +1213,7 @@
4.682 | _ => error "all_modspec: uncovered case get_obj"
4.683 val {ppc, ...} = Specify.get_met mI
4.684 val (_, vals) = oris2fmz_vals pors
4.685 - val ctxt = dI |> Thy_Info_get_theory |> Proof_Context.init_global
4.686 + val ctxt = dI |> Celem.Thy_Info_get_theory |> Proof_Context.init_global
4.687 |> Stool.declare_constraints' vals
4.688 val pt = update_pblppc pt p (map (ori2Coritm ppc) pors)
4.689 val pt = update_metppc pt p (map (ori2Coritm ppc) pors) (*WN110716 = _pblppc ?!?*)
4.690 @@ -1244,7 +1244,7 @@
4.691 then error ("is_complete_spec: called by PrfObj at "^pos'2str pos)
4.692 else
4.693 let val (dI,pI,mI) = get_obj g_spec pt p
4.694 - in dI<>e_domID andalso pI<>e_pblID andalso mI<>e_metID end
4.695 + in dI <> Celem.e_domID andalso pI <> Celem.e_pblID andalso mI <> Celem.e_metID end
4.696
4.697 (* complete empty items in specification from origin (pbl, met ev.refined);
4.698 assumes 'is_complete_mod' *)
4.699 @@ -1263,7 +1263,7 @@
4.700 fun pt_model (PblObj {meth, spec, origin = (_, spec', hdl), ...}) Met =
4.701 let
4.702 val (_, _, metID) = get_somespec' spec spec'
4.703 - val pre = if metID = e_metID then []
4.704 + val pre = if metID = Celem.e_metID then []
4.705 else
4.706 let
4.707 val {prls, pre= where_, ...} = Specify.get_met metID
4.708 @@ -1276,7 +1276,7 @@
4.709 | pt_model (PblObj {probl, spec, origin = (_, spec', hdl), ...}) _(*Frm,Pbl*) =
4.710 let
4.711 val (_, pI, _) = get_somespec' spec spec'
4.712 - val pre = if pI = e_pblID then []
4.713 + val pre = if pI = Celem.e_pblID then []
4.714 else
4.715 let
4.716 val {prls, where_, ...} = Specify.get_pbt pI
4.717 @@ -1324,7 +1324,7 @@
4.718 val pI = case get_obj I pt (lev_up p) of
4.719 PblObj{spec = (_, pI, _), ...} => pI
4.720 | _ => error "pt_extract last_onlev: uncovered case get_obj"
4.721 - in if pI = e_pblID then NONE else SOME (Tac.Check_Postcond pI) end
4.722 + in if pI = Celem.e_pblID then NONE else SOME (Tac.Check_Postcond pI) end
4.723 else SOME Tac.End_Trans (* WN0502 TODO for other branches *)
4.724 else
4.725 let val p' = lev_on p
4.726 @@ -1339,7 +1339,7 @@
4.727 else
4.728 if f = get_obj g_form pt p'
4.729 then SOME (get_obj g_tac pt p') (*because this Frm ~~~is not on worksheet*)
4.730 - else SOME (Tac.Take (term2str (get_obj g_form pt p')))
4.731 + else SOME (Tac.Take (Celem.term2str (get_obj g_form pt p')))
4.732 end
4.733 in (Form f, tac, asm) end
4.734 | pt_extract (pt, (p,p_(*Frm,Pbl*))) =
4.735 @@ -1422,7 +1422,7 @@
4.736 end
4.737 in get_inter [] from to level pt end
4.738
4.739 -fun posterm2str (pos, t) = "(" ^ pos'2str pos ^ ", " ^ term2str t ^ ")"
4.740 +fun posterm2str (pos, t) = "(" ^ pos'2str pos ^ ", " ^ Celem.term2str t ^ ")"
4.741 fun posterms2str pfs = (strs2str' o (map (curry op ^ "\n")) o (map posterm2str)) pfs
4.742
4.743 (* WN050225 omits the last step, if pt is incomplete *)
4.744 @@ -1435,7 +1435,7 @@
4.745 PblObj {origin = (_, ospec, hdf'), spec, probl,...} => (ospec, hdf', spec, probl)
4.746 | _ => error "get_ocalhd Pbl: uncovered case get_obj"
4.747 val {prls, where_, ...} = Specify.get_pbt (#2 (some_spec ospec spec))
4.748 - val pre = Stool.check_preconds (assoc_thy"Isac") prls where_ probl
4.749 + val pre = Stool.check_preconds (Celem.assoc_thy "Isac") prls where_ probl
4.750 in
4.751 (ocalhd_complete probl pre spec, Pbl, hdf', probl, pre, spec) : ocalhd
4.752 end
4.753 @@ -1445,7 +1445,7 @@
4.754 PblObj {origin = (_, ospec, hdf'), spec, meth, ...} => (ospec, hdf', spec, meth)
4.755 | _ => error "get_ocalhd Met: uncovered case get_obj"
4.756 val {prls, pre, ...} = Specify.get_met (#3 (some_spec ospec spec))
4.757 - val pre = Stool.check_preconds (assoc_thy"Isac") prls pre meth
4.758 + val pre = Stool.check_preconds (Celem.assoc_thy "Isac") prls pre meth
4.759 in
4.760 (ocalhd_complete meth pre spec, Met, hdf', meth, pre, spec)
4.761 end
4.762 @@ -1461,7 +1461,7 @@
4.763 | _ => error "reset_calchead: uncovered case get_obj"
4.764 val pt = update_pbl pt p []
4.765 val pt = update_met pt p []
4.766 - val pt = update_spec pt p e_spec
4.767 + val pt = update_spec pt p Celem.e_spec
4.768 in (pt, (p, Pbl) : pos') end
4.769
4.770 end
4.771 \ No newline at end of file
5.1 --- a/src/Tools/isac/Interpret/ctree-access.sml Tue Mar 13 15:04:27 2018 +0100
5.2 +++ b/src/Tools/isac/Interpret/ctree-access.sml Thu Mar 15 10:17:44 2018 +0100
5.3 @@ -8,22 +8,22 @@
5.4 val update_branch : CTbasic.ctree -> CTbasic.pos -> CTbasic.branch -> CTbasic.ctree
5.5 val update_ctxt : CTbasic.ctree -> CTbasic.pos -> Proof.context -> CTbasic.ctree
5.6 val update_env : CTbasic.ctree -> CTbasic.pos -> (Selem.istate * Proof.context) option -> CTbasic.ctree
5.7 - val update_domID : CTbasic.ctree -> CTbasic.pos -> domID -> CTbasic.ctree
5.8 + val update_domID : CTbasic.ctree -> CTbasic.pos -> Celem.domID -> CTbasic.ctree
5.9 val update_met : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =vvv= ? *)
5.10 val update_metppc : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =^^^= ? *)
5.11 - val update_metID : CTbasic.ctree -> CTbasic.pos -> metID -> CTbasic.ctree
5.12 + val update_metID : CTbasic.ctree -> CTbasic.pos -> Celem.metID -> CTbasic.ctree
5.13 val update_pbl : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =vvv= ? *)
5.14 val update_pblppc : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =^^^= ? *)
5.15 - val update_pblID : CTbasic.ctree -> CTbasic.pos -> pblID -> CTbasic.ctree
5.16 + val update_pblID : CTbasic.ctree -> CTbasic.pos -> Celem.pblID -> CTbasic.ctree
5.17 val update_oris : CTbasic.ctree -> CTbasic.pos -> Model.ori list -> CTbasic.ctree
5.18 - val update_orispec : CTbasic.ctree -> CTbasic.pos -> spec -> CTbasic.ctree
5.19 - val update_spec : CTbasic.ctree -> CTbasic.pos -> spec -> CTbasic.ctree
5.20 + val update_orispec : CTbasic.ctree -> CTbasic.pos -> Celem.spec -> CTbasic.ctree
5.21 + val update_spec : CTbasic.ctree -> CTbasic.pos -> Celem.spec -> CTbasic.ctree
5.22 val update_tac : CTbasic.ctree -> CTbasic.pos -> Tac.tac -> CTbasic.ctree
5.23
5.24 val cappend_form : CTbasic.ctree -> CTbasic.pos -> Selem.istate * Proof.context -> term ->
5.25 CTbasic.ctree * CTbasic.pos' list
5.26 val cappend_problem : CTbasic.ctree -> CTbasic.pos -> Selem.istate * Proof.context ->
5.27 - Selem.fmz -> Model.ori list * spec * term -> CTbasic.ctree * CTbasic.pos' list
5.28 + Selem.fmz -> Model.ori list * Celem.spec * term -> CTbasic.ctree * CTbasic.pos' list
5.29 val append_result : CTbasic.ctree -> CTbasic.pos -> Selem.istate * Proof.context ->
5.30 Selem.result -> CTbasic.ostate -> CTbasic.ctree * 'a list
5.31 val append_atomic : (* for solve.sml *)
5.32 @@ -157,7 +157,7 @@
5.33 (* called by Take *)
5.34 fun append_form p l f pt =
5.35 insert_pt (PrfObj {cell = NONE, form = f, tac = Tac.Empty_Tac, loc = (SOME l, NONE),
5.36 - branch = NoBranch, result = (e_term, []), ostate = Incomplete}) pt p;
5.37 + branch = NoBranch, result = (Celem.e_term, []), ostate = Incomplete}) pt p;
5.38 fun cappend_form pt p loc f =
5.39 let
5.40 val (pt', cs) = cut_tree pt (p, Frm)
5.41 @@ -165,13 +165,13 @@
5.42 in (pt'', cs) end;
5.43
5.44 fun append_problem [] l fmz (strs, spec, hdf) _ =
5.45 - (Nd (PblObj {cell = NONE, origin = (strs, spec, hdf), fmz = fmz, spec = empty_spec,
5.46 + (Nd (PblObj {cell = NONE, origin = (strs, spec, hdf), fmz = fmz, spec = Celem.empty_spec,
5.47 probl = [], meth = [], ctxt = Selem.e_ctxt, env = NONE, loc = (SOME l, NONE),
5.48 - branch = TransitiveB, result = (e_term, []), ostate = Incomplete}, []))
5.49 + branch = TransitiveB, result = (Celem.e_term, []), ostate = Incomplete}, []))
5.50 | append_problem p l fmz (strs, spec, hdf) pt =
5.51 - insert_pt (PblObj {cell = NONE, origin = (strs, spec, hdf), fmz = fmz, spec = empty_spec,
5.52 + insert_pt (PblObj {cell = NONE, origin = (strs, spec, hdf), fmz = fmz, spec = Celem.empty_spec,
5.53 probl = [], meth = [], ctxt = Selem.e_ctxt, env = NONE, loc = (SOME l, NONE),
5.54 - branch = TransitiveB, result = (e_term, []), ostate= Incomplete}) pt p;
5.55 + branch = TransitiveB, result = (Celem.e_term, []), ostate= Incomplete}) pt p;
5.56 fun cappend_problem _ [] loc fmz ori = (append_problem [] loc fmz ori EmptyPtree, [])
5.57 | cappend_problem pt p loc fmz ori =
5.58 apfst (append_problem p loc fmz ori) (cut_tree pt (p, Frm));
5.59 @@ -184,7 +184,7 @@
5.60 then ((fst (get_obj g_loc pt p), SOME l), get_obj g_form pt p)
5.61 else ((SOME l, NONE), f)
5.62 in insert_pt (PrfObj {cell = NONE, form = f, tac = r, loc = ll,
5.63 - branch = b, result = (e_term, []), ostate= Incomplete}) pt p
5.64 + branch = b, result = (Celem.e_term, []), ostate= Incomplete}) pt p
5.65 end;
5.66 fun cappend_parent pt p loc f r b = (* for tests only *)
5.67 apfst (append_parent p loc f r b) (cut_tree pt (p, Und));
6.1 --- a/src/Tools/isac/Interpret/ctree-basic.sml Tue Mar 13 15:04:27 2018 +0100
6.2 +++ b/src/Tools/isac/Interpret/ctree-basic.sml Thu Mar 15 10:17:44 2018 +0100
6.3 @@ -26,21 +26,21 @@
6.4 datatype ppobj =
6.5 PblObj of
6.6 {branch: branch,
6.7 - cell: lrd option,
6.8 + cell: Celem.lrd option,
6.9 loc: (Selem.istate * Proof.context) option * (Selem.istate * Proof.context) option,
6.10 ostate: ostate,
6.11 result: Selem.result,
6.12
6.13 fmz: Selem.fmz,
6.14 - origin: Model.ori list * spec * term,
6.15 + origin: Model.ori list * Celem.spec * term,
6.16 probl: Model.itm list,
6.17 meth: Model.itm list,
6.18 - spec: spec,
6.19 + spec: Celem.spec,
6.20 ctxt: Proof.context,
6.21 env: (Selem.istate * Proof.context) option}
6.22 | PrfObj of
6.23 {branch: branch,
6.24 - cell: lrd option,
6.25 + cell: Celem.lrd option,
6.26 loc: (Selem.istate * Proof.context) option * (Selem.istate * Proof.context) option,
6.27 ostate: ostate,
6.28 result: Selem.result,
6.29 @@ -57,27 +57,27 @@
6.30 val children : ctree -> ctree list (* for solve.sml *)
6.31 val get_nd : ctree -> pos -> ctree (* for solve.sml *)
6.32 val just_created_ : ppobj -> bool (* for mathengine.sml *)
6.33 - val just_created : state -> bool (* for mathengine.sml *)
6.34 - val e_origin : Model.ori list * spec * term (* for mathengine.sml *)
6.35 + val just_created : state -> bool (* for mathengine.sml *)
6.36 + val e_origin : Model.ori list * Celem.spec * term (* for mathengine.sml *)
6.37
6.38 val is_pblobj : ppobj -> bool
6.39 val is_pblobj' : ctree -> pos -> bool
6.40 val is_pblnd : ctree -> bool
6.41
6.42 - val g_spec : ppobj -> spec
6.43 + val g_spec : ppobj -> Celem.spec
6.44 val g_loc : ppobj -> (Selem.istate * Proof.context) option * (Selem.istate * Proof.context) option
6.45 val g_form : ppobj -> term
6.46 val g_pbl : ppobj -> Model.itm list
6.47 val g_met : ppobj -> Model.itm list
6.48 - val g_metID : ppobj -> metID
6.49 + val g_metID : ppobj -> Celem.metID
6.50 val g_result : ppobj -> Selem.result
6.51 val g_tac : ppobj -> Tac.tac
6.52 - val g_domID : ppobj -> domID (* for appl.sml TODO: replace by thyID *)
6.53 - val g_env : ppobj -> (Selem.istate * Proof.context) option (* for appl.sml *)
6.54 + val g_domID : ppobj -> Celem.domID (* for appl.sml TODO: replace by thyID *)
6.55 + val g_env : ppobj -> (Selem.istate * Proof.context) option (* for appl.sml *)
6.56
6.57 - val g_origin : ppobj -> Model.ori list * spec * term (* for script.sml *)
6.58 - val get_loc : ctree -> pos' -> Selem.istate * Proof.context (* for script.sml *)
6.59 - val get_istate : ctree -> pos' -> Selem.istate (* for script.sml *)
6.60 + val g_origin : ppobj -> Model.ori list * Celem.spec * term (* for script.sml *)
6.61 + val get_loc : ctree -> pos' -> Selem.istate * Proof.context (* for script.sml *)
6.62 + val get_istate : ctree -> pos' -> Selem.istate (* for script.sml *)
6.63 val get_ctxt : ctree -> pos' -> Proof.context
6.64 val get_obj : (ppobj -> 'a) -> ctree -> pos -> 'a
6.65 val get_curr_formula : state -> term
6.66 @@ -87,13 +87,13 @@
6.67 val new_val : term -> Selem.istate -> Selem.istate
6.68 (* for calchead.sml *)
6.69 type cid = cellID list
6.70 - type ocalhd = bool * pos_ * term * Model.itm list * (bool * term) list * spec
6.71 + type ocalhd = bool * pos_ * term * Model.itm list * (bool * term) list * Celem.spec
6.72 datatype ptform = Form of term | ModSpec of ocalhd
6.73 - val get_somespec' : spec -> spec -> spec
6.74 + val get_somespec' : Celem.spec -> Celem.spec -> Celem.spec
6.75 exception PTREE of string;
6.76
6.77 - val par_pbl_det : ctree -> pos -> bool * pos * rls (* for appl.sml *)
6.78 - val rootthy : ctree -> theory (* for script.sml *)
6.79 + val par_pbl_det : ctree -> pos -> bool * pos * Celem.rls (* for appl.sml *)
6.80 + val rootthy : ctree -> theory (* for script.sml *)
6.81 (* ---- made visible ONLY for structure CTaccess : CALC_TREE_ACCESS --------------------------- *)
6.82 val appl_obj : (ppobj -> ppobj) -> ctree -> pos -> ctree
6.83 val existpt : pos -> ctree -> bool (* also for tests *)
6.84 @@ -220,7 +220,7 @@
6.85 (* executed tactics (tac_s) with local environment etc.;
6.86 used for continuing eval script + for generate *)
6.87 type ets =
6.88 - (loc_ * (* of tactic in scr, tactic (weakly) associated with tac_ *)
6.89 + (Celem.loc_ *(* of tactic in scr, tactic (weakly) associated with tac_ *)
6.90 (Tac.tac_ * (* (for generate) *)
6.91 env * (* with 'tactic=result' as rule, tactic ev. _not_ ready for 'parallel let' *)
6.92 env * (* with results of (ready) tacs *)
6.93 @@ -230,11 +230,11 @@
6.94 list;
6.95
6.96 fun ets2s (l,(m,eno,env,iar,res,s)) =
6.97 - "\n(" ^ loc_2str l ^ ",(" ^ Tac.tac_2str m ^
6.98 - ",\n ens= " ^ subst2str eno ^
6.99 - ",\n env= " ^ subst2str env ^
6.100 - ",\n iar= " ^ term2str iar ^
6.101 - ",\n res= " ^ term2str res ^
6.102 + "\n(" ^ Celem.loc_2str l ^ ",(" ^ Tac.tac_2str m ^
6.103 + ",\n ens= " ^ Celem.subst2str eno ^
6.104 + ",\n env= " ^ Celem.subst2str env ^
6.105 + ",\n iar= " ^ Celem.term2str iar ^
6.106 + ",\n res= " ^ Celem.term2str res ^
6.107 ",\n " ^ Selem.safe2str s ^ "))";
6.108 fun ets2str (ets: ets) = (strs2str o (map ets2s)) ets; (* for tests only *)
6.109
6.110 @@ -246,7 +246,7 @@
6.111
6.112 datatype ppobj = (* TODO: arrange according to signature *)
6.113 PrfObj of
6.114 - {cell : lrd option, (* where in form tac has been applied, FIXME.WN0607 rename field *)
6.115 + {cell : Celem.lrd option, (* where in form tac has been applied, FIXME.WN0607 rename field *)
6.116 form : term, (* where tac is applied to *)
6.117 tac : Tac.tac, (* also in istate *)
6.118 loc : (Selem.istate * (* script interpreter state *)
6.119 @@ -260,15 +260,15 @@
6.120 result: Selem.result, (* result and assumptions *)
6.121 ostate: ostate} (* Complete <=> result is OK *)
6.122 | PblObj of
6.123 - {cell : lrd option, (* unused: meaningful only for some _Prf_Obj *)
6.124 + {cell : Celem.lrd option, (* unused: meaningful only for some _Prf_Obj *)
6.125 fmz : Selem.fmz, (* from init:FIXME never use this spec;-drop *)
6.126 origin: (Model.ori list) * (* representation from fmz+pbt
6.127 for efficiently adding items in probl, meth *)
6.128 - spec * (* updated by Refine_Tacitly *)
6.129 + Celem.spec * (* updated by Refine_Tacitly *)
6.130 term, (* headline of calc-head, as calculated initially(!) *)
6.131 - spec : spec, (* explicitly input *)
6.132 - probl : Model.itm list, (* itms explicitly input *)
6.133 - meth : Model.itm list, (* itms automatically added to copy of probl *)
6.134 + spec : Celem.spec, (* explicitly input *)
6.135 + probl : Model.itm list, (* itms explicitly input *)
6.136 + meth : Model.itm list, (* itms automatically added to copy of probl *)
6.137 ctxt : Proof.context, (* WN110513 introduced to avoid [*] [**] *)
6.138 env : (Selem.istate * Proof.context) option, (* istate only for initac in script
6.139 context for specify phase on this node NO..
6.140 @@ -310,7 +310,7 @@
6.141 fun pr_pos ps = (space_implode "." (map string_of_int ps))^". ";
6.142 (* show hd origin or form only *)
6.143 fun pr_short p (PblObj _) = pr_pos p ^ " ----- pblobj -----\n" (* for tests only *)
6.144 - | pr_short p (PrfObj {form = form, ...}) = pr_pos p ^ term2str form ^ "\n";
6.145 + | pr_short p (PrfObj {form = form, ...}) = pr_pos p ^ Celem.term2str form ^ "\n";
6.146 fun pr_ctree f pt = (* for tests only *)
6.147 let
6.148 fun pr_pt _ _ EmptyPtree = ""
6.149 @@ -406,9 +406,9 @@
6.150 (* in CalcTree/Subproblem an 'just_created_' model is created;
6.151 this is filled to 'untouched' by Model/Refine_Problem *)
6.152 fun just_created_ (PblObj {meth, probl, spec, ...}) =
6.153 - null meth andalso null probl andalso spec = e_spec
6.154 + null meth andalso null probl andalso spec = Celem.e_spec
6.155 | just_created_ _ = raise PTREE "g_ostate': uncovered fun def.";
6.156 -val e_origin = ([],e_spec,e_term);
6.157 +val e_origin = ([], Celem.e_spec, Celem.e_term);
6.158
6.159 fun just_created (pt, (p, _)) =
6.160 let val ppobj = get_obj I pt p
6.161 @@ -455,13 +455,13 @@
6.162 (* find the next parent, which is either a PblObj (return true)
6.163 or a PrfObj with tac = Detail_Set (return false)
6.164 FIXME.030403: re-organize par_pbl_det after rls' --> rls*)
6.165 -fun par_pbl_det pt [] = (true, [], Erls)
6.166 +fun par_pbl_det pt [] = (true, [], Celem.Erls)
6.167 | par_pbl_det pt p =
6.168 let
6.169 - fun par _ [] = (true, [], Erls)
6.170 + fun par _ [] = (true, [], Celem.Erls)
6.171 | par pt p =
6.172 if is_pblobj (get_obj I pt p)
6.173 - then (true, p, Erls)
6.174 + then (true, p, Celem.Erls)
6.175 else case get_obj g_tac pt p of
6.176 Tac.Rewrite_Set rls' => (false, p, assoc_rls rls')
6.177 | Tac.Rewrite_Set_Inst (_, rls') => (false, p, assoc_rls rls')
6.178 @@ -507,10 +507,10 @@
6.179 bool * (* ALL itms+preconds true *)
6.180 pos_ * (* model belongs to Problem | Method *)
6.181 term * (* header: Problem... or Cas FIXME.0312: item for marking syntaxerrors *)
6.182 - Model.itm list * (* model: given, find, relate *)
6.183 + Model.itm list * (* model: given, find, relate *)
6.184 ((bool * term) list) *(* model: preconds *)
6.185 - spec; (* specification *)
6.186 -val e_ocalhd = (false, Und, e_term, [Model.e_itm], [(false, e_term)], e_spec);
6.187 + Celem.spec; (* specification *)
6.188 +val e_ocalhd = (false, Und, Celem.e_term, [Model.e_itm], [(false, Celem.e_term)], Celem.e_spec);
6.189
6.190 datatype ptform = Form of term | ModSpec of ocalhd;
6.191
6.192 @@ -525,10 +525,10 @@
6.193 fun del_res (PblObj {cell, fmz, origin, spec, probl, meth, ctxt, env, loc= (l1, _), branch, ...}) =
6.194 PblObj {cell = cell, fmz = fmz, origin = origin, spec = spec, probl = probl, meth = meth,
6.195 ctxt = ctxt, env = env, loc= (l1, NONE), branch = branch,
6.196 - result = (e_term, []), ostate = Incomplete}
6.197 + result = (Celem.e_term, []), ostate = Incomplete}
6.198 | del_res (PrfObj {cell, form, tac, loc= (l1, _), branch, ...}) =
6.199 PrfObj {cell = cell, form = form, tac = tac, loc = (l1, NONE), branch = branch,
6.200 - result = (e_term, []), ostate = Incomplete};
6.201 + result = (Celem.e_term, []), ostate = Incomplete};
6.202
6.203
6.204 fun get_loc EmptyPtree _ = (Selem.e_istate, Selem.e_ctxt)
6.205 @@ -552,9 +552,9 @@
6.206
6.207 fun get_somespec' (dI, pI, mI) (dI', pI', mI') =
6.208 let
6.209 - val domID = if dI = e_domID then dI' else dI
6.210 - val pblID = if pI = e_pblID then pI' else pI
6.211 - val metID = if mI = e_metID then mI' else mI
6.212 + val domID = if dI = Celem.e_domID then dI' else dI
6.213 + val pblID = if pI = Celem.e_pblID then pI' else pI
6.214 + val metID = if mI = Celem.e_metID then mI' else mI
6.215 in (domID, pblID, metID) end;
6.216
6.217 (**.development for extracting an 'interval' from ptree.**)
6.218 @@ -608,13 +608,13 @@
6.219
6.220 (*extract a formula or model from ctree for itms2itemppc or model2xml*)
6.221 fun preconds2str bts =
6.222 - (strs2str o (map (linefeed o pair2str o
6.223 - (apsnd term2str) o
6.224 + (strs2str o (map (Celem.linefeed o pair2str o
6.225 + (apsnd Celem.term2str) o
6.226 (apfst bool2str)))) bts;
6.227 fun ocalhd2str (b, p, hdf, itms, prec, spec) = (* for tests only *)
6.228 - "(" ^ bool2str b ^ ", " ^ pos_2str p ^ ", " ^ term2str hdf ^
6.229 - ", " ^ Model.itms2str_ (thy2ctxt' "Isac") itms ^
6.230 - ", " ^ preconds2str prec ^ ", \n" ^ spec2str spec ^ " )";
6.231 + "(" ^ bool2str b ^ ", " ^ pos_2str p ^ ", " ^ Celem.term2str hdf ^
6.232 + ", " ^ Model.itms2str_ (Celem.thy2ctxt' "Isac") itms ^
6.233 + ", " ^ preconds2str prec ^ ", \n" ^ Celem.spec2str spec ^ " )";
6.234
6.235 fun is_pblnd (Nd (ppobj, _)) = is_pblobj ppobj
6.236 | is_pblnd _ = error "is_pblnd: uncovered fun def.";
6.237 @@ -888,7 +888,7 @@
6.238
6.239 (* get the theory explicitly specified for the rootpbl;
6.240 thus use this function _after_ finishing specification *)
6.241 -fun rootthy (Nd (PblObj {spec = (thyID, _, _), ...}, _)) = assoc_thy thyID
6.242 +fun rootthy (Nd (PblObj {spec = (thyID, _, _), ...}, _)) = Celem.assoc_thy thyID
6.243 | rootthy _ = error "rootthy: uncovered fun def.";
6.244
6.245 (**)
7.1 --- a/src/Tools/isac/Interpret/generate.sml Tue Mar 13 15:04:27 2018 +0100
7.2 +++ b/src/Tools/isac/Interpret/generate.sml Thu Mar 15 10:17:44 2018 +0100
7.3 @@ -9,13 +9,13 @@
7.4 (* for calchead.sml --------------------------------------------------------------- vvv *)
7.5 type taci
7.6 val e_taci : taci
7.7 - datatype pblmet = Method of metID | Problem of pblID | Upblmet
7.8 + datatype pblmet = Method of Celem.metID | Problem of Celem.pblID | Upblmet
7.9 datatype mout =
7.10 EmptyMout
7.11 | Error' of string
7.12 - | FormKF of cterm'
7.13 + | FormKF of Celem.cterm'
7.14 | PpcKF of pblmet * Model.item Model.ppc
7.15 - | RefinedKF of pblID * (Model.itm list * (bool * term) list)
7.16 + | RefinedKF of Celem.pblID * (Model.itm list * (bool * term) list)
7.17 val generate1 : theory -> Tac.tac_ -> Selem.istate * Proof.context ->
7.18 Ctree.pos' -> Ctree.ctree -> Ctree.pos' * Ctree.pos' list * mout * Ctree.ctree (* for calchead.sml------------- ^^^ *)
7.19 val init_istate : Tac.tac -> term -> Selem.istate (* for solve.sml *)
7.20 @@ -26,7 +26,7 @@
7.21 theory -> Tac.tac_ -> Ctree.pos' -> Ctree.ctree -> Ctree.pos' * Ctree.pos' list * mout * Ctree.ctree
7.22 val generate : (Tac.tac * Tac.tac_ * (Ctree.pos' * (Selem.istate * Proof.context))) list ->
7.23 Ctree.ctree * Ctree.pos' list * Ctree.pos' -> Ctree.ctree * Ctree.pos' list * Ctree.pos' (* for mathengine.sml *)
7.24 - val generate_inconsistent_rew : Selem.subs option * thm'' -> term -> Selem.istate * Proof.context ->
7.25 + val generate_inconsistent_rew : Selem.subs option * Celem.thm'' -> term -> Selem.istate * Proof.context ->
7.26 Ctree.pos' -> Ctree.ctree -> Ctree.state (* for interface.sml *)
7.27 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
7.28 val tacis2str : taci list -> string
7.29 @@ -45,36 +45,36 @@
7.30 (* initialize istate for Detail_Set *)
7.31 fun init_istate (Tac.Rewrite_Set rls) t =
7.32 (case assoc_rls rls of
7.33 - Rrls {scr = Rfuns {init_state = ii, ...}, ...} => Selem.RrlsState (ii t)
7.34 - | Rls {scr = EmptyScr, ...} =>
7.35 + Celem.Rrls {scr = Celem.Rfuns {init_state = ii, ...}, ...} => Selem.RrlsState (ii t)
7.36 + | Celem.Rls {scr = EmptyScr, ...} =>
7.37 error ("interSteps>..>init_istate: \"" ^ rls ^ "\" has EmptyScr." ^
7.38 "use prep_rls' for storing rule-sets !")
7.39 - | Rls {scr = Prog s, ...} => (Selem.ScrState ([(LTool.one_scr_arg s, t)], [], NONE, e_term, Selem.Sundef, true))
7.40 - | Seq {scr=EmptyScr,...} =>
7.41 + | Celem.Rls {scr = Celem.Prog s, ...} => (Selem.ScrState ([(LTool.one_scr_arg s, t)], [], NONE, Celem.e_term, Selem.Sundef, true))
7.42 + | Celem.Seq {scr=EmptyScr,...} =>
7.43 error ("interSteps>..>init_istate: \"" ^ rls ^ "\" has EmptyScr." ^
7.44 "use prep_rls' for storing rule-sets !")
7.45 - | Seq {scr = Prog s,...} => (Selem.ScrState ([(LTool.one_scr_arg s, t)], [], NONE, e_term, Selem.Sundef, true))
7.46 + | Celem.Seq {scr = Celem.Prog s,...} => (Selem.ScrState ([(LTool.one_scr_arg s, t)], [], NONE, Celem.e_term, Selem.Sundef, true))
7.47 | _ => error "init_istate Rewrite_Set: uncovered case assoc_rls")
7.48 | init_istate (Tac.Rewrite_Set_Inst (subs, rls)) t =
7.49 let
7.50 - val v = case Selem.subs2subst (assoc_thy "Isac") subs of
7.51 + val v = case Selem.subs2subst (Celem.assoc_thy "Isac") subs of
7.52 (_, v) :: _ => v
7.53 | _ => error "init_istate: uncovered case "
7.54 (*...we suppose the substitution of only _one_ bound variable*)
7.55 in case assoc_rls rls of
7.56 - Rls {scr = EmptyScr, ...} =>
7.57 + Celem.Rls {scr = EmptyScr, ...} =>
7.58 error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr." ^
7.59 "use prep_rls' for storing rule-sets !")
7.60 - | Rls {scr = Prog s, ...} =>
7.61 + | Celem.Rls {scr = Celem.Prog s, ...} =>
7.62 let val (form, bdv) = LTool.two_scr_arg s
7.63 - in (Selem.ScrState ([(form, t), (bdv, v)], [], NONE, e_term, Selem.Sundef,true))
7.64 + in (Selem.ScrState ([(form, t), (bdv, v)], [], NONE, Celem.e_term, Selem.Sundef,true))
7.65 end
7.66 - | Seq {scr = EmptyScr, ...} =>
7.67 + | Celem.Seq {scr = EmptyScr, ...} =>
7.68 error ("interSteps>..>init_istate: \""^rls^"\" has EmptyScr." ^
7.69 "use prep_rls' for storing rule-sets !")
7.70 - | Seq {scr = Prog s,...} =>
7.71 + | Celem.Seq {scr = Celem.Prog s,...} =>
7.72 let val (form, bdv) = LTool.two_scr_arg s
7.73 - in (Selem.ScrState ([(form, t), (bdv, v)],[], NONE, e_term, Selem.Sundef,true))
7.74 + in (Selem.ScrState ([(form, t), (bdv, v)],[], NONE, Celem.e_term, Selem.Sundef,true))
7.75 end
7.76 | _ => error "init_istate Rewrite_Set_Inst: uncovered case assoc_rls"
7.77 end
7.78 @@ -98,21 +98,21 @@
7.79 fun taci2str ((tac, tac_, (pos', (istate, _))):taci) =
7.80 "( " ^ Tac.tac2str tac ^ ", " ^ Tac.tac_2str tac_ ^ ", ( " ^ pos'2str pos' ^ ", " ^
7.81 Selem.istate2str istate ^ " ))"
7.82 -fun tacis2str tacis = (strs2str o (map (linefeed o taci2str))) tacis
7.83 +fun tacis2str tacis = (strs2str o (map (Celem.linefeed o taci2str))) tacis
7.84
7.85 -datatype pblmet = (*%^%*)
7.86 - Upblmet (*undefined*)
7.87 -| Problem of pblID (*%^%*)
7.88 -| Method of metID; (*%^%*)
7.89 +datatype pblmet = (*%^%*)
7.90 + Upblmet (*undefined*)
7.91 +| Problem of Celem.pblID (*%^%*)
7.92 +| Method of Celem.metID; (*%^%*)
7.93 fun pblmet2str (Problem pblID) = "Problem " ^ strs2str pblID (*%^%*)
7.94 - | pblmet2str (Method metID) = "Method " ^ metID2str metID (*%^%*)
7.95 + | pblmet2str (Method metID) = "Method " ^ Celem.metID2str metID (*%^%*)
7.96 | pblmet2str x = error ("pblmet2str: uncovered definition " ^ pblmet2str x)
7.97
7.98 (*3.5.00: TODO: foppFK eliminated in interface FE-KE !!!*)
7.99 datatype foppFK = (* in DG cases div 2 *)
7.100 EmptyFoppFK (*DG internal*)
7.101 -| FormFK of cterm'
7.102 -| PpcFK of cterm' Model.ppc
7.103 +| FormFK of Celem.cterm'
7.104 +| PpcFK of Celem.cterm' Model.ppc
7.105 fun foppFK2str (FormFK ct') ="FormFK " ^ ct'
7.106 | foppFK2str (PpcFK ppc) ="PpcFK " ^ Model.ppc2str ppc
7.107 | foppFK2str EmptyFoppFK ="EmptyFoppFK"
7.108 @@ -132,19 +132,19 @@
7.109 | edit2str Protect = "Protect";
7.110
7.111 datatype inout = (*FIXME.WN1105 drop this: was required for proto0 with dialog in sml*)
7.112 - Error_ of string (*<--*)
7.113 -| FormKF of cellID * edit * indent * nest * cterm' (*<--*)
7.114 + Error_ of string (*<--*)
7.115 +| FormKF of cellID * edit * indent * nest * Celem.cterm' (*<--*)
7.116 | PpcKF of cellID * edit * indent * nest * (pblmet * Model.item Model.ppc) (*<--*)
7.117 -| RefineKF of Stool.match list (*<--*)
7.118 -| RefinedKF of (pblID * ((Model.itm list) * ((bool * term) list))) (*<--*)
7.119 +| RefineKF of Stool.match list (*<--*)
7.120 +| RefinedKF of (Celem.pblID * ((Model.itm list) * ((bool * term) list))) (*<--*)
7.121
7.122 (*
7.123 datatype mout = EmptyMout | Error' of inout | Form' of inout | Problems of inout
7.124 *)
7.125 datatype mout =
7.126 - FormKF of cterm'
7.127 + FormKF of Celem.cterm'
7.128 | PpcKF of (pblmet * Model.item Model.ppc)
7.129 -| RefinedKF of pblID * (Model.itm list * (bool * term) list)
7.130 +| RefinedKF of Celem.pblID * (Model.itm list * (bool * term) list)
7.131 | Error' of string
7.132 | EmptyMout
7.133
7.134 @@ -157,13 +157,13 @@
7.135 (* init pbl with ...,dsc,empty | [] *)
7.136 fun init_pbl pbt =
7.137 let
7.138 - fun pbt2itm (f, (d, _)) = (0, [], false, f, Model.Inc ((d, []), (e_term, [])))
7.139 + fun pbt2itm (f, (d, _)) = (0, [], false, f, Model.Inc ((d, []), (Celem.e_term, [])))
7.140 in map pbt2itm pbt end
7.141
7.142 (* take formal parameters from pbt, for transfer from pbl/met-hierarchy *)
7.143 fun init_pbl' pbt =
7.144 let
7.145 - fun pbt2itm (f, (d, t)) = (0, [], false, f, Model.Inc((d, [t]), (e_term, [])))
7.146 + fun pbt2itm (f, (d, t)) = (0, [], false, f, Model.Inc((d, [t]), (Celem.e_term, [])))
7.147 in map pbt2itm pbt end
7.148
7.149 (*generate 1 ppobj in ctree*)
7.150 @@ -241,7 +241,7 @@
7.151 in if p' = 0 then ps @ [1] else p end
7.152 val (pt, c) = cappend_form pt p l t
7.153 in
7.154 - ((p, Frm): pos', c, FormKF (term2str t), pt)
7.155 + ((p, Frm): pos', c, FormKF (Celem.term2str t), pt)
7.156 end
7.157 | generate1 _ (Tac.Begin_Trans' t) l (p, Frm) pt =
7.158 let
7.159 @@ -251,7 +251,7 @@
7.160 val p = (lev_on o lev_dn (* starts with [...,0] *)) p
7.161 val (pt, c') = cappend_form pt p l t (*FIXME.0402 same istate ???*)
7.162 in
7.163 - ((p, Frm), c @ c', FormKF (term2str t), pt)
7.164 + ((p, Frm), c @ c', FormKF (Celem.term2str t), pt)
7.165 end
7.166 | generate1 thy (Tac.Begin_Trans' t) l (p, Res) pt =
7.167 (*append after existing PrfObj vvvvvvvvvvvvv*)
7.168 @@ -269,7 +269,7 @@
7.169 (Tac.Rewrite_Inst (Selem.subst2subs subs', thm')) (f',asm) Complete;
7.170 val pt = update_branch pt p TransitiveB
7.171 in
7.172 - ((p, Res), c, FormKF (term2str f'), pt)
7.173 + ((p, Res), c, FormKF (Celem.term2str f'), pt)
7.174 end
7.175 | generate1 _ (Tac.Rewrite' (_, _, _, _, thm', f, (f', asm))) (is, ctxt) (p, _) pt =
7.176 let
7.177 @@ -277,24 +277,24 @@
7.178 (Tac.Rewrite thm') (f', asm) Complete
7.179 val pt = update_branch pt p TransitiveB
7.180 in
7.181 - ((p, Res), c, FormKF (term2str f'), pt)
7.182 + ((p, Res), c, FormKF (Celem.term2str f'), pt)
7.183 end
7.184 | generate1 thy (Tac.Rewrite_Asm' all) l p pt = generate1 thy (Tac.Rewrite' all) l p pt
7.185 | generate1 _ (Tac.Rewrite_Set_Inst' (_, _, subs', rls', f, (f', asm))) (is, ctxt) (p, _) pt =
7.186 let
7.187 val (pt, c) = cappend_atomic pt p (is, Stool.insert_assumptions asm ctxt) f
7.188 - (Tac.Rewrite_Set_Inst (Selem.subst2subs subs', id_rls rls')) (f', asm) Complete
7.189 + (Tac.Rewrite_Set_Inst (Selem.subst2subs subs', Celem.id_rls rls')) (f', asm) Complete
7.190 val pt = update_branch pt p TransitiveB
7.191 in
7.192 - ((p, Res), c, FormKF (term2str f'), pt)
7.193 + ((p, Res), c, FormKF (Celem.term2str f'), pt)
7.194 end
7.195 | generate1 thy (Tac.Detail_Set_Inst' (_, _, subs, rls, f, (_, asm))) (is, ctxt) (p, _) pt =
7.196 let
7.197 val ctxt' = Stool.insert_assumptions asm ctxt
7.198 val (pt, _) = cappend_form pt p (is, ctxt') f
7.199 val pt = update_branch pt p TransitiveB
7.200 - val is = init_istate (Tac.Rewrite_Set_Inst (Selem.subst2subs subs, id_rls rls)) f
7.201 - val tac_ = Tac.Apply_Method' (e_metID, SOME e_term (*t ..has not been declared*), is, ctxt')
7.202 + val is = init_istate (Tac.Rewrite_Set_Inst (Selem.subst2subs subs, Celem.id_rls rls)) f
7.203 + val tac_ = Tac.Apply_Method' (Celem.e_metID, SOME Celem.e_term (*t ..has not been declared*), is, ctxt')
7.204 val pos' = ((lev_on o lev_dn) p, Frm)
7.205 in
7.206 generate1 thy tac_ (is, ctxt') pos' pt (*implicit Take*)
7.207 @@ -302,18 +302,18 @@
7.208 | generate1 _ (Tac.Rewrite_Set' (_, _, rls', f, (f', asm))) (is, ctxt) (p, _) pt =
7.209 let
7.210 val (pt, c) = cappend_atomic pt p (is, Stool.insert_assumptions asm ctxt) f
7.211 - (Tac.Rewrite_Set (id_rls rls')) (f',asm) Complete
7.212 + (Tac.Rewrite_Set (Celem.id_rls rls')) (f',asm) Complete
7.213 val pt = update_branch pt p TransitiveB
7.214 in
7.215 - ((p, Res), c, FormKF (term2str f'), pt)
7.216 + ((p, Res), c, FormKF (Celem.term2str f'), pt)
7.217 end
7.218 | generate1 thy (Tac.Detail_Set' (_, _, rls, f, (_, asm))) (is, ctxt) (p, _) pt =
7.219 let
7.220 val ctxt' = Stool.insert_assumptions asm ctxt
7.221 val (pt, _) = cappend_form pt p (is, ctxt') f
7.222 val pt = update_branch pt p TransitiveB
7.223 - val is = init_istate (Tac.Rewrite_Set (id_rls rls)) f
7.224 - val tac_ = Tac.Apply_Method' (e_metID, SOME e_term (*t ..has not been declared*), is, ctxt')
7.225 + val is = init_istate (Tac.Rewrite_Set (Celem.id_rls rls)) f
7.226 + val tac_ = Tac.Apply_Method' (Celem.e_metID, SOME Celem.e_term (*t ..has not been declared*), is, ctxt')
7.227 val pos' = ((lev_on o lev_dn) p, Frm)
7.228 in
7.229 generate1 thy tac_ (is, ctxt') pos' pt (*implicit Take*)
7.230 @@ -322,31 +322,31 @@
7.231 let
7.232 val (pt, c) = append_result pt p l (scval, asm) Complete
7.233 in
7.234 - ((p, Res), c, FormKF (term2str scval), pt)
7.235 + ((p, Res), c, FormKF (Celem.term2str scval), pt)
7.236 end
7.237 | generate1 _ (Tac.Calculate' (_, op_, f, (f', _))) l (p, _) pt =
7.238 let
7.239 val (pt,c) = cappend_atomic pt p l f (Tac.Calculate op_) (f', []) Complete
7.240 in
7.241 - ((p, Res), c, FormKF (term2str f'), pt)
7.242 + ((p, Res), c, FormKF (Celem.term2str f'), pt)
7.243 end
7.244 | generate1 _ (Tac.Check_elementwise' (consts, pred, (f', asm))) l (p, _) pt =
7.245 let
7.246 val (pt,c) = cappend_atomic pt p l consts (Tac.Check_elementwise pred) (f', asm) Complete
7.247 in
7.248 - ((p, Res), c, FormKF (term2str f'), pt)
7.249 + ((p, Res), c, FormKF (Celem.term2str f'), pt)
7.250 end
7.251 | generate1 _ (Tac.Or_to_List' (ors, list)) l (p, _) pt =
7.252 let
7.253 val (pt,c) = cappend_atomic pt p l ors Tac.Or_to_List (list, []) Complete
7.254 in
7.255 - ((p, Res), c, FormKF (term2str list), pt)
7.256 + ((p, Res), c, FormKF (Celem.term2str list), pt)
7.257 end
7.258 | generate1 _ (Tac.Substitute' (_, _, subte, t, t')) l (p, _) pt =
7.259 let
7.260 val (pt,c) =
7.261 cappend_atomic pt p l t (Tac.Substitute (Selem.subte2sube subte)) (t',[]) Complete
7.262 - in ((p, Res), c, FormKF (term2str t'), pt)
7.263 + in ((p, Res), c, FormKF (Celem.term2str t'), pt)
7.264 end
7.265 | generate1 _ (Tac.Tac_ (_, f, id, f')) l (p, _) pt =
7.266 let
7.267 @@ -358,7 +358,7 @@
7.268 let
7.269 val (pt, c) = cappend_problem pt p l (fmz_, (domID, pblID, metID)) (oris, (domID, pblID, metID), hdl)
7.270 val pt = update_ctxt pt p ctxt
7.271 - val f = Syntax.string_of_term (thy2ctxt thy) f
7.272 + val f = Syntax.string_of_term (Celem.thy2ctxt thy) f
7.273 in
7.274 ((p, Pbl), c, FormKF f, pt)
7.275 end
7.276 @@ -388,7 +388,7 @@
7.277 | generate tacis (pt, c, _: pos'(*!dropped!WN0504redesign generate/tacis?*))=
7.278 let
7.279 val (tacis', (_, tac_, (p, is))) = split_last tacis
7.280 - val (p',c',_,pt') = generate1 (assoc_thy "Isac") tac_ is p pt
7.281 + val (p',c',_,pt') = generate1 (Celem.assoc_thy "Isac") tac_ is p pt
7.282 in
7.283 generate tacis' (pt', c@c', p')
7.284 end
7.285 @@ -419,7 +419,7 @@
7.286 (pos_plus (length tacis) (lev_dn p, Res), (new_val res ist, ctxt)))]
7.287 val {nrls, ...} = Specify.get_met (get_obj g_metID pt (par_pblobj pt p))
7.288 val (pt, c, pos as (p, _)) = generate (rev tacis) (pt, [], (p, Res))
7.289 - val pt = update_tac pt p (Tac.Derive (id_rls nrls))
7.290 + val pt = update_tac pt p (Tac.Derive (Celem.id_rls nrls))
7.291 val pt = update_branch pt p TransitiveB
7.292 in (c, (pt, pos: pos')) end
7.293 | embed_deriv tacis (pt, (p, Res)) =
7.294 @@ -436,7 +436,7 @@
7.295 (pos_plus (length tacis) (lev_dn p, Res), (new_val res ist, ctxt)))];
7.296 val {nrls, ...} = Specify.get_met (get_obj g_metID pt (par_pblobj pt p))
7.297 val (pt, c, pos as (p, _)) = generate (rev tacis) (pt, [], (p, Res))
7.298 - val pt = update_tac pt p (Tac.Derive (id_rls nrls))
7.299 + val pt = update_tac pt p (Tac.Derive (Celem.id_rls nrls))
7.300 val pt = update_branch pt p TransitiveB
7.301 in (c, (pt, pos)) end
7.302 | embed_deriv _ _ = error "embed_deriv: uncovered definition"
8.1 --- a/src/Tools/isac/Interpret/inform.sml Tue Mar 13 15:04:27 2018 +0100
8.2 +++ b/src/Tools/isac/Interpret/inform.sml Thu Mar 15 10:17:44 2018 +0100
8.3 @@ -6,13 +6,13 @@
8.4
8.5 signature INPUT_FORMULAS =
8.6 sig
8.7 - datatype iitem = Find of cterm' list | Given of cterm' list | Relate of cterm' list
8.8 + datatype iitem = Find of Celem.cterm' list | Given of Celem.cterm' list | Relate of Celem.cterm' list
8.9 type imodel = iitem list
8.10 - type icalhd = Ctree.pos' * cterm' * imodel * Ctree.pos_ * spec
8.11 - val fetchErrorpatterns : Tac.tac -> errpatID list
8.12 + type icalhd = Ctree.pos' * Celem.cterm' * imodel * Ctree.pos_ * Celem.spec
8.13 + val fetchErrorpatterns : Tac.tac -> Celem.errpatID list
8.14 val input_icalhd : Ctree.ctree -> icalhd -> Ctree.ctree * Ctree.ocalhd
8.15 val inform : Chead.calcstate' -> string -> string * Chead.calcstate'
8.16 - val find_fillpatterns : Ctree.state -> errpatID -> (fillpatID * term * thm * Selem.subs option) list
8.17 + val find_fillpatterns : Ctree.state -> Celem.errpatID -> (Celem.fillpatID * term * thm * Selem.subs option) list
8.18 val is_exactly_equal : Ctree.state -> string -> string * Tac.tac
8.19 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
8.20 (* NONE *)
8.21 @@ -45,40 +45,40 @@
8.22 (*** handle an input calc-head ***)
8.23
8.24 datatype iitem =
8.25 - Given of cterm' list
8.26 + Given of Celem.cterm' list
8.27 (*Where is never input*)
8.28 -| Find of cterm' list
8.29 -| Relate of cterm' list
8.30 +| Find of Celem.cterm' list
8.31 +| Relate of Celem.cterm' list
8.32
8.33 type imodel = iitem list
8.34
8.35 (*calc-head as input*)
8.36 type icalhd =
8.37 Ctree.pos' * (*the position of the calc-head in the calc-tree*)
8.38 - cterm' * (*the headline*)
8.39 - imodel * (*the model (without Find) of the calc-head*)
8.40 + Celem.cterm' * (*the headline*)
8.41 + imodel * (*the model (without Find) of the calc-head*)
8.42 Ctree.pos_ * (*model belongs to Pbl or Met*)
8.43 - spec; (*specification: domID, pblID, metID*)
8.44 -val e_icalhd = (Ctree.e_pos', "", [Given [""]], Ctree.Pbl, e_spec) : icalhd
8.45 + Celem.spec; (*specification: domID, pblID, metID*)
8.46 +val e_icalhd = (Ctree.e_pos', "", [Given [""]], Ctree.Pbl, Celem.e_spec)
8.47
8.48 -fun is_casinput (hdf : cterm') ((fmz_, spec) : Selem.fmz) =
8.49 - hdf <> "" andalso fmz_ = [] andalso spec = e_spec
8.50 +fun is_casinput (hdf : Celem.cterm') ((fmz_, spec) : Selem.fmz) =
8.51 + hdf <> "" andalso fmz_ = [] andalso spec = Celem.e_spec
8.52
8.53 (*.handle an input as into an algebra system.*)
8.54 fun dtss2itm_ ppc (d, ts) =
8.55 let
8.56 val (f, (d, id)) = the (find_first ((curry op= d) o
8.57 (#1: (term * term) -> term) o
8.58 - (#2: pbt_ -> (term * term))) ppc)
8.59 + (#2: Celem.pbt_ -> (term * term))) ppc)
8.60 in
8.61 ([1], true, f, Model.Cor ((d, ts), (id, ts)))
8.62 end
8.63
8.64 fun flattup2 (a, (b ,c, d, e)) = (a, b, c, d, e)
8.65
8.66 -fun cas_input_ ((dI, pI, mI): spec) dtss = (*WN110515 reconsider thy..ctxt*)
8.67 +fun cas_input_ ((dI, pI, mI): Celem.spec) dtss = (*WN110515 reconsider thy..ctxt*)
8.68 let
8.69 - val thy = assoc_thy dI
8.70 + val thy = Celem.assoc_thy dI
8.71 val {ppc, ...} = Specify.get_pbt pI
8.72 val its_ = map (dtss2itm_ ppc) dtss (*([1],true,"#Given",Cor (...))*)
8.73 val its = Specify.add_id its_
8.74 @@ -104,7 +104,7 @@
8.75 let
8.76 val (h, argl) = strip_comb hdt
8.77 in
8.78 - case assoc_cas (assoc_thy "Isac") h of
8.79 + case assoc_cas (Celem.assoc_thy "Isac") h of
8.80 NONE => NONE
8.81 | SOME (spec as (dI,_,_), argl2dtss) =>
8.82 let
8.83 @@ -112,7 +112,7 @@
8.84 val (pI, pits, mI, mits, pre, ctxt) = cas_input_ spec dtss
8.85 val spec = (dI, pI, mI)
8.86 val (pt,_) =
8.87 - Ctree.cappend_problem Ctree.e_ctree [] (Selem.e_istate, Selem.e_ctxt) ([], e_spec) ([], e_spec, hdt)
8.88 + Ctree.cappend_problem Ctree.e_ctree [] (Selem.e_istate, Selem.e_ctxt) ([], Celem.e_spec) ([], Celem.e_spec, hdt)
8.89 val pt = Ctree.update_spec pt [] spec
8.90 val pt = Ctree.update_pbl pt [] pits
8.91 val pt = Ctree.update_met pt [] mits
8.92 @@ -123,15 +123,15 @@
8.93 end
8.94
8.95 (*lazy evaluation for (Thy_Info_get_theory "Isac")*)
8.96 -fun Isac _ = assoc_thy "Isac";
8.97 +fun Isac _ = Celem.assoc_thy "Isac";
8.98
8.99 (* re-parse itms with a new thy and prepare for checking with ori list *)
8.100 fun parsitm dI (itm as (i, v, _, f, Model.Cor ((d, ts), _))) =
8.101 (let val t = Model.comp_dts (d, ts)
8.102 - val _ = (term_to_string''' dI t)
8.103 + val _ = (Celem.term_to_string''' dI t)
8.104 (*t his ^^^^^^^^^^^^ should raise the exn on unability of re-parsing dts *)
8.105 in itm end
8.106 - handle _ => (i, v, false, f, Model.Syn (term2str e_term (*t ..(t) has not been declared*))))
8.107 + handle _ => (i, v, false, f, Model.Syn (Celem.term2str Celem.e_term (*t ..(t) has not been declared*))))
8.108 | parsitm dI (i, v, b, f, Model.Syn str) =
8.109 (let val _ = (Thm.term_of o the o (TermC.parse dI)) str
8.110 in (i, v, b ,f, Model.Par str) end
8.111 @@ -142,24 +142,24 @@
8.112 handle _ => (i, v, b, f, Model.Syn str))
8.113 | parsitm dI (itm as (i, v, _, f, Model.Inc ((d, ts), _))) =
8.114 (let val t = Model.comp_dts (d,ts);
8.115 - val _ = term_to_string''' dI t;
8.116 + val _ = Celem.term_to_string''' dI t;
8.117 (*this ^ should raise the exn on unability of re-parsing dts*)
8.118 in itm end
8.119 - handle _ => (i, v, false, f, Model.Syn (term2str e_term (*t ..(t) has not been declared*))))
8.120 + handle _ => (i, v, false, f, Model.Syn (Celem.term2str Celem.e_term (*t ..(t) has not been declared*))))
8.121 | parsitm dI (itm as (i, v, _, f, Model.Sup (d, ts))) =
8.122 (let val t = Model.comp_dts (d,ts);
8.123 - val _ = term_to_string''' dI t;
8.124 + val _ = Celem.term_to_string''' dI t;
8.125 (*this ^ should raise the exn on unability of re-parsing dts*)
8.126 in itm end
8.127 - handle _ => (i, v, false, f, Model.Syn (term2str e_term (*t ..(t) has not been declared*))))
8.128 + handle _ => (i, v, false, f, Model.Syn (Celem.term2str Celem.e_term (*t ..(t) has not been declared*))))
8.129 | parsitm dI (itm as (i, v, _, f, Model.Mis (d, t'))) =
8.130 (let val t = d $ t';
8.131 - val _ = term_to_string''' dI t;
8.132 + val _ = Celem.term_to_string''' dI t;
8.133 (*this ^ should raise the exn on unability of re-parsing dts*)
8.134 in itm end
8.135 - handle _ => (i, v, false, f, Model.Syn (term2str e_term (*t ..(t) has not been declared*))))
8.136 + handle _ => (i, v, false, f, Model.Syn (Celem.term2str Celem.e_term (*t ..(t) has not been declared*))))
8.137 | parsitm dI (itm as (_, _, _, _, Model.Par _)) =
8.138 - error ("parsitm (" ^ Model.itm2str_ (thy2ctxt dI) itm ^ "): Par should be internal");
8.139 + error ("parsitm (" ^ Model.itm2str_ (Celem.thy2ctxt dI) itm ^ "): Par should be internal");
8.140
8.141 (*separate a list to a pair of elements that do NOT satisfy the predicate,
8.142 and of elements that satisfy the predicate, i.e. (false, true)*)
8.143 @@ -181,7 +181,7 @@
8.144 (* WN.9.11.03 copied from fun appl_add *)
8.145 fun appl_add' dI oris ppc pbt (sel, ct) =
8.146 let
8.147 - val ctxt = assoc_thy dI |> thy2ctxt;
8.148 + val ctxt = Celem.assoc_thy dI |> Celem.thy2ctxt;
8.149 in
8.150 case TermC.parseNEW ctxt ct of
8.151 NONE => (0, [], false, sel, Model.Syn ct)
8.152 @@ -193,7 +193,7 @@
8.153 | (msg,_) => error ("appl_add': " ^ msg))
8.154 | (_, (i, v, _, d, ts), _) =>
8.155 if is_e_ts ts
8.156 - then (i, v, false, sel, Model.Inc ((d, ts), (e_term, [])))
8.157 + then (i, v, false, sel, Model.Inc ((d, ts), (Celem.e_term, [])))
8.158 else (i, v, false, sel, Model.Sup (d, ts)))
8.159 end
8.160
8.161 @@ -219,7 +219,7 @@
8.162 (*.input into empty PblObj, i.e. empty fmz+origin (unknown example).*)
8.163 fun unknown_expl dI pbt selcts =
8.164 let
8.165 - val thy = assoc_thy dI
8.166 + val thy = Celem.assoc_thy dI
8.167 val its_ = map (fstr2itm_ thy pbt) selcts (*([1],true,"#Given",Cor (...))*)
8.168 val its = Specify.add_id its_
8.169 in map flattup2 its end
8.170 @@ -239,19 +239,19 @@
8.171 fun oris2itms _ _ [] = [] (* WN161130: similar in ptyps ?!? *)
8.172 | oris2itms pbt vat ((i, v, f, d, ts) :: os) =
8.173 if member op = vat v
8.174 - then (i, v, true, f, Model.Cor ((d, ts), (e_term, []))) :: (oris2itms pbt vat os)
8.175 + then (i, v, true, f, Model.Cor ((d, ts), (Celem.e_term, []))) :: (oris2itms pbt vat os)
8.176 else oris2itms pbt vat os
8.177
8.178 fun par2fstr (_, _, _, f, Model.Par s) = (f, s)
8.179 - | par2fstr itm = error ("par2fstr: called with " ^ Model.itm2str_ (thy2ctxt' "Isac") itm)
8.180 + | par2fstr itm = error ("par2fstr: called with " ^ Model.itm2str_ (Celem.thy2ctxt' "Isac") itm)
8.181 fun itms2fstr (_, _, _, f, Model.Cor ((d, ts), _)) = (f, Model.comp_dts'' (d, ts))
8.182 | itms2fstr (_, _, _, f, Model.Syn str) = (f, str)
8.183 | itms2fstr (_, _, _, f, Model.Typ str) = (f, str)
8.184 | itms2fstr (_, _, _, f, Model.Inc ((d, ts), _)) = (f, Model.comp_dts'' (d,ts))
8.185 | itms2fstr (_, _, _, f, Model.Sup (d, ts)) = (f, Model.comp_dts'' (d, ts))
8.186 - | itms2fstr (_, _, _, f, Model.Mis (d, t)) = (f, term2str (d $ t))
8.187 + | itms2fstr (_, _, _, f, Model.Mis (d, t)) = (f, Celem.term2str (d $ t))
8.188 | itms2fstr (itm as (_, _, _, _, Model.Par _)) =
8.189 - error ("parsitm (" ^ Model.itm2str_ (thy2ctxt' "Isac") itm ^ "): Par should be internal");
8.190 + error ("parsitm (" ^ Model.itm2str_ (Celem.thy2ctxt' "Isac") itm ^ "): Par should be internal");
8.191
8.192 fun imodel2fstr iitems =
8.193 let
8.194 @@ -273,7 +273,7 @@
8.195 else (*hacked WN0602 ~~~ ~~~~~~~~~, ..dropped !*)
8.196 let val (pos_, pits, mits) =
8.197 if dI <> sdI
8.198 - then let val its = map (parsitm (assoc_thy dI)) probl;
8.199 + then let val its = map (parsitm (Celem.assoc_thy dI)) probl;
8.200 val (its, trms) = filter_sep is_Par its;
8.201 val pbt = (#ppc o Specify.get_pbt) (#2 (Chead.some_spec ospec sspec))
8.202 in (Ctree.Pbl, appl_adds dI oris its pbt (map par2fstr trms), meth) end
8.203 @@ -284,7 +284,7 @@
8.204 let val pbt = (#ppc o Specify.get_pbt) pI
8.205 val dI' = #1 (Chead.some_spec ospec spec)
8.206 val oris = if pI = #2 ospec then oris
8.207 - else Specify.prep_ori fmz_(assoc_thy"Isac") pbt |> #1;
8.208 + else Specify.prep_ori fmz_(Celem.assoc_thy"Isac") pbt |> #1;
8.209 in (Ctree.Pbl, appl_adds dI' oris probl pbt
8.210 (map itms2fstr probl), meth) end
8.211 else if mI <> smI (*FIXME.WN0311: what if probl is incomplete?!*)
8.212 @@ -299,12 +299,12 @@
8.213 val pt = Ctree.update_spec pt p spec;
8.214 in if pos_ = Ctree.Pbl
8.215 then let val {prls,where_,...} = Specify.get_pbt (#2 (Chead.some_spec ospec spec))
8.216 - val pre = Stool.check_preconds (assoc_thy"Isac") prls where_ pits
8.217 + val pre = Stool.check_preconds (Celem.assoc_thy"Isac") prls where_ pits
8.218 in (Ctree.update_pbl pt p pits,
8.219 (Chead.ocalhd_complete pits pre spec, Ctree.Pbl, hdf', pits, pre, spec): Ctree.ocalhd)
8.220 end
8.221 else let val {prls,pre,...} = Specify.get_met (#3 (Chead.some_spec ospec spec))
8.222 - val pre = Stool.check_preconds (assoc_thy"Isac") prls pre mits
8.223 + val pre = Stool.check_preconds (Celem.assoc_thy"Isac") prls pre mits
8.224 in (Ctree.update_met pt p mits,
8.225 (Chead.ocalhd_complete mits pre spec, Ctree.Met, hdf', mits, pre, spec) : Ctree.ocalhd)
8.226 end
8.227 @@ -336,20 +336,20 @@
8.228 (* 040214: version for concat_deriv *)
8.229 fun rev_deriv' (t, r, (t', a)) = (t', Rtools.sym_rule r, (t, a));
8.230
8.231 -fun mk_tacis ro erls (t, r as Thm (id, thm), (t', a)) =
8.232 +fun mk_tacis ro erls (t, r as Celem.Thm (id, thm), (t', a)) =
8.233 (Tac.Rewrite (id, thm),
8.234 Tac.Rewrite' ("Isac", fst ro, erls, false, Lucin.rule2thm'' r, t, (t', a)),
8.235 (Ctree.e_pos'(*to be updated before generate tacis!!!*), (Selem.Uistate, Selem.e_ctxt)))
8.236 - | mk_tacis _ _ (t, r as Rls_ rls, (t', a)) =
8.237 + | mk_tacis _ _ (t, r as Celem.Rls_ rls, (t', a)) =
8.238 (Tac.Rewrite_Set (Lucin.rule2rls' r),
8.239 Tac.Rewrite_Set' ("Isac", false, rls, t, (t', a)),
8.240 (Ctree.e_pos'(*to be updated before generate tacis!!!*), (Selem.Uistate, Selem.e_ctxt)))
8.241 - | mk_tacis _ _ (t, r, _) = error ("mk_tacis: not impl. for " ^ rule2str r ^ " at " ^ term2str t)
8.242 + | mk_tacis _ _ (t, r, _) = error ("mk_tacis: not impl. for " ^ Celem.rule2str r ^ " at " ^ Celem.term2str t)
8.243
8.244 (* fo = ifo excluded already in inform *)
8.245 fun concat_deriv rew_ord erls rules fo ifo =
8.246 let
8.247 - fun derivat ([]:(term * rule * (term * term list)) list) = e_term
8.248 + fun derivat ([]:(term * Celem.rule * (term * term list)) list) = Celem.e_term
8.249 | derivat dt = (#1 o #3 o last_elem) dt
8.250 fun equal (_,_,(t1, _)) (_,_,(t2, _)) = t1=t2
8.251 val fod = Rtools.make_deriv (Isac"") erls rules (snd rew_ord) NONE fo
8.252 @@ -380,9 +380,9 @@
8.253 case p_ of
8.254 Ctree.Frm => Ctree.get_obj Ctree.g_form pt p
8.255 | Ctree.Res => (fst o (Ctree.get_obj Ctree.g_result pt)) p
8.256 - | _ => e_term (*on PblObj is fo <> ifo*);
8.257 + | _ => Celem.e_term (*on PblObj is fo <> ifo*);
8.258 val {nrls, ...} = Specify.get_met (Ctree.get_obj Ctree.g_metID pt (Ctree.par_pblobj pt p))
8.259 - val {rew_ord, erls, rules, ...} = rep_rls nrls
8.260 + val {rew_ord, erls, rules, ...} = Celem.rep_rls nrls
8.261 val (found, der) = concat_deriv rew_ord erls rules fo ifo; (*<---------------*)
8.262 in
8.263 if found
8.264 @@ -410,10 +410,10 @@
8.265 end
8.266
8.267 (* check if (agreed result, input formula) matches the error pattern "pat" modulo simplifier rls *)
8.268 -fun check_err_patt (res, inf) (subst: subst) (errpatID: errpatID, pat) rls =
8.269 +fun check_err_patt (res, inf) subst (errpatID, pat) rls =
8.270 let
8.271 val (res', _, _, rewritten) =
8.272 - Rewrite.rew_sub (Isac()) 1 subst e_rew_ord e_rls false [] (HOLogic.Trueprop $ pat) res;
8.273 + Rewrite.rew_sub (Isac()) 1 subst Celem.e_rew_ord Celem.e_rls false [] (HOLogic.Trueprop $ pat) res;
8.274 in
8.275 if rewritten
8.276 then
8.277 @@ -436,7 +436,7 @@
8.278 val (_, subst) = Rtools.get_bdv_subst prog env
8.279 fun scan (_, [], _) = NONE
8.280 | scan (errpatID, errpat :: errpats, _) =
8.281 - case check_err_patt (res, inf) (subst: subst) (errpatID, errpat) rls of
8.282 + case check_err_patt (res, inf) subst (errpatID, errpat) rls of
8.283 NONE => scan (errpatID, errpats, [])
8.284 | SOME errpatID => SOME errpatID
8.285 fun scans [] = NONE
8.286 @@ -456,7 +456,7 @@
8.287 if "no derivation found" then check_error_patterns.
8.288 ALTERNATIVE: check_error_patterns _within_ compare_step seems too expensive.*)
8.289 fun inform (cs as (_, _, (pt, pos as (p, _))): Chead.calcstate') istr =
8.290 - case TermC.parse (assoc_thy "Isac") istr of
8.291 + case TermC.parse (Celem.assoc_thy "Isac") istr of
8.292 SOME f_in =>
8.293 let
8.294 val f_in = Thm.term_of f_in
8.295 @@ -479,7 +479,7 @@
8.296 let
8.297 val pp = Ctree.par_pblobj pt p
8.298 val (errpats, nrls, prog) = case Specify.get_met (Ctree.get_obj Ctree.g_metID pt pp) of
8.299 - {errpats, nrls, scr = Prog prog, ...} => (errpats, nrls, prog)
8.300 + {errpats, nrls, scr = Celem.Prog prog, ...} => (errpats, nrls, prog)
8.301 | _ => error "inform: uncovered case of get_met"
8.302 val env = case Ctree.get_istate pt pos of
8.303 Selem.ScrState (env, _, _, _, _, _) => env
8.304 @@ -496,10 +496,10 @@
8.305
8.306 (* fill-in patterns an forms.
8.307 returns thm required by "fun in_fillform *)
8.308 -fun get_fillform (subs_opt, subst) (thm, form) errpatID ((fillpatID, pat, erpaID): fillpat) =
8.309 +fun get_fillform (subs_opt, subst) (thm, form) errpatID (fillpatID, pat, erpaID) =
8.310 let
8.311 val (form', _, _, rewritten) =
8.312 - Rewrite.rew_sub (Isac()) 1 subst e_rew_ord e_rls false [] (HOLogic.Trueprop $ pat) form;
8.313 + Rewrite.rew_sub (Isac()) 1 subst Celem.e_rew_ord Celem.e_rls false [] (HOLogic.Trueprop $ pat) form;
8.314 in (*the fillpat of the thm must be dedicated to errpatID*)
8.315 if errpatID = erpaID andalso rewritten
8.316 then SOME (fillpatID, HOLogic.mk_eq (form, form'), thm, subs_opt)
8.317 @@ -510,9 +510,9 @@
8.318 let
8.319 val thmDeriv = Thm.get_name_hint thm
8.320 val (part, thyID) = Rtools.thy_containing_thm thmDeriv
8.321 - val theID = [part, thyID, "Theorems", thmID_of_derivation_name thmDeriv]
8.322 + val theID = [part, thyID, "Theorems", Celem.thmID_of_derivation_name thmDeriv]
8.323 val fillpats = case Specify.get_the theID of
8.324 - Hthm {fillpats, ...} => fillpats
8.325 + Celem.Hthm {fillpats, ...} => fillpats
8.326 | _ => error "get_fillpats: uncovered case of get_the"
8.327 val some = map (get_fillform subst (thm, form) errpatID) fillpats
8.328 in some |> filter is_some |> map the end
8.329 @@ -522,22 +522,22 @@
8.330 val f_curr = Ctree.get_curr_formula (pt, pos);
8.331 val pp = Ctree.par_pblobj pt p
8.332 val (errpats, prog) = case Specify.get_met (Ctree.get_obj Ctree.g_metID pt pp) of
8.333 - {errpats, scr = Prog prog, ...} => (errpats, prog)
8.334 + {errpats, scr = Celem.Prog prog, ...} => (errpats, prog)
8.335 | _ => error "find_fillpatterns: uncovered case of get_met"
8.336 val env = case Ctree.get_istate pt pos of
8.337 Selem.ScrState (env, _, _, _, _, _) => env
8.338 | _ => error "inform: uncovered case of get_istate"
8.339 val subst = Rtools.get_bdv_subst prog env
8.340 val errpatthms = errpats
8.341 - |> filter ((curry op = errpatID) o (#1: errpat -> errpatID))
8.342 - |> map (#3: errpat -> thm list)
8.343 + |> filter ((curry op = errpatID) o (#1: Celem.errpat -> Celem.errpatID))
8.344 + |> map (#3: Celem.errpat -> thm list)
8.345 |> flat
8.346 in map (get_fillpats subst f_curr errpatID) errpatthms |> flat end
8.347
8.348 (* check if an input formula is exactly equal the rewrite from a rule
8.349 which is stored at the pos where the input is stored of "ok". *)
8.350 fun is_exactly_equal (pt, pos as (p, _)) istr =
8.351 - case TermC.parseNEW (assoc_thy "Isac" |> thy2ctxt) istr of
8.352 + case TermC.parseNEW (Celem.assoc_thy "Isac" |> Celem.thy2ctxt) istr of
8.353 NONE => ("syntax error in '" ^ istr ^ "'", Tac.Tac "")
8.354 | SOME ifo =>
8.355 let
8.356 @@ -569,13 +569,13 @@
8.357 | _ => "e_rls"
8.358 val (part, thyID) = Rtools.thy_containing_rls "Isac" rlsID;
8.359 val rls = case Specify.get_the [part, thyID, "Rulesets", rlsID] of
8.360 - Hrls {thy_rls = (_, rls), ...} => rls
8.361 + Celem.Hrls {thy_rls = (_, rls), ...} => rls
8.362 | _ => error "fetchErrorpatterns: uncovered case of get_the"
8.363 in case rls of
8.364 - Rls {errpatts, ...} => errpatts
8.365 - | Seq {errpatts, ...} => errpatts
8.366 - | Rrls {errpatts, ...} => errpatts
8.367 - | Erls => []
8.368 + Celem.Rls {errpatts, ...} => errpatts
8.369 + | Celem.Seq {errpatts, ...} => errpatts
8.370 + | Celem.Rrls {errpatts, ...} => errpatts
8.371 + | Celem.Erls => []
8.372 end
8.373
8.374 (**)
9.1 --- a/src/Tools/isac/Interpret/mathengine.sml Tue Mar 13 15:04:27 2018 +0100
9.2 +++ b/src/Tools/isac/Interpret/mathengine.sml Thu Mar 15 10:17:44 2018 +0100
9.3 @@ -17,19 +17,19 @@
9.4 val step : Ctree.pos' -> Chead.calcstate -> string * Chead.calcstate'
9.5 val detailstep :
9.6 Ctree.ctree -> Ctree.pos' -> string * Ctree.ctree * Ctree.pos'
9.7 - val get_pblID : Ctree.state -> pblID option
9.8 + val get_pblID : Ctree.state -> Celem.pblID option
9.9
9.10 - val initcontext_met : Ctree.ctree -> Ctree.pos' -> bool * string list * scr * Model.itm list * (bool * term) list
9.11 + val initcontext_met : Ctree.ctree -> Ctree.pos' -> bool * string list * Celem.scr * Model.itm list * (bool * term) list
9.12 val initcontext_pbl : Ctree.ctree -> Ctree.pos' -> bool * string list * term * Model.itm list * (bool * term) list
9.13 - val context_met : metID -> Ctree.ctree -> Ctree.pos -> bool * metID * scr * Model.itm list * (bool * term) list
9.14 - val context_pbl : pblID -> Ctree.ctree -> Ctree.pos -> bool * pblID * term * Model.itm list * (bool * term) list
9.15 - val set_method : metID -> Ctree.state -> Ctree.ctree * Ctree.ocalhd
9.16 - val set_problem : pblID -> Ctree.state -> Ctree.ctree * Ctree.ocalhd
9.17 - val set_theory : thyID -> Ctree.state -> Ctree.ctree * Ctree.ocalhd
9.18 - val tryrefine : pblID -> Ctree.ctree -> Ctree.pos' -> bool * pblID * term * Model.itm list * (bool * term) list
9.19 + val context_met : Celem.metID -> Ctree.ctree -> Ctree.pos -> bool * Celem.metID * Celem.scr * Model.itm list * (bool * term) list
9.20 + val context_pbl : Celem.pblID -> Ctree.ctree -> Ctree.pos -> bool * Celem.pblID * term * Model.itm list * (bool * term) list
9.21 + val set_method : Celem.metID -> Ctree.state -> Ctree.ctree * Ctree.ocalhd
9.22 + val set_problem : Celem.pblID -> Ctree.state -> Ctree.ctree * Ctree.ocalhd
9.23 + val set_theory : Celem.thyID -> Ctree.state -> Ctree.ctree * Ctree.ocalhd
9.24 + val tryrefine : Celem.pblID -> Ctree.ctree -> Ctree.pos' -> bool * Celem.pblID * term * Model.itm list * (bool * term) list
9.25 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
9.26 val CalcTreeTEST : Selem.fmz list -> Ctree.pos' * NEW * Generate.mout * (string * Tac.tac) * Selem.safe * Ctree.ctree
9.27 - val f2str : Generate.mout -> cterm'
9.28 + val f2str : Generate.mout -> Celem.cterm'
9.29 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
9.30 type nxt_
9.31 type lOc_
9.32 @@ -53,10 +53,10 @@
9.33 val (_, pI, _) = Ctree.get_obj Ctree.g_spec pt p'
9.34 val (_, (_, oI, _), _) = Ctree.get_obj Ctree.g_origin pt p'
9.35 in
9.36 - if pI <> e_pblID
9.37 + if pI <> Celem.e_pblID
9.38 then SOME pI
9.39 else
9.40 - if oI <> e_pblID then SOME oI else NONE end;
9.41 + if oI <> Celem.e_pblID then SOME oI else NONE end;
9.42
9.43 datatype lOc_ =
9.44 ERror of string (*after loc_specify, loc_solve*)
9.45 @@ -123,8 +123,8 @@
9.46 | _ => Chead.nxt_specif Tac.Model_Problem (pt, (p, Ctree.Pbl))
9.47 else
9.48 let
9.49 - val cpI = if pI = e_pblID then pI' else pI;
9.50 - val cmI = if mI = e_metID then mI' else mI;
9.51 + val cpI = if pI = Celem.e_pblID then pI' else pI;
9.52 + val cmI = if mI = Celem.e_metID then mI' else mI;
9.53 val {ppc, prls, where_, ...} = Specify.get_pbt cpI;
9.54 val pre = Stool.check_preconds "thy 100820" prls where_ probl;
9.55 val pb = foldl and_ (true, map fst pre);
9.56 @@ -282,11 +282,11 @@
9.57 => (probl, os, pI, hdl, pI')
9.58 | Ctree.PrfObj _ => error "initcontext_pbl: uncovered case"
9.59 val pblID =
9.60 - if pI' = e_pblID
9.61 + if pI' = Celem.e_pblID
9.62 then (* TODO.WN051125 (#init o get_pbt) pI *) takelast (2, pI)
9.63 else pI'
9.64 val {ppc, where_, prls, ...} = Specify.get_pbt pblID
9.65 - val (model_ok, (pbl, pre)) = Specify.match_itms_oris (assoc_thy "Isac") probl (ppc,where_,prls) os
9.66 + val (model_ok, (pbl, pre)) = Specify.match_itms_oris (Celem.assoc_thy "Isac") probl (ppc, where_, prls) os
9.67 in
9.68 (model_ok, pblID, hdl, pbl, pre)
9.69 end
9.70 @@ -297,11 +297,11 @@
9.71 case Ctree.get_obj I pt p of
9.72 Ctree.PblObj {meth, origin = (os, (_, _, mI), _), spec=(_, _, mI'), ...} => (meth, os, mI, mI')
9.73 | Ctree.PrfObj _ => error "initcontext_met: uncovered case"
9.74 - val metID = if mI' = e_metID
9.75 + val metID = if mI' = Celem.e_metID
9.76 then (*TODO.WN051125 (#init o get_pbt) pI *) takelast (2, mI)
9.77 else mI'
9.78 val {ppc, pre, prls, scr, ...} = Specify.get_met metID
9.79 - val (model_ok, (pbl, pre)) = Specify.match_itms_oris (assoc_thy "Isac") meth (ppc,pre,prls) os
9.80 + val (model_ok, (pbl, pre)) = Specify.match_itms_oris (Celem.assoc_thy "Isac") meth (ppc,pre,prls) os
9.81 in
9.82 (model_ok, metID, scr, pbl, pre)
9.83 end
9.84 @@ -314,7 +314,7 @@
9.85 Ctree.PblObj {probl,origin = (os, _, hdl),...} => (probl, os, hdl)
9.86 | Ctree.PrfObj _ => error "context_pbl: uncovered case"
9.87 val {ppc,where_,prls,...} = Specify.get_pbt pI
9.88 - val (model_ok, (pbl, pre)) = Specify.match_itms_oris (assoc_thy "Isac") probl (ppc,where_,prls) os
9.89 + val (model_ok, (pbl, pre)) = Specify.match_itms_oris (Celem.assoc_thy "Isac") probl (ppc,where_,prls) os
9.90 in
9.91 (model_ok, pI, hdl, pbl, pre)
9.92 end
9.93 @@ -326,7 +326,7 @@
9.94 Ctree.PblObj {meth, origin = (os, _, _),...} => (meth, os)
9.95 | Ctree.PrfObj _ => error "context_met: uncovered case"
9.96 val {ppc,pre,prls,scr,...} = Specify.get_met mI
9.97 - val (model_ok, (pbl, pre)) = Specify.match_itms_oris (assoc_thy "Isac") meth (ppc,pre,prls) os
9.98 + val (model_ok, (pbl, pre)) = Specify.match_itms_oris (Celem.assoc_thy "Isac") meth (ppc,pre,prls) os
9.99 in
9.100 (model_ok, mI, scr, pbl, pre)
9.101 end
9.102 @@ -338,11 +338,11 @@
9.103 Ctree.PblObj {probl, origin = (os, _, hdl), ...} => (probl, os, hdl)
9.104 | Ctree.PrfObj _ => error "context_met: uncovered case"
9.105 in
9.106 - case Specify.refine_pbl (assoc_thy "Isac") pI probl of
9.107 + case Specify.refine_pbl (Celem.assoc_thy "Isac") pI probl of
9.108 NONE => (*copy from context_pbl*)
9.109 let
9.110 val {ppc,where_,prls,...} = Specify.get_pbt pI
9.111 - val (_, (pbl, pre)) = Specify.match_itms_oris (assoc_thy "Isac") probl (ppc,where_,prls) os
9.112 + val (_, (pbl, pre)) = Specify.match_itms_oris (Celem.assoc_thy "Isac") probl (ppc,where_,prls) os
9.113 in
9.114 (false, pI, hdl, pbl, pre)
9.115 end
9.116 @@ -374,13 +374,13 @@
9.117 val (form, _, _) = Chead.pt_extract ptp
9.118 in
9.119 case form of
9.120 - Ctree.Form t => Generate.FormKF (term2str t)
9.121 + Ctree.Form t => Generate.FormKF (Celem.term2str t)
9.122 | Ctree.ModSpec (_, p_, _, gfr, pre, _) =>
9.123 Generate.PpcKF (
9.124 (case p_ of Ctree.Pbl => Generate.Problem []
9.125 | Ctree.Met => Generate.Method []
9.126 | _ => error "TESTg_form: uncovered case",
9.127 - Specify.itms2itemppc (assoc_thy"Isac") gfr pre))
9.128 + Specify.itms2itemppc (Celem.assoc_thy"Isac") gfr pre))
9.129 end
9.130
9.131 (* create a calc-tree; for use within sml: thus "^^^" NOT decoded to "^" etc;
10.1 --- a/src/Tools/isac/Interpret/model.sml Tue Mar 13 15:04:27 2018 +0100
10.2 +++ b/src/Tools/isac/Interpret/model.sml Thu Mar 15 10:17:44 2018 +0100
10.3 @@ -12,11 +12,11 @@
10.4 val oris2str : ori list -> string
10.5 val e_ori : ori
10.6 datatype item
10.7 - = Correct of cterm' | False of cterm' | Incompl of cterm' | Missing of cterm' | Superfl of string
10.8 + = Correct of Celem.cterm' | False of Celem.cterm' | Incompl of Celem.cterm' | Missing of Celem.cterm' | Superfl of string
10.9 | SyntaxE of string | TypeE of string
10.10 datatype itm_ = Cor of (term * (term list)) * (term * (term list))
10.11 - | Syn of cterm' | Typ of cterm' | Inc of (term * (term list)) * (term * (term list))
10.12 - | Sup of (term * (term list)) | Mis of (term * term) | Par of cterm'
10.13 + | Syn of Celem.cterm' | Typ of Celem.cterm' | Inc of (term * (term list)) * (term * (term list))
10.14 + | Sup of (term * (term list)) | Mis of (term * term) | Par of Celem.cterm'
10.15 val itm_2str : itm_ -> string
10.16 val itm_2str_ : Proof.context -> itm_ -> string
10.17 type itm
10.18 @@ -109,7 +109,7 @@
10.19 (b)
10.20 ==========================================================================*)
10.21
10.22 -val script_parse = the o (@{theory Script} |> thy2ctxt |> TermC.parseNEW);
10.23 +val script_parse = the o (@{theory Script} |> Celem.thy2ctxt |> TermC.parseNEW);
10.24 val e_listReal = script_parse "[]::(real list)";
10.25 val e_listBool = script_parse "[]::(bool list)";
10.26
10.27 @@ -149,21 +149,21 @@
10.28 then (d $ e_listReal)
10.29 else if LTool.is_booll_dsc d then (d $ e_listBool) else d
10.30 | comp_dts (d, ts) = (d $ (comp_ts (d, ts)))
10.31 - handle _ => error ("comp_dts: " ^ term2str d ^ " $ " ^ term2str (hd ts));
10.32 + handle _ => error ("comp_dts: " ^ Celem.term2str d ^ " $ " ^ Celem.term2str (hd ts));
10.33 fun comp_dts' (d, []) =
10.34 if LTool.is_reall_dsc d
10.35 then (d $ e_listReal)
10.36 else if LTool.is_booll_dsc d then (d $ e_listBool) else d
10.37 | comp_dts' (d, ts) = (d $ (comp_ts (d, ts)))
10.38 - handle _ => error ("comp_dts': " ^ term2str d ^ " $ " ^ term2str (hd ts));
10.39 + handle _ => error ("comp_dts': " ^ Celem.term2str d ^ " $ " ^ Celem.term2str (hd ts));
10.40 fun comp_dts'' (d, []) =
10.41 if LTool.is_reall_dsc d
10.42 - then term2str (d $ e_listReal)
10.43 + then Celem.term2str (d $ e_listReal)
10.44 else if LTool.is_booll_dsc d
10.45 - then term2str (d $ e_listBool)
10.46 - else term2str d
10.47 - | comp_dts'' (d, ts) = term2str (d $ (comp_ts (d, ts)))
10.48 - handle _ => error ("comp_dts'': " ^ term2str d ^ " $ " ^ term2str (hd ts));
10.49 + then Celem.term2str (d $ e_listBool)
10.50 + else Celem.term2str d
10.51 + | comp_dts'' (d, ts) = Celem.term2str (d $ (comp_ts (d, ts)))
10.52 + handle _ => error ("comp_dts'': " ^ Celem.term2str d ^ " $ " ^ Celem.term2str (hd ts));
10.53
10.54 (* decompose an input into description, terms (ev. elems of lists),
10.55 and the value for the problem-environment; inv to comp_dts *)
10.56 @@ -172,13 +172,13 @@
10.57 then if LTool.is_list_dsc d andalso TermC.is_list arg andalso LTool.is_unl d |> not
10.58 then (d, take_apart arg)
10.59 else (d, [arg])
10.60 - else (e_term, dest_list' t)
10.61 + else (Celem.e_term, dest_list' t)
10.62 | split_dts t =
10.63 let val t' as (h, _) = strip_comb t;
10.64 in
10.65 if LTool.is_dsc h
10.66 then (h, dest_list t')
10.67 - else (e_term, dest_list' t)
10.68 + else (Celem.e_term, dest_list' t)
10.69 end;
10.70 (* version returning ts only *)
10.71 fun split_dts' (d, arg) =
10.72 @@ -228,13 +228,13 @@
10.73 * (term list) (* [#0, epsilon] 9.5.03 outcommented *)
10.74 ) list;
10.75 fun pen2str ctxt (t, ts) =
10.76 - pair2str (term_to_string' ctxt t, (strs2str' o map (term_to_string' ctxt)) ts);
10.77 + pair2str (Celem.term_to_string' ctxt t, (strs2str' o map (Celem.term_to_string' ctxt)) ts);
10.78 fun penv2str_ thy penv = (strs2str' o (map (pen2str thy))) penv;
10.79
10.80 (* get the constant value from a penv *)
10.81 fun getval (id, values) =
10.82 case values of
10.83 - [] => error ("penv_value: no values in '" ^ term2str id)
10.84 + [] => error ("penv_value: no values in '" ^ Celem.term2str id)
10.85 | [v] => (id, v)
10.86 | (v1 :: v2 :: _) => (case v1 of
10.87 Const ("Script.Arbfix",_) => (id, v2)
10.88 @@ -248,7 +248,7 @@
10.89 fun mkval _(*dsc*) [] = error "mkval called with []"
10.90 | mkval _ [t] = t
10.91 | mkval _ ts = TermC.list2isalist ((type_of o hd) ts) ts;
10.92 -fun mkval' x = mkval e_term x;
10.93 +fun mkval' x = mkval Celem.e_term x;
10.94
10.95 (* the internal representation of a models' item
10.96 4.9.01: not consistent:
10.97 @@ -259,13 +259,13 @@
10.98 Cor of (term * (* description *)
10.99 (term list)) * (* for list: elem-wise input *)
10.100 (term * (term list)) (* elem of penv ---- penv delayed to future *)
10.101 -| Syn of cterm'
10.102 -| Typ of cterm'
10.103 +| Syn of Celem.cterm'
10.104 +| Typ of Celem.cterm'
10.105 | Inc of (term * (term list)) * (term * (term list)) (*lists,
10.106 + init_pbl WN.11.03 FIXXME: empty penv .. bad; init_pbl should return Mis !!! *)
10.107 | Sup of (term * (term list)) (* user-input not found in pbt(+?oris?11.03)*)
10.108 | Mis of (term * term) (* after re-specification pbt-item not found in pbl: only dsc, pid_*)
10.109 -| Par of cterm'; (* internal state from fun parsitm *)
10.110 +| Par of Celem.cterm'; (* internal state from fun parsitm *)
10.111
10.112 type vats = int list; (* variants in formalizations *)
10.113
10.114 @@ -326,19 +326,19 @@
10.115 term * (* description *)
10.116 term list (* isalist2list t | [t] *)
10.117 );
10.118 -val e_ori = (0, [], "", e_term, [e_term]) : ori;
10.119 +val e_ori = (0, [], "", Celem.e_term, [Celem.e_term]) : ori;
10.120
10.121 fun ori2str (i, vs, fi, t, ts) =
10.122 "(" ^ string_of_int i ^ ", " ^ (strs2str o (map string_of_int)) vs ^ ", " ^ fi ^ "," ^
10.123 - term2str t ^ ", " ^ (strs2str o (map term2str)) ts ^ ")";
10.124 -val oris2str = strs2str' o (map (linefeed o ori2str));
10.125 + Celem.term2str t ^ ", " ^ (strs2str o (map Celem.term2str)) ts ^ ")";
10.126 +val oris2str = strs2str' o (map (Celem.linefeed o ori2str));
10.127
10.128 (* an or without leading integer *)
10.129 type preori = (vats * string * term * term list);
10.130 fun preori2str (vs, fi, t, ts) =
10.131 "(" ^ (strs2str o (map string_of_int)) vs ^ ", " ^ fi ^ ", " ^
10.132 - term2str t ^ ", " ^ (strs2str o (map term2str)) ts ^ ")";
10.133 -val preoris2str = (strs2str' o (map (linefeed o preori2str)));
10.134 + Celem.term2str t ^ ", " ^ (strs2str o (map Celem.term2str)) ts ^ ")";
10.135 +val preoris2str = (strs2str' o (map (Celem.linefeed o preori2str)));
10.136
10.137 (* given the input value (from split_dts)
10.138 make the value in a problem-env according to description-type
10.139 @@ -353,14 +353,14 @@
10.140 then [v] (*eg. [r=Arbfix]*)
10.141 else
10.142 (case v of (*eg. eps=#0*) (Const ("HOL.eq", _) $ l $ r) => [r, l]
10.143 - | _ => error ("pbl_ids Tools.nam: no equality " ^ term_to_string' ctxt v))
10.144 + | _ => error ("pbl_ids Tools.nam: no equality " ^ Celem.term_to_string' ctxt v))
10.145 | pbl_ids _ (Const (_, Type ("fun", [_,Type ("Tools.una", _)]))) v = [v]
10.146 | pbl_ids _ (Const (_, Type ("fun", [_,Type ("Tools.unl", _)]))) v = [v]
10.147 | pbl_ids _ (Const (_, Type ("fun", [_,Type ("Tools.str", _)]))) v = [v]
10.148 | pbl_ids _ (Const (_, Type ("fun", [_,Type ("Tools.toreal", _)]))) v = [v]
10.149 | pbl_ids _ (Const (_, Type ("fun", [_,Type ("Tools.toreall", _)])))v = [v]
10.150 | pbl_ids _ (Const (_, Type ("fun", [_,Type ("Tools.unknown" ,_)])))v = [v]
10.151 - | pbl_ids _ _ v = error ("pbl_ids: not implemented for " ^ term2str v);
10.152 + | pbl_ids _ _ v = error ("pbl_ids: not implemented for " ^ Celem.term2str v);
10.153
10.154 (* given an already input itm, ((14.9.01: no difference to pbl_ids jet!!))
10.155 make the value in a problem-env according to description-type.
10.156 @@ -419,13 +419,13 @@
10.157
10.158 (* for _output_ of the items of a Model *)
10.159 datatype item =
10.160 - Correct of cterm' (* labels a correct formula (type cterm') *)
10.161 + Correct of Celem.cterm' (* labels a correct formula (type cterm') *)
10.162 | SyntaxE of string (**)
10.163 | TypeE of string (**)
10.164 - | False of cterm' (* WN050618 notexistent in itm_: only used in Where *)
10.165 - | Incompl of cterm' (**)
10.166 + | False of Celem.cterm' (* WN050618 notexistent in itm_: only used in Where *)
10.167 + | Incompl of Celem.cterm' (**)
10.168 | Superfl of string (**)
10.169 - | Missing of cterm';
10.170 + | Missing of Celem.cterm';
10.171 fun item2str (Correct s) ="Correct " ^ s
10.172 | item2str (SyntaxE s) ="SyntaxE " ^ s
10.173 | item2str (TypeE s) ="TypeE " ^ s
10.174 @@ -435,21 +435,21 @@
10.175 | item2str (Missing s) ="Missing " ^ s;
10.176 (*make string for error-msgs*)
10.177 fun itm_2str_ ctxt (Cor ((d, ts), penv)) =
10.178 - "Cor " ^ term_to_string' ctxt (comp_dts (d, ts)) ^ " ," ^ pen2str ctxt penv
10.179 + "Cor " ^ Celem.term_to_string' ctxt (comp_dts (d, ts)) ^ " ," ^ pen2str ctxt penv
10.180 | itm_2str_ _ (Syn c) = "Syn " ^ c
10.181 | itm_2str_ _ (Typ c) = "Typ " ^ c
10.182 | itm_2str_ ctxt (Inc ((d, ts), penv)) =
10.183 - "Inc " ^ term_to_string' ctxt (comp_dts (d, ts)) ^ " ," ^ pen2str ctxt penv
10.184 + "Inc " ^ Celem.term_to_string' ctxt (comp_dts (d, ts)) ^ " ," ^ pen2str ctxt penv
10.185 | itm_2str_ ctxt (Sup (d, ts)) =
10.186 - "Sup " ^ term_to_string' ctxt (comp_dts (d, ts))
10.187 + "Sup " ^ Celem.term_to_string' ctxt (comp_dts (d, ts))
10.188 | itm_2str_ ctxt (Mis (d, pid)) =
10.189 - "Mis "^ term_to_string' ctxt d ^ " " ^ term_to_string' ctxt pid
10.190 + "Mis "^ Celem.term_to_string' ctxt d ^ " " ^ Celem.term_to_string' ctxt pid
10.191 | itm_2str_ _ (Par s) = "Trm "^s;
10.192 -fun itm_2str t = itm_2str_ (thy2ctxt' "Isac") t;
10.193 +fun itm_2str t = itm_2str_ (Celem.thy2ctxt' "Isac") t;
10.194 fun itm2str_ ctxt ((i, is, b, s, itm_):itm) =
10.195 "(" ^ string_of_int i ^ " ," ^ ints2str' is ^ " ," ^ bool2str b ^ " ," ^
10.196 s ^ " ," ^ itm_2str_ ctxt itm_ ^ ")";
10.197 -fun itms2str_ ctxt itms = strs2str' (map (linefeed o (itm2str_ ctxt)) itms);
10.198 +fun itms2str_ ctxt itms = strs2str' (map (Celem.linefeed o (itm2str_ ctxt)) itms);
10.199 fun init_item str = SyntaxE str;
10.200
10.201 type 'a ppc =
10.202 @@ -489,14 +489,14 @@
10.203 | d_in (Mis (d, _)) = d
10.204 | d_in _ = error "d_in: uncovered case in fun.def.";
10.205
10.206 -fun dts2str (d, ts) = pair2str (term2str d, terms2str ts);
10.207 +fun dts2str (d, ts) = pair2str (Celem.term2str d, Celem.terms2str ts);
10.208 fun penvval_in (Cor ((d, _), (_, ts))) = [comp_ts (d,ts)]
10.209 | penvval_in (Syn (c)) = (tracing("*** penvval_in: Syn ("^c^")"); [])
10.210 | penvval_in (Typ (c)) = (tracing("*** penvval_in: Typ ("^c^")"); [])
10.211 | penvval_in (Inc (_, (_, ts))) = ts
10.212 | penvval_in (Sup dts) = (tracing ("*** penvval_in: Sup "^(dts2str dts)); [])
10.213 | penvval_in (Mis (d, t)) = (tracing ("*** penvval_in: Mis " ^
10.214 - pair2str(term2str d, term2str t)); [])
10.215 + pair2str(Celem.term2str d, Celem.term2str t)); [])
10.216 | penvval_in _ = error "penvval_in: uncovered case in fun.def.";
10.217
10.218 (* check a predicate labelled with indication of incomplete substitution;
10.219 @@ -507,7 +507,7 @@
10.220 bool * (* has the precondition evaluated to true *)
10.221 term (* the precondition (for map) *)
10.222 *)
10.223 -fun pre2str (b, t) = pair2str(bool2str b, term2str t);
10.224 -fun pres2str pres = strs2str' (map (linefeed o pre2str) pres);
10.225 +fun pre2str (b, t) = pair2str(bool2str b, Celem.term2str t);
10.226 +fun pres2str pres = strs2str' (map (Celem.linefeed o pre2str) pres);
10.227
10.228 end;
10.229 \ No newline at end of file
11.1 --- a/src/Tools/isac/Interpret/mstools.sml Tue Mar 13 15:04:27 2018 +0100
11.2 +++ b/src/Tools/isac/Interpret/mstools.sml Thu Mar 15 10:17:44 2018 +0100
11.3 @@ -9,8 +9,8 @@
11.4
11.5 signature SPECIFY_TOOL =
11.6 sig
11.7 - val check_preconds : 'a -> rls -> term list -> Model.itm list -> (bool * term) list
11.8 - val check_preconds' : rls -> term list -> Model.itm list -> 'a -> (bool * term) list
11.9 + val check_preconds : 'a -> Celem.rls -> term list -> Model.itm list -> (bool * term) list
11.10 + val check_preconds' : Celem.rls -> term list -> Model.itm list -> 'a -> (bool * term) list
11.11
11.12 val get_assumptions : Proof.context -> term list
11.13 val insert_assumptions : term list -> Proof.context -> Proof.context
11.14 @@ -18,19 +18,19 @@
11.15 val declare_constraints' : term list -> Proof.context -> Proof.context
11.16 val from_subpbl_to_caller : Proof.context -> term -> Proof.context -> Proof.context
11.17
11.18 - datatype match_ = Match_ of pblID * (Model.itm list * (bool * term) list) | NoMatch_
11.19 + datatype match_ = Match_ of Celem.pblID * (Model.itm list * (bool * term) list) | NoMatch_
11.20 val refined_ : match_ list -> match_ option
11.21 - datatype match = Matches of pblID * Model.item Model.ppc | NoMatch of pblID * Model.item Model.ppc
11.22 + datatype match = Matches of Celem.pblID * Model.item Model.ppc | NoMatch of Celem.pblID * Model.item Model.ppc
11.23 val matchs2str : match list -> string
11.24 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
11.25 val pres2str : (bool * term) list -> string
11.26 - val refined : match list -> pblID
11.27 + val refined : match list -> Celem.pblID
11.28 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
11.29 val transfer_asms_from_to : Proof.context -> Proof.context -> Proof.context
11.30 ( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
11.31
11.32 (*----- unused code, kept as hints to design ideas ---------------------------------------------*)
11.33 - val pblID_of_match : match -> pblID
11.34 + val pblID_of_match : match -> Celem.pblID
11.35 val refined_IDitms : match list -> match option
11.36 end
11.37
11.38 @@ -38,8 +38,8 @@
11.39 struct
11.40
11.41 datatype match =
11.42 - Matches of pblID * Model.item Model.ppc
11.43 -| NoMatch of pblID * Model.item Model.ppc;
11.44 + Matches of Celem.pblID * Model.item Model.ppc
11.45 +| NoMatch of Celem.pblID * Model.item Model.ppc;
11.46 fun match2str (Matches (pI, ppc)) = "Matches (" ^ strs2str pI ^ ", " ^ Model.itemppc2str ppc ^ ")"
11.47 | match2str (NoMatch (pI, ppc)) = "NoMatch (" ^ strs2str pI ^ ", " ^ Model.itemppc2str ppc ^ ")";
11.48 fun matchs2str ms = (strs2str o (map match2str)) ms;
11.49 @@ -48,7 +48,7 @@
11.50
11.51 (* 10.03 for Refine_Problem *)
11.52 datatype match_ =
11.53 - Match_ of pblID * (( Model.itm list) * ((bool * term) list))
11.54 + Match_ of Celem.pblID * (( Model.itm list) * ((bool * term) list))
11.55 | NoMatch_;
11.56
11.57 (* the refined pbt is the last_element Matches in the list *)
11.58 @@ -57,7 +57,7 @@
11.59 fun matches_pblID (Matches (pI, _)) = pI
11.60 | matches_pblID _ = error "matches_pblID: uncovered case in fun.def.";
11.61 fun refined ms = ((matches_pblID o the o (find_first is_matches) o rev) ms)
11.62 - handle _ => [] : pblID;
11.63 + handle _ => [];
11.64 fun refined_IDitms ms = ((find_first is_matches) o rev) ms;
11.65
11.66 (* the refined pbt is the last_element Matches in the list, for Refine_Problem, tryrefine *)
11.67 @@ -77,13 +77,13 @@
11.68 (*NOT ALL Free's have been substituted, eg. because of incomplete model*)
11.69 (false, pre)
11.70 | evalprecond prls (true, pre) =
11.71 - if Rewrite.eval_true (assoc_thy "Isac") (* for Pattern.match *)
11.72 + if Rewrite.eval_true (Celem.assoc_thy "Isac") (* for Pattern.match *)
11.73 [pre] prls (* pre parsed, prls.thy *)
11.74 then (true , pre)
11.75 else (false , pre);
11.76
11.77 -fun pre2str (b, t) = pair2str(bool2str b, term2str t);
11.78 -fun pres2str pres = strs2str' (map (linefeed o pre2str) pres);
11.79 +fun pre2str (b, t) = pair2str(bool2str b, Celem.term2str t);
11.80 +fun pres2str pres = strs2str' (map (Celem.linefeed o pre2str) pres);
11.81
11.82 (* check preconditions, return true if all true *)
11.83 fun check_preconds' _ [] _ _ = [] (* empty preconditions are true *)
12.1 --- a/src/Tools/isac/Interpret/ptyps.sml Tue Mar 13 15:04:27 2018 +0100
12.2 +++ b/src/Tools/isac/Interpret/ptyps.sml Thu Mar 15 10:17:44 2018 +0100
12.3 @@ -10,45 +10,48 @@
12.4 val prep_ori : Selem.fmz_ -> theory -> field list -> Model.ori list * Proof.context
12.5 val add_id : 'a list -> (int * 'a) list
12.6 val add_field' : theory -> field list -> Model.ori list -> Model.ori list
12.7 - val match_itms_oris : theory -> Model.itm list -> field list * term list * rls ->
12.8 + val match_itms_oris : theory -> Model.itm list -> field list * term list * Celem.rls ->
12.9 Model.ori list -> bool * (Model.itm list * (bool * term) list)
12.10 - val refine_ori : Model.ori list -> pblID -> pblID option
12.11 - val refine_ori' : Model.ori list -> pblID -> pblID
12.12 - val refine_pbl : theory -> pblID -> Model.itm list -> (pblID * (Model.itm list * (bool * term) list)) option
12.13 + val refine_ori : Model.ori list -> Celem.pblID -> Celem.pblID option
12.14 + val refine_ori' : Model.ori list -> Celem.pblID -> Celem.pblID
12.15 + val refine_pbl : theory -> Celem.pblID -> Model.itm list ->
12.16 + (Celem.pblID * (Model.itm list * (bool * term) list)) option
12.17
12.18 val appc : ('a list -> 'b list) -> 'a Model.ppc -> 'b Model.ppc
12.19 val mappc : ('a -> 'b) -> 'a Model.ppc -> 'b Model.ppc
12.20 val itms2itemppc : theory -> Model.itm list -> (bool * term) list -> Model.item Model.ppc (* for generate.sml *)
12.21
12.22 - val get_pbt : pblID -> pbt
12.23 - val get_met : metID -> met (* for generate.sml *)
12.24 - val get_met' : theory -> metID -> met (* for pbl-met-hierarchy.sml *)
12.25 - val get_the : theID -> thydata (* for inform.sml *)
12.26 + val get_pbt : Celem.pblID -> Celem.pbt
12.27 + val get_met : Celem.metID -> Celem.met (* for generate.sml *)
12.28 + val get_met' : theory -> Celem.metID -> Celem.met (* for pbl-met-hierarchy.sml *)
12.29 + val get_the : Celem.theID -> Celem.thydata (* for inform.sml *)
12.30
12.31 type pblRD = string list (* for pbl-met-hierarchy.sml *)
12.32 val format_pblIDl : string list list -> string (* for thy-hierarchy.sml *)
12.33 - val scan : string list -> 'a ptyp list -> string list list (* for thy-hierarchy.sml *)
12.34 + val scan : string list -> 'a Celem.ptyp list -> string list list (* for thy-hierarchy.sml *)
12.35 val itm_out : theory -> Model.itm_ -> string
12.36 val dsc_unknown : term
12.37
12.38 - val pblID2guh : pblID -> guh (* for datatypes.sml *)
12.39 - val metID2guh : metID -> guh (* for datatypes.sml *)
12.40 - val kestoreID2guh : ketype -> kestoreID -> guh (* for datatypes.sml *)
12.41 - val guh2kestoreID : guh -> string list (* for interface.sml *)
12.42 + val pblID2guh : Celem.pblID -> Celem.guh (* for datatypes.sml *)
12.43 + val metID2guh : Celem.metID -> Celem.guh (* for datatypes.sml *)
12.44 + val kestoreID2guh : Celem.ketype -> Celem.kestoreID -> Celem.guh (* for datatypes.sml *)
12.45 + val guh2kestoreID : Celem.guh -> string list (* for interface.sml *)
12.46 (* for Knowledge/, if below at left margin *)
12.47 - val prep_pbt : theory -> guh -> string list -> pblID ->
12.48 - string list * (string * string list) list * rls * string option * metID list -> pbt * pblID
12.49 - val prep_met : theory -> string -> string list -> pblID ->
12.50 + val prep_pbt : theory -> Celem.guh -> string list -> Celem.pblID ->
12.51 + string list * (string * string list) list * Celem.rls * string option * Celem.metID list ->
12.52 + Celem.pbt * Celem.pblID
12.53 + val prep_met : theory -> string -> string list -> Celem.pblID ->
12.54 string list * (string * string list) list *
12.55 - {calc: 'a, crls: rls, errpats: errpat list, nrls: rls, prls: rls, rew_ord': rew_ord', rls': rls, srls: rls}
12.56 - * string -> met * metID
12.57 + {calc: 'a, crls: Celem.rls, errpats: Celem.errpat list, nrls: Celem.rls, prls: Celem.rls,
12.58 + rew_ord': Celem.rew_ord', rls': Celem.rls, srls: Celem.rls} * string ->
12.59 + Celem.met * Celem.metID
12.60 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
12.61 val show_ptyps : unit -> unit
12.62 val show_mets : unit -> unit
12.63 datatype match' = Matches' of Model.item Model.ppc | NoMatch' of Model.item Model.ppc
12.64 - val match_pbl : Selem.fmz_ -> pbt -> match'
12.65 - val refine : Selem.fmz_ -> pblID -> Stool.match list
12.66 - val e_errpat : errpat
12.67 + val match_pbl : Selem.fmz_ -> Celem.pbt -> match'
12.68 + val refine : Selem.fmz_ -> Celem.pblID -> Stool.match list
12.69 + val e_errpat : Celem.errpat
12.70 val show_pblguhs : unit -> unit
12.71 val sort_pblguhs : unit -> unit
12.72 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
12.73 @@ -69,12 +72,12 @@
12.74 type field = string * (term * term)
12.75 val dsc_unknown = (Thm.term_of o the o (TermC.parseold @{theory Script})) "unknown::'a => unknow";
12.76
12.77 -fun itm_2item (_: theory) (Model.Cor ((d, ts), _)) = Model.Correct (term2str (Model.comp_dts (d, ts)))
12.78 +fun itm_2item (_: theory) (Model.Cor ((d, ts), _)) = Model.Correct (Celem.term2str (Model.comp_dts (d, ts)))
12.79 | itm_2item _ (Model.Syn c) = Model.SyntaxE c
12.80 | itm_2item _ (Model.Typ c) = Model.TypeE c
12.81 - | itm_2item _ (Model.Inc ((d, ts), _)) = Model.Incompl (term2str (Model.comp_dts (d, ts)))
12.82 - | itm_2item _ (Model.Sup (d, ts)) = Model.Superfl (term2str (Model.comp_dts (d, ts)))
12.83 - | itm_2item _ (Model.Mis (d, pid)) = Model.Missing (term2str d ^ " " ^ term2str pid)
12.84 + | itm_2item _ (Model.Inc ((d, ts), _)) = Model.Incompl (Celem.term2str (Model.comp_dts (d, ts)))
12.85 + | itm_2item _ (Model.Sup (d, ts)) = Model.Superfl (Celem.term2str (Model.comp_dts (d, ts)))
12.86 + | itm_2item _ (Model.Mis (d, pid)) = Model.Missing (Celem.term2str d ^ " " ^ Celem.term2str pid)
12.87 | itm_2item _ _ = error "itm_2item: uncovered definition"
12.88
12.89 fun mappc f {Given = gi, Where = wh, Find = fi, With = wi, Relate = re} =
12.90 @@ -98,20 +101,20 @@
12.91 let
12.92 val (hd, arg) = case strip_comb t of
12.93 (hd, [arg]) => (hd, arg)
12.94 - | _ => error ("split_did: doesn't match (hd,[arg]) for t = " ^ term2str t)
12.95 + | _ => error ("split_did: doesn't match (hd,[arg]) for t = " ^ Celem.term2str t)
12.96 in (hd, arg) end
12.97
12.98 (*create output-string for itm_*)
12.99 -fun itm_out _ (Model.Cor ((d, ts), _)) = term2str (Model.comp_dts (d, ts))
12.100 +fun itm_out _ (Model.Cor ((d, ts), _)) = Celem.term2str (Model.comp_dts (d, ts))
12.101 | itm_out _ (Model.Syn c) = c
12.102 | itm_out _ (Model.Typ c) = c
12.103 - | itm_out _ (Model.Inc ((d, ts), _)) = term2str (Model.comp_dts (d, ts))
12.104 - | itm_out _ (Model.Sup (d, ts)) = term2str (Model.comp_dts (d, ts))
12.105 - | itm_out _ (Model.Mis (d, pid)) = term2str d ^ " " ^ term2str pid
12.106 + | itm_out _ (Model.Inc ((d, ts), _)) = Celem.term2str (Model.comp_dts (d, ts))
12.107 + | itm_out _ (Model.Sup (d, ts)) = Celem.term2str (Model.comp_dts (d, ts))
12.108 + | itm_out _ (Model.Mis (d, pid)) = Celem.term2str d ^ " " ^ Celem.term2str pid
12.109 | itm_out _ _ = error "itm_out: uncovered definition"
12.110
12.111 -fun boolterm2item (true, term) = Model.Correct (term2str term)
12.112 - | boolterm2item (false, term) = Model.False (term2str term);
12.113 +fun boolterm2item (true, term) = Model.Correct (Celem.term2str term)
12.114 + | boolterm2item (false, term) = Model.False (Celem.term2str term);
12.115
12.116 fun itms2itemppc thy itms pre =
12.117 let
12.118 @@ -127,7 +130,7 @@
12.119 in case filter (eq d) pbt of
12.120 [(fi, (_, _))] => (fi, d, ts)
12.121 | [] => ("#undef", d, ts) (*may come with met.ppc*)
12.122 - | _ => error ("add_field: " ^ term2str d ^ " more than once in pbt")
12.123 + | _ => error ("add_field: " ^ Celem.term2str d ^ " more than once in pbt")
12.124 end;
12.125
12.126 (* take over field from met.ppc at 'Specify_Method' into ori,
12.127 @@ -138,7 +141,7 @@
12.128 case filter (eq d) mpc of
12.129 [(fi, (_, _))] => [(i, v, fi, d, ts)]
12.130 | [] => [] (*25.2.02: dsc in ori, but not in met -> superfluous*)
12.131 - | _ => error ("add_field': " ^ term2str d ^ " more than once in met");
12.132 + | _ => error ("add_field': " ^ Celem.term2str d ^ " more than once in met");
12.133 in flat ((map (repl mpc)) ori) end;
12.134
12.135 (* mark an element with the position within a plateau;
12.136 @@ -201,33 +204,33 @@
12.137 |> map flattup;
12.138 in (oris, ctxt) end;
12.139
12.140 -val e_errpat = ("e_errpatID", [TermC.parse_patt @{theory} "?a = ?b"], [@{thm refl}]): errpat
12.141 +val e_errpat = ("e_errpatID", [TermC.parse_patt @{theory} "?a = ?b"], [@{thm refl}]): Celem.errpat
12.142 val e_fillpat = ("e_fillpatID", TermC.parse_patt @{theory} "?a = _", "e_errpatID")
12.143
12.144 (** breadth-first search on hierarchy of problem-types **)
12.145
12.146 (* pblID are reverted _on calling_ the retrieve-funs *)
12.147 -type pblRD = (*e.g. ["equations","univariate","normalise"] for internal retrieval *)
12.148 - pblID; (*e.g. ["normalise","univariate","equations"] presented to student *)
12.149 +type pblRD = (*e.g. ["equations","univariate","normalise"] for internal retrieval *)
12.150 + Celem.pblID; (*e.g. ["normalise","univariate","equations"] presented to student *)
12.151
12.152 (* apply a fun to a ptyps node *)
12.153 -fun app_ptyp x = app_py (get_ptyps ()) x;
12.154 +fun app_ptyp x = Celem.app_py (get_ptyps ()) x;
12.155
12.156 (* TODO: generalize search for subthy *)
12.157 -fun get_pbt (pblID: pblID) = get_py (get_ptyps ()) pblID (rev pblID)
12.158 +fun get_pbt (pblID: Celem.pblID) = Celem.get_py (get_ptyps ()) pblID (rev pblID)
12.159
12.160 (* TODO: throws exn 'get_pbt not found: ' ... confusing !! take 'ketype' as an argument *)
12.161 -fun get_met (metID : metID) = get_py (get_mets ()) metID metID;
12.162 -fun get_met' thy (metID : metID) = get_py (KEStore_Elems.get_mets thy) metID metID;
12.163 -fun get_the (theID : theID) = get_py (get_thes ()) theID theID;
12.164 +fun get_met metID = Celem.get_py (get_mets ()) metID metID;
12.165 +fun get_met' thy metID = Celem.get_py (KEStore_Elems.get_mets thy) metID metID;
12.166 +fun get_the theID = Celem.get_py (get_thes ()) theID theID;
12.167
12.168 (* lookup a guh in hierarchy of problems / methods depending on fst 4 chars in guh *)
12.169 -fun guh2kestoreID (guh: guh) =
12.170 +fun guh2kestoreID guh =
12.171 case (implode o (take_fromto 1 4) o Symbol.explode) guh of
12.172 "pbl_" =>
12.173 let
12.174 - fun node ids gu (Ptyp (id, [{guh, ...} : pbt], ns)) =
12.175 - if gu = guh then SOME ((ids @ [id]) : kestoreID) else nodes (ids @ [id]) gu ns
12.176 + fun node ids gu (Celem.Ptyp (id, [{guh, ...}], ns)) =
12.177 + if gu = guh then SOME (ids @ [id]) else nodes (ids @ [id]) gu ns
12.178 | node _ _ _ = error "guh2kestoreID node: uncovered fun def."
12.179 and nodes _ _ [] = NONE
12.180 | nodes ids gu (n :: ns) = case node ids gu n of
12.181 @@ -239,8 +242,8 @@
12.182 end
12.183 | "met_" =>
12.184 let
12.185 - fun node ids gu (Ptyp (id, [{guh, ...} : met], ns)) =
12.186 - if gu = guh then SOME ((ids @ [id]) : kestoreID) else nodes (ids @ [id]) gu ns
12.187 + fun node ids gu (Celem.Ptyp (id, [{guh, ...}], ns)) =
12.188 + if gu = guh then SOME (ids @ [id]) else nodes (ids @ [id]) gu ns
12.189 | node _ _ _ = error "guh2kestoreID node: uncovered fun def."
12.190 and nodes _ _ [] = NONE
12.191 | nodes ids gu (n :: ns) = case node ids gu n of
12.192 @@ -254,8 +257,7 @@
12.193
12.194 (* prepare problem-types before storing in pbltypes;
12.195 dont forget to "check_guh_unique" before ins *)
12.196 -fun prep_pbt thy guh maa init
12.197 - (pblID, dsc_dats: (string * (string list)) list, ev: rls, ca: string option, metIDs: metID list) =
12.198 +fun prep_pbt thy guh maa init (pblID, dsc_dats, ev, ca, metIDs) =
12.199 let
12.200 fun eq f (f', _) = f = f';
12.201 val gi = filter (eq "#Given") dsc_dats;
12.202 @@ -293,12 +295,12 @@
12.203 cas= case ca of
12.204 NONE => NONE
12.205 | SOME s => SOME ((Thm.term_of o the o (TermC.parse thy)) s),
12.206 - prls = ev, where_ = wh, ppc = gi @ fi @ re, met = metIDs}, pblID): pbt * pblID
12.207 + prls = ev, where_ = wh, ppc = gi @ fi @ re, met = metIDs}, pblID)
12.208 end;
12.209
12.210 (* prepare met for storage analogous to pbt *)
12.211 fun prep_met thy guh maa init
12.212 - (metID, ppc: (string * string list) list,
12.213 + (metID, ppc,
12.214 {rew_ord' = ro, rls' = rls, srls = srls, prls = prls, calc = _(*scr_isa_fns*), crls = cr,
12.215 errpats = ep, nrls = nr}, scr) =
12.216 let
12.217 @@ -336,9 +338,9 @@
12.218 val sc = ((TermC.inst_abs o Thm.term_of o the o (TermC.parse thy)) scr)
12.219 val calc = if scr = "empty_script" then [] else LTool.get_calcs thy sc
12.220 in
12.221 - ({guh = guh, mathauthors = maa, init = init, ppc = gi @ fi @ re, pre = wh, rew_ord' = ro,
12.222 + ({guh = guh, mathauthors = maa, init = init, ppc = gi @ fi @ re, pre = wh, rew_ord' = ro,
12.223 erls = rls, srls = srls, prls = prls, calc = calc,
12.224 - crls = cr, errpats = ep, nrls = nr, scr = Prog sc}: met, metID: metID)
12.225 + crls = cr, errpats = ep, nrls = nr, scr = Celem.Prog sc}, metID)
12.226 end;
12.227
12.228
12.229 @@ -348,10 +350,10 @@
12.230 fun format_pblIDl strll = enclose "[\n" "\n]\n" (space_implode ",\n" (map format_pblID strll));
12.231
12.232 fun scan _ [] = [] (* no base case, for empty doms only *)
12.233 - | scan id ((Ptyp ((i, _, []))) :: []) = [id @ [i]]
12.234 - | scan id ((Ptyp ((i, _, pl))) :: []) = scan (id @ [i]) pl
12.235 - | scan id ((Ptyp ((i, _, []))) :: ps) = [id @ [i]] @ (scan id ps)
12.236 - | scan id ((Ptyp ((i, _, pl))) :: ps) = (scan (id @ [i]) pl) @ (scan id ps);
12.237 + | scan id ((Celem.Ptyp ((i, _, []))) :: []) = [id @ [i]]
12.238 + | scan id ((Celem.Ptyp ((i, _, pl))) :: []) = scan (id @ [i]) pl
12.239 + | scan id ((Celem.Ptyp ((i, _, []))) :: ps) = [id @ [i]] @ (scan id ps)
12.240 + | scan id ((Celem.Ptyp ((i, _, pl))) :: ps) = (scan (id @ [i]) pl) @ (scan id ps);
12.241
12.242 fun show_ptyps () = (writeln o format_pblIDl o (scan [])) (get_ptyps ()); (* for tests *)
12.243 fun show_mets () = (writeln o format_pblIDl o (scan [])) (get_mets ()); (* for tests *)
12.244 @@ -511,7 +513,7 @@
12.245 | NoMatch' of Model.item Model.ppc;
12.246
12.247 (* match a formalization with a problem type, for tests *)
12.248 -fun match_pbl fmz ({thy = thy, where_ = pre, ppc, prls = er, ...}: pbt) =
12.249 +fun match_pbl fmz {thy = thy, where_ = pre, ppc, prls = er, ...} =
12.250 let
12.251 val oris = prep_ori fmz thy ppc |> #1;
12.252 val (bool, (itms, pre')) = match_oris' thy oris (ppc, pre, er);
12.253 @@ -522,11 +524,11 @@
12.254 end;
12.255
12.256 (* refine a problem; construct pblRD while scanning *)
12.257 -fun refin (pblRD: pblRD) ori ((Ptyp (pI, [py], [])): pbt ptyp) =
12.258 +fun refin (pblRD: pblRD) ori (Celem.Ptyp (pI, [py], [])) =
12.259 if match_oris (#thy py) (#prls py) ori (#ppc py, #where_ py)
12.260 then SOME ((pblRD @ [pI]): pblRD)
12.261 else NONE
12.262 - | refin pblRD ori (Ptyp (pI, [py], pys)) =
12.263 + | refin pblRD ori (Celem.Ptyp (pI, [py], pys)) =
12.264 if match_oris (#thy py) (#prls py) ori (#ppc py, #where_ py)
12.265 then (case refins (pblRD @ [pI]) ori pys of
12.266 SOME pblRD' => SOME pblRD'
12.267 @@ -534,13 +536,13 @@
12.268 else NONE
12.269 | refin _ _ _ = error "refin: uncovered fun def."
12.270 and refins _ _ [] = NONE
12.271 - | refins pblRD ori ((p as Ptyp _) :: pts) =
12.272 + | refins pblRD ori ((p as Celem.Ptyp _) :: pts) =
12.273 (case refin pblRD ori p of
12.274 SOME pblRD' => SOME pblRD'
12.275 | NONE => refins pblRD ori pts);
12.276
12.277 (* refine a problem; version providing output for math-experts *)
12.278 -fun refin' (pblRD: pblRD) fmz pbls ((Ptyp (pI, [py], [])): pbt ptyp) =
12.279 +fun refin' (pblRD: pblRD) fmz pbls (Celem.Ptyp (pI, [py], [])) =
12.280 let
12.281 val _ = (tracing o ((curry op ^) "*** pass ") o strs2str) (pblRD @ [pI])
12.282 val {thy, ppc, where_, prls, ...} = py
12.283 @@ -552,7 +554,7 @@
12.284 then pbls @ [Stool.Matches (rev (pblRD @ [pI]), itms2itemppc thy itms pre')]
12.285 else pbls @ [Stool.NoMatch (rev (pblRD @ [pI]), itms2itemppc thy itms pre')]
12.286 end
12.287 - | refin' pblRD fmz pbls (Ptyp (pI, [py], pys)) =
12.288 + | refin' pblRD fmz pbls (Celem.Ptyp (pI, [py], pys)) =
12.289 let
12.290 val _ = (tracing o ((curry op ^)"*** pass ") o strs2str) (pblRD @ [pI])
12.291 val {thy, ppc, where_, prls, ...} = py
12.292 @@ -568,7 +570,7 @@
12.293 end
12.294 | refin' _ _ _ _ = error "refin': uncovered fun def."
12.295 and refins' _ _ pbls [] = pbls
12.296 - | refins' pblRD fmz pbls ((p as Ptyp _) :: pts) =
12.297 + | refins' pblRD fmz pbls ((p as Celem.Ptyp _) :: pts) =
12.298 let
12.299 val pbls' = refin' pblRD fmz pbls p
12.300 in
12.301 @@ -578,7 +580,7 @@
12.302 end;
12.303
12.304 (* refine a problem; version for tactic Refine_Problem *)
12.305 -fun refin'' _ (pblRD: pblRD) itms pbls ((Ptyp (pI, [py], [])): pbt ptyp) =
12.306 +fun refin'' _ (pblRD: pblRD) itms pbls (Celem.Ptyp (pI, [py], [])) =
12.307 let
12.308 val {thy, ppc, where_, prls, ...} = py
12.309 val (b, (itms', pre')) = match_itms thy itms (ppc, where_, prls);
12.310 @@ -587,7 +589,7 @@
12.311 then pbls @ [Stool.Match_ (rev (pblRD @ [pI]), (itms', pre'))]
12.312 else pbls @ [Stool.NoMatch_]
12.313 end
12.314 - | refin'' _ pblRD itms pbls (Ptyp (pI, [py], pys)) =
12.315 + | refin'' _ pblRD itms pbls (Celem.Ptyp (pI, [py], pys)) =
12.316 let
12.317 val {thy, ppc, where_, prls, ...} = py
12.318 val (b, (itms', pre')) = match_itms thy itms (ppc, where_, prls);
12.319 @@ -598,7 +600,7 @@
12.320 end
12.321 | refin'' _ _ _ _ _ = error "refin': uncovered fun def."
12.322 and refins'' _ _ _ pbls [] = pbls
12.323 - | refins'' thy pblRD itms pbls ((p as Ptyp _) :: pts) =
12.324 + | refins'' thy pblRD itms pbls ((p as Celem.Ptyp _) :: pts) =
12.325 let
12.326 val pbls' = refin'' thy pblRD itms pbls p
12.327 in case last_elem pbls' of
12.328 @@ -608,12 +610,12 @@
12.329
12.330 (* for tactic Refine_Tacitly
12.331 oris are already created wrt. some pbt; pbt contains thy for parsing *)
12.332 -fun refine_ori oris (pblID: pblID) =
12.333 +fun refine_ori oris pblID =
12.334 let
12.335 val opt = app_ptyp (refin ((rev o tl) pblID) oris) pblID (rev pblID);
12.336 in case opt of
12.337 SOME pblRD =>
12.338 - let val pblID': pblID = rev pblRD
12.339 + let val pblID': Celem.pblID = rev pblRD
12.340 in if pblID' = pblID then NONE else SOME pblID' end
12.341 | NONE => NONE
12.342 end;
12.343 @@ -621,7 +623,7 @@
12.344
12.345 (* for tactic Refine_Problem
12.346 10.03: returnvalue -> (pIrefined, itm list) would be sufficient *)
12.347 -fun refine_pbl thy (pblID: pblID) itms =
12.348 +fun refine_pbl thy pblID itms =
12.349 case Stool.refined_ (app_ptyp (refin'' thy ((rev o tl) pblID) itms []) pblID (rev pblID)) of
12.350 NONE => NONE
12.351 | SOME (Stool.Match_ (rfd as (pI', _))) => if pblID = pI' then NONE else SOME rfd
12.352 @@ -635,23 +637,23 @@
12.353
12.354 (* make a guh from a reference to an element in the kestore;
12.355 EXCEPT theory hierarchy ... compare 'fun keref2xml' *)
12.356 -fun pblID2guh (pblID:pblID) = (((#guh o get_pbt) pblID)
12.357 +fun pblID2guh pblID = (((#guh o get_pbt) pblID)
12.358 handle _ => error ("pblID2guh: not for \"" ^ strs2str' pblID ^ "\""));
12.359 -fun metID2guh (metID:metID) = (((#guh o get_met) metID)
12.360 +fun metID2guh metID = (((#guh o get_met) metID)
12.361 handle _ => error ("metID2guh: no 'Met_' for \"" ^ strs2str' metID ^ "\""));
12.362 -fun kestoreID2guh Pbl_ (kestoreID: kestoreID) = pblID2guh kestoreID
12.363 - | kestoreID2guh Met_ (kestoreID: kestoreID) = metID2guh kestoreID
12.364 +fun kestoreID2guh Pbl_ kestoreID = pblID2guh kestoreID
12.365 + | kestoreID2guh Met_ kestoreID = metID2guh kestoreID
12.366 | kestoreID2guh ketype kestoreID =
12.367 - error ("kestoreID2guh: \"" ^ ketype2str ketype ^ "\" not for \"" ^ strs2str' kestoreID ^ "\"");
12.368 + error ("kestoreID2guh: \"" ^ Celem.ketype2str ketype ^ "\" not for \"" ^ strs2str' kestoreID ^ "\"");
12.369
12.370 fun show_pblguhs () = (* for tests *)
12.371 - (tracing o strs2str o (map linefeed)) (coll_pblguhs (get_ptyps ()))
12.372 + (tracing o strs2str o (map Celem.linefeed)) (Celem.coll_pblguhs (get_ptyps ()))
12.373 fun sort_pblguhs () = (* for tests *)
12.374 - (tracing o strs2str o (map linefeed)) (((sort string_ord) o coll_pblguhs) (get_ptyps ()))
12.375 + (tracing o strs2str o (map Celem.linefeed)) (((sort string_ord) o Celem.coll_pblguhs) (get_ptyps ()))
12.376
12.377 fun show_metguhs () = (* for tests *)
12.378 - (tracing o strs2str o (map linefeed)) (coll_metguhs (get_mets ()))
12.379 + (tracing o strs2str o (map Celem.linefeed)) (Celem.coll_metguhs (get_mets ()))
12.380 fun sort_metguhs () = (* for tests *)
12.381 - (tracing o strs2str o (map linefeed)) (((sort string_ord) o coll_metguhs) (get_mets ()))
12.382 + (tracing o strs2str o (map Celem.linefeed)) (((sort string_ord) o Celem.coll_metguhs) (get_mets ()))
12.383
12.384 end
13.1 --- a/src/Tools/isac/Interpret/rewtools.sml Tue Mar 13 15:04:27 2018 +0100
13.2 +++ b/src/Tools/isac/Interpret/rewtools.sml Thu Mar 15 10:17:44 2018 +0100
13.3 @@ -6,42 +6,43 @@
13.4 signature REWRITE_TOOLS =
13.5 sig
13.6 type deriv
13.7 - val contains_rule : rule -> rls -> bool
13.8 - val atomic_appl_tacs : theory -> string -> rls -> term -> Tac.tac -> Tac.tac list
13.9 - val thy_containing_rls : theory' -> rls' -> string * theory'
13.10 - val thy_containing_cal : theory' -> prog_calcID -> string * string
13.11 + val contains_rule : Celem.rule -> Celem.rls -> bool
13.12 + val atomic_appl_tacs : theory -> string -> Celem.rls -> term -> Tac.tac -> Tac.tac list
13.13 + val thy_containing_rls : Celem.theory' -> Celem.rls' -> string * Celem.theory'
13.14 + val thy_containing_cal : Celem.theory' -> Celem.prog_calcID -> string * string
13.15 datatype contthy
13.16 - = ContNOrew of {applto: term, thm_rls: guh, thyID: thyID}
13.17 - | ContNOrewInst of {applto: term, bdvs: subst, thm_rls: guh, thminst: term, thyID: thyID}
13.18 - | ContRls of {applto: term, asms: term list, result: term, rls: guh, thyID: thyID}
13.19 - | ContRlsInst of {applto: term, asms: term list, bdvs: subst, result: term, rls: guh, thyID: thyID}
13.20 - | ContThm of {applat: term, applto: term, asmrls: rls', asms: (term * term) list,
13.21 - lhs: term * term, resasms: term list, result: term, reword: rew_ord', rhs: term * term,
13.22 - thm: guh, thyID: thyID}
13.23 - | ContThmInst of {applat: term, applto: term, asmrls: rls', asms: (term * term) list,
13.24 - bdvs: subst, lhs: term * term, resasms: term list, result: term, reword: rew_ord',
13.25 - rhs: term * term, thm: guh, thminst: term, thyID: thyID}
13.26 + = ContNOrew of {applto: term, thm_rls: Celem.guh, thyID: Celem.thyID}
13.27 + | ContNOrewInst of {applto: term, bdvs: Celem.subst, thm_rls: Celem.guh, thminst: term, thyID: Celem.thyID}
13.28 + | ContRls of {applto: term, asms: term list, result: term, rls: Celem.guh, thyID: Celem.thyID}
13.29 + | ContRlsInst of {applto: term, asms: term list, bdvs: Celem.subst, result: term, rls: Celem.guh, thyID: Celem.thyID}
13.30 + | ContThm of {applat: term, applto: term, asmrls: Celem.rls', asms: (term * term) list,
13.31 + lhs: term * term, resasms: term list, result: term, reword: Celem.rew_ord', rhs: term * term,
13.32 + thm: Celem.guh, thyID: Celem.thyID}
13.33 + | ContThmInst of {applat: term, applto: term, asmrls: Celem.rls', asms: (term * term) list,
13.34 + bdvs: Celem.subst, lhs: term * term, resasms: term list, result: term, reword: Celem.rew_ord',
13.35 + rhs: term * term, thm: Celem.guh, thminst: term, thyID: Celem.thyID}
13.36 | EContThy
13.37 - val guh2filename : guh -> filename
13.38 - val is_sym : thmID -> bool
13.39 - val sym_drop : thmID -> thmID val sym_rls : rls -> rls
13.40 - val sym_rule : rule -> rule
13.41 - val thms_of_rls : rls -> rule list
13.42 - val theID2filename : theID -> filename
13.43 - val no_thycontext : guh -> bool
13.44 - val subs_from : Selem.istate -> 'a -> guh -> Selem.subs
13.45 - val guh2rewtac : guh -> Selem.subs -> Tac.tac
13.46 + val guh2filename : Celem.guh -> Celem.filename
13.47 + val is_sym : Celem.thmID -> bool
13.48 + val sym_drop : Celem.thmID -> Celem.thmID
13.49 + val sym_rls : Celem.rls -> Celem.rls
13.50 + val sym_rule : Celem.rule -> Celem.rule
13.51 + val thms_of_rls : Celem.rls -> Celem.rule list
13.52 + val theID2filename : Celem.theID -> Celem.filename
13.53 + val no_thycontext : Celem.guh -> bool
13.54 + val subs_from : Selem.istate -> 'a -> Celem.guh -> Selem.subs
13.55 + val guh2rewtac : Celem.guh -> Selem.subs -> Tac.tac
13.56 val get_tac_checked : Ctree.ctree -> Ctree.pos' -> Tac.tac
13.57 val context_thy : Ctree.state -> Tac.tac -> contthy
13.58 - val distinct_Thm : rule list -> rule list
13.59 - val eq_Thms : string list -> rule -> bool
13.60 - val make_deriv : theory -> rls -> rule list -> ((term * term) list -> term * term -> bool) ->
13.61 + val distinct_Thm : Celem.rule list -> Celem.rule list
13.62 + val eq_Thms : string list -> Celem.rule -> bool
13.63 + val make_deriv : theory -> Celem.rls -> Celem.rule list -> ((term * term) list -> term * term -> bool) ->
13.64 term option -> term -> deriv
13.65 - val reverse_deriv : theory -> rls -> rule list -> ((term * term) list -> term * term -> bool) ->
13.66 - term option -> term -> (rule * (term * term list)) list
13.67 - val get_bdv_subst : term -> (term * term) list -> Selem.subs option * subst
13.68 + val reverse_deriv : theory -> Celem.rls -> Celem.rule list -> ((term * term) list -> term * term -> bool) ->
13.69 + term option -> term -> (Celem.rule * (term * term list)) list
13.70 + val get_bdv_subst : term -> (term * term) list -> Selem.subs option * Celem.subst
13.71 val thy_containing_thm : string -> string * string
13.72 - val guh2theID : guh -> theID
13.73 + val guh2theID : Celem.guh -> Celem.theID
13.74 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
13.75 (* NONE *)
13.76 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
13.77 @@ -51,7 +52,7 @@
13.78 ( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
13.79
13.80 (*----- unused code, kept as hints to design ideas ---------------------------------------------*)
13.81 - val deri2str : (rule * (term * term list)) list -> string
13.82 + val deri2str : (Celem.rule * (term * term list)) list -> string
13.83 val sym_trm : term -> term
13.84 end
13.85
13.86 @@ -79,17 +80,17 @@
13.87 .*)
13.88 type deriv = (* derivation for insertin one level of nodes into the calctree *)
13.89 ( term * (* where the rule is applied to *)
13.90 - rule * (* rule to be applied *)
13.91 + Celem.rule * (* rule to be applied *)
13.92 ( term * (* resulting from rule application *)
13.93 term list)) (* assumptions resulting from rule application *)
13.94 list (* *)
13.95
13.96 fun trta2str (t, r, (t', a)) =
13.97 - "\n(" ^ term2str t ^ ", " ^ rule2str' r ^ ", (" ^ term2str t' ^ ", " ^ terms2str a ^ "))"
13.98 + "\n(" ^ Celem.term2str t ^ ", " ^ Celem.rule2str' r ^ ", (" ^ Celem.term2str t' ^ ", " ^ Celem.terms2str a ^ "))"
13.99 fun trtas2str trtas = (strs2str o (map trta2str)) trtas
13.100 val deriv2str = trtas2str
13.101 fun rta2str (r, (t, a)) =
13.102 - "\n(" ^ rule2str' r ^ ", (" ^ term2str t ^ ", " ^ terms2str a ^ "))"
13.103 + "\n(" ^ Celem.rule2str' r ^ ", (" ^ Celem.term2str t ^ ", " ^ Celem.terms2str a ^ "))"
13.104 fun rtas2str rtas = (strs2str o (map rta2str)) rtas
13.105 val deri2str = rtas2str
13.106
13.107 @@ -140,11 +141,11 @@
13.108 WN060825 too complicated for the intended use by cancel_, common_nominator_
13.109 and unreflectedly adapted to extension of rules by Rls_: returns Rls_("sym_simpl..
13.110 -- replaced below *)
13.111 -fun make_deriv thy erls (rs:rule list) ro goal tt =
13.112 +fun make_deriv thy erls rs ro goal tt =
13.113 let
13.114 datatype switch = Appl | Noap (* unify with version in rewrite.sml *)
13.115 fun rew_once _ rts t Noap [] =
13.116 - (case goal of NONE => rts | SOME _ => error ("make_deriv: no derivation for " ^ term2str t))
13.117 + (case goal of NONE => rts | SOME _ => error ("make_deriv: no derivation for " ^ Celem.term2str t))
13.118 | rew_once lim rts t Appl [] = rew_once lim rts t Noap rs
13.119 (*| Seq _ => rts) FIXXXXXME 14.3.03*)
13.120 | rew_once lim rts t apno rs' =
13.121 @@ -153,20 +154,20 @@
13.122 | SOME g => if g = t then rts else rew_or_calc lim rts t apno rs')
13.123 and rew_or_calc lim rts t apno (rrs' as (r :: rs')) =
13.124 if lim < 0
13.125 - then (tracing ("make_deriv exceeds " ^ int2str (! lim_deriv) ^ "with deriv =\n");
13.126 + then (tracing ("make_deriv exceeds " ^ int2str (! Celem.lim_deriv) ^ "with deriv =\n");
13.127 tracing (deriv2str rts); rts)
13.128 else
13.129 (case r of
13.130 - Thm (thmid, tm) =>
13.131 - (if not (! trace_rewrite) then () else tracing ("### trying thm \"" ^ thmid ^ "\"");
13.132 + Celem.Thm (thmid, tm) =>
13.133 + (if not (! Celem.trace_rewrite) then () else tracing ("### trying thm \"" ^ thmid ^ "\"");
13.134 case Rewrite.rewrite_ thy ro erls true tm t of
13.135 NONE => rew_once lim rts t apno rs'
13.136 | SOME (t', a') =>
13.137 - (if ! trace_rewrite then tracing ("### rewrites to: " ^ term2str t') else ();
13.138 + (if ! Celem.trace_rewrite then tracing ("### rewrites to: " ^ Celem.term2str t') else ();
13.139 rew_once (lim - 1) (rts @ [(t, r, (t', a'))]) t' Appl rrs'))
13.140 - | Calc (c as (op_, _)) =>
13.141 + | Celem.Calc (c as (op_, _)) =>
13.142 let
13.143 - val _ = if not (! trace_rewrite) then () else tracing ("### trying calc. \"" ^ op_^"\"")
13.144 + val _ = if not (! Celem.trace_rewrite) then () else tracing ("### trying calc. \"" ^ op_^"\"")
13.145 val t = TermC.uminus_to_string t
13.146 in
13.147 case Calc.adhoc_thm thy c t of
13.148 @@ -176,92 +177,92 @@
13.149 val (t', a') = case Rewrite.rewrite_ thy ro erls true tm t of
13.150 SOME ta => ta
13.151 | NONE => error "adhoc_thm: NONE"
13.152 - val _ = if not (! trace_rewrite) then () else tracing("### calc. to: " ^term2str t')
13.153 - val r' = Thm (thmid, tm)
13.154 + val _ = if not (! Celem.trace_rewrite) then () else tracing("### calc. to: " ^ Celem.term2str t')
13.155 + val r' = Celem.Thm (thmid, tm)
13.156 in rew_once (lim - 1) (rts @ [(t, r', (t', a'))]) t' Appl rrs' end)
13.157 handle _ => error "derive_norm, Calc: no rewrite"
13.158 end
13.159 (*| Cal1 (cc as (op_,_)) => ... WN080222 see rewrite__set_: see 7df94616c1bd and earlier*)
13.160 - | Rls_ rls => (* WN060829: CREATES "sym_rlsID", see 7df94616c1bd and earlier*)
13.161 + | Celem.Rls_ rls => (* WN060829: CREATES "sym_rlsID", see 7df94616c1bd and earlier*)
13.162 (case Rewrite.rewrite_set_ thy true rls t of
13.163 NONE => rew_once lim rts t apno rs'
13.164 | SOME (t', a') => rew_once (lim - 1) (rts @ [(t, r, (t', a'))]) t' Appl rrs')
13.165 - | rule => error ("rew_once: uncovered case " ^ rule2str rule))
13.166 + | rule => error ("rew_once: uncovered case " ^ Celem.rule2str rule))
13.167 | rew_or_calc _ _ _ _ [] = error "rew_or_calc: called with []"
13.168 - in rew_once (! lim_deriv) [] tt Noap rs : deriv end
13.169 + in rew_once (! Celem.lim_deriv) [] tt Noap rs end
13.170
13.171 -fun sym_drop (thmID : thmID) =
13.172 +fun sym_drop thmID =
13.173 case Symbol.explode thmID of
13.174 - "s" :: "y" :: "m" :: "_" :: id => implode id : thmID
13.175 + "s" :: "y" :: "m" :: "_" :: id => implode id
13.176 | _ => thmID
13.177 -fun is_sym (thmID : thmID) =
13.178 +fun is_sym thmID =
13.179 case Symbol.explode thmID of
13.180 "s" :: "y" :: "m" :: "_" :: _ => true
13.181 | _ => false;
13.182
13.183 (*FIXXXXME.040219: detail has to handle Rls id="sym_..."
13.184 by applying make_deriv, rev_deriv'; see concat_deriv*)
13.185 -fun sym_rls Erls = Erls
13.186 - | sym_rls (Rls {id, scr, calc, errpatts, erls, srls, rules, rew_ord, preconds}) =
13.187 - Rls {id = "sym_" ^ id, scr = scr, calc = calc, errpatts = errpatts, erls = erls, srls = srls,
13.188 +fun sym_rls Celem.Erls = Celem.Erls
13.189 + | sym_rls (Celem.Rls {id, scr, calc, errpatts, erls, srls, rules, rew_ord, preconds}) =
13.190 + Celem.Rls {id = "sym_" ^ id, scr = scr, calc = calc, errpatts = errpatts, erls = erls, srls = srls,
13.191 rules = rules, rew_ord = rew_ord, preconds = preconds}
13.192 - | sym_rls (Seq {id, scr, calc, errpatts, erls, srls, rules, rew_ord, preconds}) =
13.193 - Seq {id = "sym_" ^ id, scr = scr, calc = calc, errpatts = errpatts, erls = erls, srls = srls,
13.194 + | sym_rls (Celem.Seq {id, scr, calc, errpatts, erls, srls, rules, rew_ord, preconds}) =
13.195 + Celem.Seq {id = "sym_" ^ id, scr = scr, calc = calc, errpatts = errpatts, erls = erls, srls = srls,
13.196 rules = rules, rew_ord = rew_ord, preconds = preconds}
13.197 - | sym_rls (Rrls {id, scr, calc, errpatts, erls, prepat, rew_ord}) =
13.198 - Rrls {id = "sym_" ^ id, scr = scr, calc = calc, errpatts = errpatts, erls = erls,
13.199 + | sym_rls (Celem.Rrls {id, scr, calc, errpatts, erls, prepat, rew_ord}) =
13.200 + Celem.Rrls {id = "sym_" ^ id, scr = scr, calc = calc, errpatts = errpatts, erls = erls,
13.201 prepat = prepat, rew_ord = rew_ord}
13.202
13.203 (* toggles sym_* and keeps "#:" for ad-hoc calculations *)
13.204 -fun sym_rule (Thm (thmID, thm)) =
13.205 +fun sym_rule (Celem.Thm (thmID, thm)) =
13.206 let
13.207 val thm' = sym_thm thm
13.208 val thmID' = case Symbol.explode thmID of
13.209 "s" :: "y" :: "m" :: "_" :: id => implode id
13.210 - | "#" :: ":" :: _ => "#: " ^ string_of_thmI thm'
13.211 + | "#" :: ":" :: _ => "#: " ^ Celem.string_of_thmI thm'
13.212 | _ => "sym_" ^ thmID
13.213 - in Thm (thmID', thm') end
13.214 -| sym_rule (Rls_ rls) = Rls_ (sym_rls rls) (* TODO? handle with interSteps ? *)
13.215 -| sym_rule r = error ("sym_rule: not for " ^ rule2str r)
13.216 + in Celem.Thm (thmID', thm') end
13.217 +| sym_rule (Celem.Rls_ rls) = Celem.Rls_ (sym_rls rls) (* TODO? handle with interSteps ? *)
13.218 +| sym_rule r = error ("sym_rule: not for " ^ Celem.rule2str r)
13.219
13.220 (*version for reverse rewrite used before 040214*)
13.221 fun rev_deriv (t, r, (_, a)) = (sym_rule r, (t, a));
13.222 -fun reverse_deriv thy erls (rs:rule list) ro goal t =
13.223 - (rev o (map rev_deriv)) (make_deriv thy erls (rs:rule list) ro goal t)
13.224 +fun reverse_deriv thy erls rs ro goal t =
13.225 + (rev o (map rev_deriv)) (make_deriv thy erls rs ro goal t)
13.226
13.227 -fun eq_Thm (Thm (id1, _), Thm (id2,_)) = id1 = id2
13.228 - | eq_Thm (Thm (_, _), _) = false
13.229 - | eq_Thm (Rls_ r1, Rls_ r2) = id_rls r1 = id_rls r2
13.230 - | eq_Thm (Rls_ _, _) = false
13.231 - | eq_Thm (r1, r2) = error ("eq_Thm: called with '" ^ rule2str r1 ^ "' '"^ rule2str r2 ^ "'")
13.232 +fun eq_Thm (Celem.Thm (id1, _), Celem.Thm (id2,_)) = id1 = id2
13.233 + | eq_Thm (Celem.Thm (_, _), _) = false
13.234 + | eq_Thm (Celem.Rls_ r1, Celem.Rls_ r2) = Celem.id_rls r1 = Celem.id_rls r2
13.235 + | eq_Thm (Celem.Rls_ _, _) = false
13.236 + | eq_Thm (r1, r2) = error ("eq_Thm: called with '" ^ Celem.rule2str r1 ^ "' '" ^ Celem.rule2str r2 ^ "'")
13.237 fun distinct_Thm r = gen_distinct eq_Thm r
13.238
13.239 -fun eq_Thms thmIDs thm = (member op = thmIDs (id_of_thm thm))
13.240 +fun eq_Thms thmIDs thm = (member op = thmIDs (Celem.id_of_thm thm))
13.241 handle ERROR _ => false
13.242
13.243 fun thy_containing_thm thmDeriv =
13.244 let
13.245 - val isabthys' = map Context.theory_name (isabthys ());
13.246 + val isabthys' = map Context.theory_name (Celem.isabthys ());
13.247 in
13.248 - if member op= isabthys' (thyID_of_derivation_name thmDeriv)
13.249 - then ("Isabelle", thyID_of_derivation_name thmDeriv)
13.250 - else ("IsacKnowledge", thyID_of_derivation_name thmDeriv)
13.251 + if member op= isabthys' (Celem.thyID_of_derivation_name thmDeriv)
13.252 + then ("Isabelle", Celem.thyID_of_derivation_name thmDeriv)
13.253 + else ("IsacKnowledge", Celem.thyID_of_derivation_name thmDeriv)
13.254 end
13.255
13.256 (* which theory in ancestors of thy' contains a ruleset *)
13.257 -fun thy_containing_rls (thy' : theory') (rls' : rls') =
13.258 +fun thy_containing_rls thy' rls' =
13.259 let
13.260 - val thy = Thy_Info_get_theory thy'
13.261 + val thy = Celem.Thy_Info_get_theory thy'
13.262 in
13.263 case AList.lookup op= (KEStore_Elems.get_rlss thy) rls' of
13.264 - SOME (thy'', _) => (partID' thy'', thy'')
13.265 + SOME (thy'', _) => (Celem.partID' thy'', thy'')
13.266 | _ => error ("thy_containing_rls : rls '" ^ rls' ^ "' not in ancestors of thy '" ^ thy' ^ "'")
13.267 end
13.268
13.269 (* this function cannot work as long as the datastructure does not contain thy' *)
13.270 -fun thy_containing_cal (thy' : theory') (sop : prog_calcID) =
13.271 +fun thy_containing_cal thy' sop =
13.272 let
13.273 - val thy = Thy_Info_get_theory thy'
13.274 + val thy = Celem.Thy_Info_get_theory thy'
13.275 in
13.276 case AList.lookup op= (KEStore_Elems.get_calcs thy) sop of
13.277 SOME (_(*"Groups.plus_class.plus"*), _) => ("IsacKnowledge", "Atools" (*FIXME*))
13.278 @@ -272,65 +273,65 @@
13.279 datatype contthy = (*also an item from KEStore on Browser .....#*)
13.280 EContThy (* not from KEStore ..............................*)
13.281 | ContThm of (* a theorem in contex ===========================*)
13.282 - {thyID : thyID, (* for *2guh in sub-elems here .*)
13.283 - thm : guh, (* theorem in the context .*)
13.284 - applto : term, (* applied to formula ... .*)
13.285 - applat : term, (* ... with lhs inserted .*)
13.286 - reword : rew_ord', (* order used for rewrite .*)
13.287 - asms : (term (* asumption instantiated .*)
13.288 - * term) list, (* asumption evaluated .*)
13.289 - lhs : term (* lhs of the theorem ... #*)
13.290 - * term, (* ... instantiated .*)
13.291 - rhs : term (* rhs of the theorem ... #*)
13.292 - * term, (* ... instantiated .*)
13.293 - result : term, (* resulting from the rewrite .*)
13.294 - resasms : term list, (* ... with asms stored .*)
13.295 - asmrls : rls' (* ruleset for evaluating asms .*)
13.296 + {thyID : Celem.thyID, (* for *2guh in sub-elems here .*)
13.297 + thm : Celem.guh, (* theorem in the context .*)
13.298 + applto : term, (* applied to formula ... .*)
13.299 + applat : term, (* ... with lhs inserted .*)
13.300 + reword : Celem.rew_ord', (* order used for rewrite .*)
13.301 + asms : (term (* asumption instantiated .*)
13.302 + * term) list, (* asumption evaluated .*)
13.303 + lhs : term (* lhs of the theorem ... #*)
13.304 + * term, (* ... instantiated .*)
13.305 + rhs : term (* rhs of the theorem ... #*)
13.306 + * term, (* ... instantiated .*)
13.307 + result : term, (* resulting from the rewrite .*)
13.308 + resasms : term list, (* ... with asms stored .*)
13.309 + asmrls : Celem.rls' (* ruleset for evaluating asms .*)
13.310 }
13.311 | ContThmInst of (* a theorem with bdvs in contex ============ *)
13.312 - {thyID : thyID, (*for *2guh in sub-elems here .*)
13.313 - thm : guh, (*theorem in the context .*)
13.314 - bdvs : subst, (*bound variables to modify... .*)
13.315 - thminst : term, (*... theorem instantiated .*)
13.316 - applto : term, (*applied to formula ... .*)
13.317 - applat : term, (*... with lhs inserted .*)
13.318 - reword : rew_ord', (*order used for rewrite .*)
13.319 - asms : (term (*asumption instantiated .*)
13.320 - * term) list, (*asumption evaluated .*)
13.321 - lhs : term (*lhs of the theorem ... #*)
13.322 - * term, (*... instantiated .*)
13.323 - rhs : term (*rhs of the theorem ... #*)
13.324 - * term, (*... instantiated .*)
13.325 - result : term, (*resulting from the rewrite .*)
13.326 - resasms : term list, (*... with asms stored .*)
13.327 - asmrls : rls' (*ruleset for evaluating asms .*)
13.328 + {thyID : Celem.thyID, (*for *2guh in sub-elems here .*)
13.329 + thm : Celem.guh, (*theorem in the context .*)
13.330 + bdvs : Celem.subst, (*bound variables to modify... .*)
13.331 + thminst : term, (*... theorem instantiated .*)
13.332 + applto : term, (*applied to formula ... .*)
13.333 + applat : term, (*... with lhs inserted .*)
13.334 + reword : Celem.rew_ord', (*order used for rewrite .*)
13.335 + asms : (term (*asumption instantiated .*)
13.336 + * term) list, (*asumption evaluated .*)
13.337 + lhs : term (*lhs of the theorem ... #*)
13.338 + * term, (*... instantiated .*)
13.339 + rhs : term (*rhs of the theorem ... #*)
13.340 + * term, (*... instantiated .*)
13.341 + result : term, (*resulting from the rewrite .*)
13.342 + resasms : term list, (*... with asms stored .*)
13.343 + asmrls : Celem.rls' (*ruleset for evaluating asms .*)
13.344 }
13.345 | ContRls of (* a rule set in contex ========================= *)
13.346 - {thyID : thyID, (*for *2guh in sub-elems here .*)
13.347 - rls : guh, (*rule set in the context .*)
13.348 - applto : term, (*rewrite this formula .*)
13.349 - result : term, (*resulting from the rewrite .*)
13.350 - asms : term list (*... with asms stored .*)
13.351 + {thyID : Celem.thyID, (*for *2guh in sub-elems here .*)
13.352 + rls : Celem.guh, (*rule set in the context .*)
13.353 + applto : term, (*rewrite this formula .*)
13.354 + result : term, (*resulting from the rewrite .*)
13.355 + asms : term list (*... with asms stored .*)
13.356 }
13.357 | ContRlsInst of (* a rule set with bdvs in contex =========== *)
13.358 - {thyID : thyID, (*for *2guh in sub-elems here .*)
13.359 - rls : guh, (*rule set in the context .*)
13.360 - bdvs : subst, (*for bound variables in thms .*)
13.361 - applto : term, (*rewrite this formula .*)
13.362 - result : term, (*resulting from the rewrite .*)
13.363 - asms : term list (*... with asms stored .*)
13.364 + {thyID : Celem.thyID, (*for *2guh in sub-elems here .*)
13.365 + rls : Celem.guh, (*rule set in the context .*)
13.366 + bdvs : Celem.subst, (*for bound variables in thms .*)
13.367 + applto : term, (*rewrite this formula .*)
13.368 + result : term, (*resulting from the rewrite .*)
13.369 + asms : term list (*... with asms stored .*)
13.370 }
13.371 | ContNOrew of (* no rewrite for thm or rls ================== *)
13.372 - {thyID : thyID, (*for *2guh in sub-elems here .*)
13.373 - thm_rls : guh, (*thm or rls in the context .*)
13.374 - applto : term (*rewrite this formula .*)
13.375 + {thyID : Celem.thyID, (*for *2guh in sub-elems here .*)
13.376 + thm_rls : Celem.guh, (*thm or rls in the context .*)
13.377 + applto : term (*rewrite this formula .*)
13.378 }
13.379 | ContNOrewInst of (* no rewrite for some instantiation ====== *)
13.380 - {thyID : thyID, (*for *2guh in sub-elems here .*)
13.381 - thm_rls : guh, (*thm or rls in the context .*)
13.382 - bdvs : subst, (*for bound variables in thms .*)
13.383 - thminst : term, (*... theorem instantiated .*)
13.384 - applto : term (*rewrite this formula .*)
13.385 + {thyID : Celem.thyID, (*for *2guh in sub-elems here .*)
13.386 + thm_rls : Celem.guh, (*thm or rls in the context .*)
13.387 + bdvs : Celem.subst, (*for bound variables in thms .*)
13.388 + thminst : term, (*... theorem instantiated .*)
13.389 + applto : term (*rewrite this formula .*)
13.390 }
13.391
13.392 (*.check a rewrite-tac for bdv (RL always used *_Inst !) TODO.WN060718
13.393 @@ -338,8 +339,8 @@
13.394 fun get_tac_checked pt ((p, _) : Ctree.pos') = Ctree.get_obj Ctree.g_tac pt p;
13.395
13.396 (* create a derivation-name, eg. ("refl", _) --> "HOL.refl"*)
13.397 -fun deriv_of_thm'' ((thmID, _) : thm'') =
13.398 - thmID |> Global_Theory.get_thm (Isac ()) |> Thm.get_name_hint
13.399 +fun deriv_of_thm'' (thmID, _) =
13.400 + thmID |> Global_Theory.get_thm (Celem.Isac ()) |> Thm.get_name_hint
13.401
13.402 (* get the formula f at ptp rewritten by the Rewrite_* already applied to f *)
13.403 fun context_thy (pt, pos as (p,p_)) (tac as Tac.Rewrite thm'') =
13.404 @@ -348,11 +349,11 @@
13.405 (case Applicable.applicable_in pos pt tac of
13.406 Chead.Appl (Tac.Rewrite' (thy', ord', erls, _, _, f, (res,asm))) =>
13.407 ContThm
13.408 - {thyID = theory'2thyID thy',
13.409 - thm = thm2guh (thy_containing_thm thm_deriv) (thmID_of_derivation_name thm_deriv),
13.410 - applto = f, applat = e_term, reword = ord',
13.411 - asms = [](*asms ~~ asms'*), lhs = (e_term, e_term)(*(lhs, lhs')*), rhs = (e_term, e_term)(*(rhs, rhs')*),
13.412 - result = res, resasms = asm, asmrls = id_rls erls}
13.413 + {thyID = Celem.theory'2thyID thy',
13.414 + thm = Celem.thm2guh (thy_containing_thm thm_deriv) (Celem.thmID_of_derivation_name thm_deriv),
13.415 + applto = f, applat = Celem.e_term, reword = ord',
13.416 + asms = [](*asms ~~ asms'*), lhs = (Celem.e_term, Celem.e_term)(*(lhs, lhs')*), rhs = (Celem.e_term, Celem.e_term)(*(rhs, rhs')*),
13.417 + result = res, resasms = asm, asmrls = Celem.id_rls erls}
13.418 | Chead.Notappl _ =>
13.419 let
13.420 val pp = Ctree.par_pblobj pt p
13.421 @@ -363,15 +364,15 @@
13.422 | _ => error "context_thy: uncovered position"
13.423 in
13.424 ContNOrew
13.425 - {thyID = theory'2thyID thy',
13.426 + {thyID = Celem.theory'2thyID thy',
13.427 thm_rls =
13.428 - thm2guh (thy_containing_thm thm_deriv) (thmID_of_derivation_name thm_deriv),
13.429 + Celem.thm2guh (thy_containing_thm thm_deriv) (Celem.thmID_of_derivation_name thm_deriv),
13.430 applto = f}
13.431 end
13.432 | _ => error "context_thy..Rewrite: uncovered case 2")
13.433 end
13.434 | context_thy (pt, pos as (p, p_)) (tac as Tac.Rewrite_Inst (subs, (thmID, _))) =
13.435 - let val thm = Global_Theory.get_thm (Isac ()) thmID
13.436 + let val thm = Global_Theory.get_thm (Celem.Isac ()) thmID
13.437 in
13.438 (case Applicable.applicable_in pos pt tac of
13.439 Chead.Appl (Tac.Rewrite_Inst' (thy', ord', erls, _, subst, _, f, (res, asm))) =>
13.440 @@ -380,20 +381,20 @@
13.441 val thminst = TermC.inst_bdv subst ((Calc.norm o #prop o Thm.rep_thm) thm)
13.442 in
13.443 ContThmInst
13.444 - {thyID = theory'2thyID thy',
13.445 + {thyID = Celem.theory'2thyID thy',
13.446 thm =
13.447 - thm2guh (thy_containing_thm thm_deriv) (thmID_of_derivation_name thm_deriv),
13.448 - bdvs = subst, thminst = thminst, applto = f, applat = e_term, reword = ord',
13.449 - asms = [](*asms ~~ asms'*), lhs = (e_term, e_term)(*(lhs, lhs')*), rhs = (e_term, e_term)(*(rhs, rhs')*),
13.450 - result = res, resasms = asm, asmrls = id_rls erls}
13.451 + Celem.thm2guh (thy_containing_thm thm_deriv) (Celem.thmID_of_derivation_name thm_deriv),
13.452 + bdvs = subst, thminst = thminst, applto = f, applat = Celem.e_term, reword = ord',
13.453 + asms = [](*asms ~~ asms'*), lhs = (Celem.e_term, Celem.e_term)(*(lhs, lhs')*), rhs = (Celem.e_term, Celem.e_term)(*(rhs, rhs')*),
13.454 + result = res, resasms = asm, asmrls = Celem.id_rls erls}
13.455 end
13.456 | Chead.Notappl _ =>
13.457 let
13.458 - val thm = Global_Theory.get_thm (Isac ()(*WN141021 assoc_thy thy' ERROR*)) thmID
13.459 + val thm = Global_Theory.get_thm (Celem.Isac ()(*WN141021 assoc_thy thy' ERROR*)) thmID
13.460 val thm_deriv = Thm.get_name_hint thm
13.461 val pp = Ctree.par_pblobj pt p
13.462 val thy' = Ctree.get_obj Ctree.g_domID pt pp
13.463 - val subst = Selem.subs2subst (assoc_thy thy') subs
13.464 + val subst = Selem.subs2subst (Celem.assoc_thy thy') subs
13.465 val thminst = TermC.inst_bdv subst ((Calc.norm o #prop o Thm.rep_thm) thm)
13.466 val f = case p_ of
13.467 Ctree.Frm => Ctree.get_obj Ctree.g_form pt p
13.468 @@ -401,8 +402,8 @@
13.469 | _ => error "context_thy: uncovered case 3"
13.470 in
13.471 ContNOrewInst
13.472 - {thyID = theory'2thyID thy',
13.473 - thm_rls = thm2guh (thy_containing_thm thm_deriv) (thmID_of_derivation_name thm_deriv),
13.474 + {thyID = Celem.theory'2thyID thy',
13.475 + thm_rls = Celem.thm2guh (thy_containing_thm thm_deriv) (Celem.thmID_of_derivation_name thm_deriv),
13.476 bdvs = subst, thminst = thminst, applto = f}
13.477 end
13.478 | _ => error "context_thy..Rewrite_Inst: uncovered case 4")
13.479 @@ -411,16 +412,16 @@
13.480 (case Applicable.applicable_in p pt tac of
13.481 Chead.Appl (Tac.Rewrite_Set' (thy', _, _(*rls*), f, (res,asm))) =>
13.482 ContRls
13.483 - {thyID = theory'2thyID thy',
13.484 - rls = rls2guh (thy_containing_rls thy' rls') rls',
13.485 + {thyID = Celem.theory'2thyID thy',
13.486 + rls = Celem.rls2guh (thy_containing_rls thy' rls') rls',
13.487 applto = f, result = res, asms = asm}
13.488 | _ => error ("context_thy Rewrite_Set: not for Chead.Notappl"))
13.489 | context_thy (pt,p) (tac as Tac.Rewrite_Set_Inst (_(*subs*), rls')) =
13.490 (case Applicable.applicable_in p pt tac of
13.491 Chead.Appl (Tac.Rewrite_Set_Inst' (thy', _, subst, _, f, (res,asm))) =>
13.492 ContRlsInst
13.493 - {thyID = theory'2thyID thy',
13.494 - rls = rls2guh (thy_containing_rls thy' rls') rls',
13.495 + {thyID = Celem.theory'2thyID thy',
13.496 + rls = Celem.rls2guh (thy_containing_rls thy' rls') rls',
13.497 bdvs = subst, applto = f, result = res, asms = asm}
13.498 | _ => error ("context_thy Rewrite_Set_Inst: not for Chead.Notappl"))
13.499 | context_thy (_, p) tac =
13.500 @@ -428,14 +429,14 @@
13.501
13.502 (* get all theorems in a rule set (recursivley containing rule sets) *)
13.503 fun thm_of_rule Erule = []
13.504 - | thm_of_rule (thm as Thm _) = [thm]
13.505 - | thm_of_rule (Calc _) = []
13.506 - | thm_of_rule (Cal1 _) = []
13.507 - | thm_of_rule (Rls_ rls) = thms_of_rls rls
13.508 -and thms_of_rls Erls = []
13.509 - | thms_of_rls (Rls {rules,...}) = (flat o (map thm_of_rule)) rules
13.510 - | thms_of_rls (Seq {rules,...}) = (flat o (map thm_of_rule)) rules
13.511 - | thms_of_rls (Rrls _) = []
13.512 + | thm_of_rule (thm as Celem.Thm _) = [thm]
13.513 + | thm_of_rule (Celem.Calc _) = []
13.514 + | thm_of_rule (Celem.Cal1 _) = []
13.515 + | thm_of_rule (Celem.Rls_ rls) = thms_of_rls rls
13.516 +and thms_of_rls Celem.Erls = []
13.517 + | thms_of_rls (Celem.Rls {rules,...}) = (flat o (map thm_of_rule)) rules
13.518 + | thms_of_rls (Celem.Seq {rules,...}) = (flat o (map thm_of_rule)) rules
13.519 + | thms_of_rls (Celem.Rrls _) = []
13.520
13.521 (* check if a rule is contained in a rule-set (recursivley down in Rls_);
13.522 this rule can even be a rule-set itself *)
13.523 @@ -444,14 +445,14 @@
13.524 fun (*find (_, Rls_ rls) = finds (get_rules rls)
13.525 | find r12 = eq_rule r12
13.526 and*) finds [] = false
13.527 - | finds (r1 :: rs) = if eq_rule (r, r1) then true else finds rs
13.528 + | finds (r1 :: rs) = if Celem.eq_rule (r, r1) then true else finds rs
13.529 in
13.530 - finds (get_rules rls)
13.531 + finds (Celem.get_rules rls)
13.532 end
13.533
13.534 (* try if a rewrite-rule is applicable to a given formula;
13.535 in case of rule-sets (recursivley) collect all _atomic_ rewrites *)
13.536 -fun try_rew thy ((_, ro) : rew_ord) erls (subst : subst) f (thm' as Thm (_, thm)) =
13.537 +fun try_rew thy ((_, ro) : Celem.rew_ord) erls (subst : Celem.subst) f (thm' as Celem.Thm (_, thm)) =
13.538 if LTool.contains_bdv thm
13.539 then case Rewrite.rewrite_inst_ thy ro erls false subst thm f of
13.540 SOME _ => [Tac.rule2tac thy subst thm']
13.541 @@ -459,31 +460,31 @@
13.542 else (case Rewrite.rewrite_ thy ro erls false thm f of
13.543 SOME _ => [Tac.rule2tac thy [] thm']
13.544 | NONE => [])
13.545 - | try_rew thy _ _ _ f (cal as Calc c) =
13.546 + | try_rew thy _ _ _ f (cal as Celem.Calc c) =
13.547 (case Calc.adhoc_thm thy c f of
13.548 SOME _ => [Tac.rule2tac thy [] cal]
13.549 | NONE => [])
13.550 - | try_rew thy _ _ _ f (cal as Cal1 c) =
13.551 + | try_rew thy _ _ _ f (cal as Celem.Cal1 c) =
13.552 (case Calc.adhoc_thm thy c f of
13.553 SOME _ => [Tac.rule2tac thy [] cal]
13.554 | NONE => [])
13.555 - | try_rew thy _ _ subst f (Rls_ rls) = filter_appl_rews thy subst f rls
13.556 + | try_rew thy _ _ subst f (Celem.Rls_ rls) = filter_appl_rews thy subst f rls
13.557 | try_rew _ _ _ _ _ _ = error "try_rew: uncovered case"
13.558 -and filter_appl_rews thy subst f (Rls {rew_ord = ro, erls, rules, ...}) =
13.559 +and filter_appl_rews thy subst f (Celem.Rls {rew_ord = ro, erls, rules, ...}) =
13.560 gen_distinct Tac.eq_tac (flat (map (try_rew thy ro erls subst f) rules))
13.561 - | filter_appl_rews thy subst f (Seq {rew_ord = ro, erls, rules,...}) =
13.562 + | filter_appl_rews thy subst f (Celem.Seq {rew_ord = ro, erls, rules,...}) =
13.563 gen_distinct Tac.eq_tac (flat (map (try_rew thy ro erls subst f) rules))
13.564 - | filter_appl_rews _ _ _ (Rrls _) = []
13.565 + | filter_appl_rews _ _ _ (Celem.Rrls _) = []
13.566 | filter_appl_rews _ _ _ _ = error "filter_appl_rews: uncovered case"
13.567
13.568 (* decide if a tactic is applicable to a given formula;
13.569 in case of Rewrite_Set* go down to _atomic_ rewrite-tactics *)
13.570 fun atomic_appl_tacs thy _ _ f (Tac.Calculate scrID) =
13.571 - try_rew thy e_rew_ordX e_rls [] f (Calc (assoc_calc' thy scrID |> snd))
13.572 + try_rew thy Celem.e_rew_ordX Celem.e_rls [] f (Celem.Calc (assoc_calc' thy scrID |> snd))
13.573 | atomic_appl_tacs thy ro erls f (Tac.Rewrite thm'') =
13.574 - try_rew thy (ro, assoc_rew_ord ro) erls [] f (Thm thm'')
13.575 + try_rew thy (ro, Celem.assoc_rew_ord ro) erls [] f (Celem.Thm thm'')
13.576 | atomic_appl_tacs thy ro erls f (Tac.Rewrite_Inst (subs, thm'')) =
13.577 - try_rew thy (ro, assoc_rew_ord ro) erls (Selem.subs2subst thy subs) f (Thm thm'')
13.578 + try_rew thy (ro, Celem.assoc_rew_ord ro) erls (Selem.subs2subst thy subs) f (Celem.Thm thm'')
13.579
13.580 | atomic_appl_tacs thy _ _ f (Tac.Rewrite_Set rls') =
13.581 filter_appl_rews thy [] f (assoc_rls rls')
13.582 @@ -493,9 +494,9 @@
13.583 (tracing ("### atomic_appl_tacs: not impl. for tac = '" ^ Tac.tac2str tac ^ "'"); []);
13.584
13.585 (* filenames not only for thydata, but also for thy's etc *)
13.586 -fun theID2filename (theID : theID) = theID2guh theID ^ ".xml" : filename
13.587 +fun theID2filename theID = Celem.theID2guh theID ^ ".xml"
13.588
13.589 -fun guh2theID (guh : guh) =
13.590 +fun guh2theID guh =
13.591 let
13.592 val guh' = Symbol.explode guh
13.593 val part = implode (take_fromto 1 4 guh')
13.594 @@ -515,7 +516,7 @@
13.595 val thyID = takewhile [] (not o (curry op= "-")) rest
13.596 val rest' = dropuntil (curry op = "-") rest
13.597 in case implode rest' of
13.598 - "-part" => [chap] : theID
13.599 + "-part" => [chap] : Celem.theID
13.600 | "" => [chap, implode thyID]
13.601 | "-Theorems" => [chap, implode thyID, "Theorems"]
13.602 | "-Rulesets" => [chap, implode thyID, "Rulesets"]
13.603 @@ -536,7 +537,7 @@
13.604 end
13.605 end
13.606
13.607 -fun guh2filename (guh : guh) = guh ^ ".xml" : filename;
13.608 +fun guh2filename guh = guh ^ ".xml";
13.609
13.610 fun guh2rewtac guh [] =
13.611 let
13.612 @@ -544,7 +545,7 @@
13.613 [isa, thy, sect, xstr] => (isa, thy, sect, xstr)
13.614 | _ => error "guh2rewtac: uncovered case"
13.615 in case sect of
13.616 - "Theorems" => Tac.Rewrite (xstr, Rewrite.assoc_thm'' (assoc_thy thy) xstr)
13.617 + "Theorems" => Tac.Rewrite (xstr, Rewrite.assoc_thm'' (Celem.assoc_thy thy) xstr)
13.618 | "Rulesets" => Tac.Rewrite_Set xstr
13.619 | _ => error ("guh2rewtac: not impl. for '"^xstr^"'")
13.620 end
13.621 @@ -555,13 +556,13 @@
13.622 | _ => error "guh2rewtac: uncovered case"
13.623 in case sect of
13.624 "Theorems" =>
13.625 - Tac.Rewrite_Inst (subs, (xstr, Rewrite.assoc_thm'' (assoc_thy thy) xstr))
13.626 + Tac.Rewrite_Inst (subs, (xstr, Rewrite.assoc_thm'' (Celem.assoc_thy thy) xstr))
13.627 | "Rulesets" => Tac.Rewrite_Set_Inst (subs, xstr)
13.628 | str => error ("guh2rewtac: not impl. for '" ^ str ^ "'")
13.629 end
13.630
13.631 (* the front-end may request a context for any element of the hierarchy *)
13.632 -fun no_thycontext (guh : guh) = (guh2theID guh; false)
13.633 +fun no_thycontext guh = (guh2theID guh; false)
13.634 handle ERROR _ => true;
13.635
13.636 (* get the substitution of bound variables for matchTheory:
13.637 @@ -571,7 +572,7 @@
13.638 # otherwise []
13.639 WN060617 hack assuming that all scripts use only one bound variable
13.640 and use 'v_' as the formal argument for this bound variable*)
13.641 -fun subs_from (Selem.ScrState (env, _, _, _, _, _)) _ (guh : guh) =
13.642 +fun subs_from (Selem.ScrState (env, _, _, _, _, _)) _ guh =
13.643 let
13.644 val (_, _, thyID, sect, xstr) = case guh2theID guh of
13.645 theID as [isa, thyID, sect, xstr] => (theID, isa, thyID, sect, xstr)
13.646 @@ -579,31 +580,31 @@
13.647 in
13.648 case sect of
13.649 "Theorems" =>
13.650 - let val thm = Global_Theory.get_thm (assoc_thy (thyID2theory' thyID)) xstr
13.651 + let val thm = Global_Theory.get_thm (Celem.assoc_thy (Celem.thyID2theory' thyID)) xstr
13.652 in
13.653 if LTool.contains_bdv thm
13.654 then
13.655 let
13.656 val formal_arg = TermC.str2term "v_"
13.657 val value = subst_atomic env formal_arg
13.658 - in ["(bdv," ^ term2str value ^ ")"] : Selem.subs end
13.659 + in ["(bdv," ^ Celem.term2str value ^ ")"] : Selem.subs end
13.660 else []
13.661 end
13.662 | "Rulesets" =>
13.663 let
13.664 - val rules = (get_rules o assoc_rls) xstr
13.665 + val rules = (Celem.get_rules o assoc_rls) xstr
13.666 in
13.667 if LTool.contain_bdv rules
13.668 then
13.669 let
13.670 val formal_arg = TermC.str2term "v_"
13.671 val value = subst_atomic env formal_arg
13.672 - in ["(bdv," ^ term2str value ^ ")"] : Selem.subs end
13.673 + in ["(bdv," ^ Celem.term2str value ^ ")"] : Selem.subs end
13.674 else []
13.675 end
13.676 | str => error ("subs_from: uncovered case with " ^ str)
13.677 end
13.678 - | subs_from _ _ (guh : guh) = error ("subs_from: uncovered case with " ^ guh)
13.679 + | subs_from _ _ guh = error ("subs_from: uncovered case with " ^ guh)
13.680
13.681 (* get a substitution for "bdv*" from the current program and environment.
13.682 returns a substitution: subst for rewriting and another: sube for Rewrite: *)
13.683 @@ -619,7 +620,7 @@
13.684 | scan (t1 $ t2) = case scan t1 of NONE => scan t2 | SOME subst => SOME subst
13.685 in
13.686 case scan prog of
13.687 - NONE => (NONE: Selem.subs option, []: subst)
13.688 + NONE => (NONE: Selem.subs option, []: Celem.subst)
13.689 | SOME tm =>
13.690 let val subst = tm |> subst_atomic env |> TermC.isalist2list |> map TermC.isapair2pair
13.691 (* "[(bdv,v_v)]": term
14.1 --- a/src/Tools/isac/Interpret/script.sml Tue Mar 13 15:04:27 2018 +0100
14.2 +++ b/src/Tools/isac/Interpret/script.sml Thu Mar 15 10:17:44 2018 +0100
14.3 @@ -10,20 +10,20 @@
14.4 datatype locate = NotLocatable | Steps of Selem.istate * step list
14.5
14.6 val next_tac : (*diss: next-tactic-function*)
14.7 - theory' * rls -> Ctree.state -> scr -> Selem.istate * 'a -> Tac.tac_ * (Selem.istate * 'a) * (term * Selem.safe)
14.8 + Celem.theory' * Celem.rls -> Ctree.state -> Celem.scr -> Selem.istate * 'a -> Tac.tac_ * (Selem.istate * 'a) * (term * Selem.safe)
14.9 val locate_gen : (*diss: locate-function*)
14.10 - theory' * rls -> Tac.tac_ -> Ctree.state -> scr * 'a -> Selem.istate * Proof.context -> locate
14.11 + Celem.theory' * Celem.rls -> Tac.tac_ -> Ctree.state -> Celem.scr * 'a -> Selem.istate * Proof.context -> locate
14.12
14.13 (* can these functions be local to Lucin or part of LItools ? *)
14.14 val sel_rules : Ctree.ctree -> Ctree.pos' -> Tac.tac list
14.15 - val init_form : 'a -> scr -> (term * term) list -> term option
14.16 + val init_form : 'a -> Celem.scr -> (term * term) list -> term option
14.17 val tac_2tac : Tac.tac_ -> Tac.tac
14.18 - val init_scrstate : theory -> Model.itm list -> metID -> Selem.istate * Proof.context * scr
14.19 - val from_pblobj' : theory' -> Ctree.pos' -> Ctree.ctree -> rls * (Selem.istate * Proof.context) * scr
14.20 - val from_pblobj_or_detail' : theory' -> Ctree.pos' -> Ctree.ctree ->
14.21 - rls * (Selem.istate * Proof.context) * scr
14.22 - val rule2thm'' : rule -> thm''
14.23 - val rule2rls' : rule -> string
14.24 + val init_scrstate : theory -> Model.itm list -> Celem.metID -> Selem.istate * Proof.context * Celem.scr
14.25 + val from_pblobj' : Celem.theory' -> Ctree.pos' -> Ctree.ctree -> Celem.rls * (Selem.istate * Proof.context) * Celem.scr
14.26 + val from_pblobj_or_detail' : Celem.theory' -> Ctree.pos' -> Ctree.ctree ->
14.27 + Celem.rls * (Selem.istate * Proof.context) * Celem.scr
14.28 + val rule2thm'' : Celem.rule -> Celem.thm''
14.29 + val rule2rls' : Celem.rule -> string
14.30 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
14.31 val sel_appl_atomic_tacs : Ctree.ctree -> Ctree.pos' -> Tac.tac list
14.32 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
14.33 @@ -69,16 +69,16 @@
14.34 * pos' (*position in ctree; ctree * pos' is the proofstate *)
14.35 * pos' list; (*of ctree-nodes probably cut (by fst tac_) *)
14.36
14.37 -fun rule2thm'' (Thm (id, thm)) = (id, thm) : thm''
14.38 - | rule2thm'' r = error ("rule2thm': not defined for " ^ rule2str r);
14.39 -fun rule2rls' (Rls_ rls) = id_rls rls
14.40 - | rule2rls' r = error ("rule2rls': not defined for " ^ rule2str r);
14.41 +fun rule2thm'' (Celem.Thm (id, thm)) = (id, thm)
14.42 + | rule2thm'' r = error ("rule2thm': not defined for " ^ Celem.rule2str r);
14.43 +fun rule2rls' (Celem.Rls_ rls) = Celem.id_rls rls
14.44 + | rule2rls' r = error ("rule2rls': not defined for " ^ Celem.rule2str r);
14.45
14.46 (*.makes a (rule,term) list to a Step (m, mout, pt', p', cid) for solve;
14.47 complicated with current t in rrlsstate.*)
14.48 fun rts2steps steps ((pt, p), (f, f'', rss, rts), (thy', ro, er, pa)) [(r, (f', am))] =
14.49 let
14.50 - val thy = assoc_thy thy'
14.51 + val thy = Celem.assoc_thy thy'
14.52 val ctxt = get_ctxt pt p |> Stool.insert_assumptions am
14.53 val m = Tac.Rewrite' (thy', ro, er, pa, rule2thm'' r, f, (f', am))
14.54 val is = Selem.RrlsState (f', f'', rss, rts)
14.55 @@ -87,7 +87,7 @@
14.56 in (is, (m, mout, pt', p', cid) :: steps) end
14.57 | rts2steps steps ((pt, p) ,(f, f'', rss, rts), (thy', ro, er, pa)) ((r, (f', am)) :: rts') =
14.58 let
14.59 - val thy = assoc_thy thy'
14.60 + val thy = Celem.assoc_thy thy'
14.61 val ctxt = get_ctxt pt p |> Stool.insert_assumptions am
14.62 val m = Tac.Rewrite' (thy', ro, er, pa, rule2thm'' r, f, (f', am))
14.63 val is = Selem.RrlsState (f', f'', rss, rts)
14.64 @@ -116,10 +116,10 @@
14.65
14.66 (*go at a location in a script and fetch the contents*)
14.67 fun go [] t = t
14.68 - | go (D::p) (Abs(_, _, t0)) = go (p : loc_) t0
14.69 + | go (D::p) (Abs(_, _, t0)) = go (p : Celem.loc_) t0
14.70 | go (L::p) (t1 $ _) = go p t1
14.71 | go (R::p) (_ $ t2) = go p t2
14.72 - | go l _ = error ("go: no " ^ loc_2str l);
14.73 + | go l _ = error ("go: no " ^ Celem.loc_2str l);
14.74
14.75 (*.get argument of first stactic in a script for init_form.*)
14.76 fun get_stac thy (_ $ body) =
14.77 @@ -165,10 +165,10 @@
14.78 | get_t _ (Const ("Script.SubProblem",_) $ _ $ _) _ = NONE
14.79
14.80 | get_t _ _ _ = ((*tracing ("### get_t yac: list-expr "^(term2str x));*) NONE)
14.81 - in get_t thy body e_term end
14.82 - | get_stac _ t = error ("get_stac: no fun-def. for " ^ term2str t);
14.83 + in get_t thy body Celem.e_term end
14.84 + | get_stac _ t = error ("get_stac: no fun-def. for " ^ Celem.term2str t);
14.85
14.86 -fun init_form thy (Prog sc) env =
14.87 +fun init_form thy (Celem.Prog sc) env =
14.88 (case get_stac thy sc of NONE => NONE | SOME stac => SOME (subst_atomic env stac))
14.89 | init_form _ _ _ = error "init_form: no match";
14.90
14.91 @@ -204,7 +204,7 @@
14.92 fun test_dsc d (_, _, _, _, itm_) = (d = Model.d_in itm_)
14.93 fun itm2arg itms (_,(d,_)) =
14.94 case find_first (test_dsc d) itms of
14.95 - NONE => error ("itms2args: '" ^ term2str d ^ "' not in itms")
14.96 + NONE => error ("itms2args: '" ^ Celem.term2str d ^ "' not in itms")
14.97 | SOME (_, _, _, _, itm_) => Model.penvval_in itm_
14.98 (*| SOME (_,_,_,_,itm_) => mk_arg thy (Model.d_in itm_) (ts_in itm_);
14.99 penv postponed; presently penv holds already LTool.env for script*)
14.100 @@ -233,12 +233,12 @@
14.101 val subStr = Selem.subst2subs subML;
14.102 in (Tac.Rewrite_Set_Inst (subStr, rls), Tac.Empty_Tac_) end
14.103 | stac2tac_ _ _ (Const ("Script.Calculate", _) $ Free (op_, _) $ _) = (Tac.Calculate op_, Tac.Empty_Tac_)
14.104 - | stac2tac_ _ _ (Const ("Script.Take", _) $ t) = (Tac.Take (term2str t), Tac.Empty_Tac_)
14.105 + | stac2tac_ _ _ (Const ("Script.Take", _) $ t) = (Tac.Take (Celem.term2str t), Tac.Empty_Tac_)
14.106 | stac2tac_ _ _ (Const ("Script.Substitute", _) $ isasub $ _) =
14.107 (Tac.Substitute ((Selem.subte2sube o TermC.isalist2list) isasub), Tac.Empty_Tac_)
14.108 | stac2tac_ _ thy (Const("Script.Check'_elementwise", _) $ _ $
14.109 (Const ("Set.Collect", _) $ Abs (_, _, pred))) =
14.110 - (Tac.Check_elementwise (term_to_string''' thy pred), Tac.Empty_Tac_)
14.111 + (Tac.Check_elementwise (Celem.term_to_string''' thy pred), Tac.Empty_Tac_)
14.112 | stac2tac_ _ _ (Const("Script.Or'_to'_List", _) $ _ ) = (Tac.Or_to_List, Tac.Empty_Tac_)
14.113 | stac2tac_ _ _ (Const ("Script.Tac", _) $ Free (str, _)) =
14.114 (Tac.Tac ((de_esc_underscore o strip_thy) str), Tac.Empty_Tac_)
14.115 @@ -249,7 +249,7 @@
14.116 ags') =
14.117 let
14.118 val dI = ((implode o drop_last(*.."'"*) o Symbol.explode) dI')(*^""*);
14.119 - val thy = maxthy (assoc_thy dI) (rootthy pt);
14.120 + val thy = Celem.maxthy (Celem.assoc_thy dI) (rootthy pt);
14.121 val pI = ((map (de_esc_underscore o TermC.free2str)) o TermC.isalist2list) pI';
14.122 val mI = ((map (de_esc_underscore o TermC.free2str)) o TermC.isalist2list) mI';
14.123 val ags = TermC.isalist2list ags';
14.124 @@ -268,9 +268,9 @@
14.125 => (Chead.match_ags_msg pI stac ags(*raise exn*); []), mI);
14.126 val (fmz_, vals) = Chead.oris2fmz_vals pors;
14.127 val {cas,ppc,thy,...} = Specify.get_pbt pI
14.128 - val dI = theory2theory' thy (*.take dI from _refined_ pbl.*)
14.129 - val dI = theory2theory' (maxthy (assoc_thy dI) (rootthy pt));
14.130 - val ctxt = dI |> Thy_Info_get_theory |> Proof_Context.init_global |> Stool.declare_constraints' vals
14.131 + val dI = Celem.theory2theory' thy (*.take dI from _refined_ pbl.*)
14.132 + val dI = Celem.theory2theory' (Celem.maxthy (Celem.assoc_thy dI) (rootthy pt));
14.133 + val ctxt = dI |> Celem.Thy_Info_get_theory |> Proof_Context.init_global |> Stool.declare_constraints' vals
14.134 val hdl =
14.135 case cas of
14.136 NONE => LTool.pblterm dI pI
14.137 @@ -278,7 +278,7 @@
14.138 val f = LTool.subpbl (strip_thy dI) pI
14.139 in (Tac.Subproblem (dI, pI), Tac.Subproblem' ((dI, pI, mI), pors, hdl, fmz_, ctxt, f))
14.140 end
14.141 - | stac2tac_ _ thy t = error ("stac2tac_ TODO: no match for " ^ term_to_string''' thy t);
14.142 + | stac2tac_ _ thy t = error ("stac2tac_ TODO: no match for " ^ Celem.term_to_string''' thy t);
14.143
14.144 fun stac2tac pt thy t = (fst o stac2tac_ pt thy) t;
14.145
14.146 @@ -316,7 +316,7 @@
14.147 else ((*tracing"3### assod ..AssWeak";*) AssWeak(m, f'))
14.148 else ((*tracing"3### assod ..NotAss";*) NotAss)
14.149 | (Const ("Script.Rewrite'_Set'_Inst",_) $ _ $ Free (rls_, _) $ _ $ f_) =>
14.150 - if Rtools.contains_rule (Thm thm'') (assoc_rls rls_)
14.151 + if Rtools.contains_rule (Celem.Thm thm'') (assoc_rls rls_)
14.152 then if f = f_ then Ass (m,f') else AssWeak (m,f')
14.153 else NotAss
14.154 | _ => NotAss)
14.155 @@ -336,28 +336,28 @@
14.156 AssWeak (m,f'))
14.157 else ((*tracing"3### assod ..NotAss";*) NotAss))
14.158 | (Const ("Script.Rewrite'_Set", _) $ Free (rls_, _) $ _ $ f_) =>
14.159 - if Rtools.contains_rule (Thm thm'') (assoc_rls rls_)
14.160 + if Rtools.contains_rule (Celem.Thm thm'') (assoc_rls rls_)
14.161 then if f = f_ then Ass (m, f') else AssWeak (m, f')
14.162 else NotAss
14.163 | _ => NotAss)
14.164 | assod _ _ (m as Tac.Rewrite_Set_Inst' (_, _, _, rls, f, (f', _)))
14.165 (Const ("Script.Rewrite'_Set'_Inst", _) $ _ $ Free (rls_, _) $ _ $ f_) =
14.166 - if id_rls rls = rls_
14.167 + if Celem.id_rls rls = rls_
14.168 then if f = f_ then Ass (m, f') else AssWeak (m ,f')
14.169 else NotAss
14.170 | assod _ _ (m as Tac.Detail_Set_Inst' (_, _, _, rls, f, (f',_)))
14.171 (Const ("Script.Rewrite'_Set'_Inst", _) $ _ $ Free (rls_, _) $ _ $ f_) =
14.172 - if id_rls rls = rls_
14.173 + if Celem.id_rls rls = rls_
14.174 then if f = f_ then Ass (m, f') else AssWeak (m, f')
14.175 else NotAss
14.176 | assod _ _ (m as Tac.Rewrite_Set' (_, _, rls, f, (f', _)))
14.177 (Const ("Script.Rewrite'_Set", _) $ Free (rls_, _) $ _ $ f_) =
14.178 - if id_rls rls = rls_
14.179 + if Celem.id_rls rls = rls_
14.180 then if f = f_ then Ass (m, f') else AssWeak (m, f')
14.181 else NotAss
14.182 | assod _ _ (m as Tac.Detail_Set' (_, _, rls, f, (f', _)))
14.183 (Const ("Script.Rewrite'_Set", _) $ Free (rls_, _) $ _ $ f_) =
14.184 - if id_rls rls = rls_
14.185 + if Celem.id_rls rls = rls_
14.186 then if f = f_ then Ass (m, f') else AssWeak (m, f')
14.187 else NotAss
14.188 | assod _ _ (m as Tac.Calculate' (_, op_, f, (f', _))) stac =
14.189 @@ -367,16 +367,16 @@
14.190 then if f = f_ then Ass (m, f') else AssWeak (m, f')
14.191 else NotAss
14.192 | (Const ("Script.Rewrite'_Set'_Inst", _) $ _ $ Free(rls_,_) $_$f_) =>
14.193 - let val thy = assoc_thy "Isac";
14.194 + let val thy = Celem.assoc_thy "Isac";
14.195 in
14.196 - if Rtools.contains_rule (Calc (assoc_calc' thy op_ |> snd)) (assoc_rls rls_)
14.197 + if Rtools.contains_rule (Celem.Calc (assoc_calc' thy op_ |> snd)) (assoc_rls rls_)
14.198 then if f = f_ then Ass (m, f') else AssWeak (m, f')
14.199 else NotAss
14.200 end
14.201 | (Const ("Script.Rewrite'_Set",_) $ Free (rls_, _) $ _ $ f_) =>
14.202 - let val thy = assoc_thy "Isac";
14.203 + let val thy = Celem.assoc_thy "Isac";
14.204 in
14.205 - if Rtools.contains_rule (Calc (assoc_calc' thy op_ |> snd)) (assoc_rls rls_)
14.206 + if Rtools.contains_rule (Celem.Calc (assoc_calc' thy op_ |> snd)) (assoc_rls rls_)
14.207 then if f = f_ then Ass (m,f') else AssWeak (m,f')
14.208 else NotAss
14.209 end
14.210 @@ -397,7 +397,7 @@
14.211 in if t = t' then error "assod: Substitute' not applicable to val of Expr"
14.212 else Ass (Tac.Substitute' (ro, erls, subte, t, t'), t')
14.213 end
14.214 - else (case Rewrite.rewrite_terms_ (Isac()) ro erls subte t of
14.215 + else (case Rewrite.rewrite_terms_ (Celem.Isac ()) ro erls subte t of
14.216 SOME (t', _) => Ass (Tac.Substitute' (ro, erls, subte, t, t'), t')
14.217 | NONE => error "assod: Substitute' not applicable to val of Expr")
14.218 | assod _ _ (m as Tac.Tac_ (thy, _, id, f')) (Const ("Script.Tac",_) $ Free (id', _)) =
14.219 @@ -411,7 +411,7 @@
14.220 Free (dI',_) $ (Const ("Product_Type.Pair",_) $ pI' $ mI')) $ ags') =
14.221 let
14.222 val dI = ((implode o drop_last(*.."'"*) o Symbol.explode) dI')(*^""*);
14.223 - val thy = maxthy (assoc_thy dI) (rootthy pt);
14.224 + val thy = Celem.maxthy (Celem.assoc_thy dI) (rootthy pt);
14.225 val pI = ((map (de_esc_underscore o TermC.free2str)) o TermC.isalist2list) pI';
14.226 val mI = ((map (de_esc_underscore o TermC.free2str)) o TermC.isalist2list) mI';
14.227 val ags = TermC.isalist2list ags';
14.228 @@ -430,9 +430,9 @@
14.229 => (Chead.match_ags_msg pI stac ags(*raise exn*); []), mI);
14.230 val (fmz_, vals) = Chead.oris2fmz_vals pors;
14.231 val {cas, ppc, thy, ...} = Specify.get_pbt pI
14.232 - val dI = theory2theory' thy (*take dI from _refined_ pbl*)
14.233 - val dI = theory2theory' (maxthy (assoc_thy dI) (rootthy pt))
14.234 - val ctxt = dI |> Thy_Info_get_theory |> Proof_Context.init_global |> Stool.declare_constraints' vals
14.235 + val dI = Celem.theory2theory' thy (*take dI from _refined_ pbl*)
14.236 + val dI = Celem.theory2theory' (Celem.maxthy (Celem.assoc_thy dI) (rootthy pt))
14.237 + val ctxt = dI |> Celem.Thy_Info_get_theory |> Proof_Context.init_global |> Stool.declare_constraints' vals
14.238 val hdl =
14.239 case cas of
14.240 NONE => LTool.pblterm dI pI
14.241 @@ -463,19 +463,19 @@
14.242 | tac_2tac (Tac.Rewrite' (_, _, _, _, thm, _, _)) = Tac.Rewrite thm
14.243 | tac_2tac (Tac.Rewrite_Inst' (_, _, _, _, sub, thm, _, _)) = Tac.Rewrite_Inst (Selem.subst2subs sub, thm)
14.244
14.245 - | tac_2tac (Tac.Rewrite_Set' (_, _, rls, _, _)) = Tac.Rewrite_Set (id_rls rls)
14.246 - | tac_2tac (Tac.Detail_Set' (_, _, rls, _, _)) = Tac.Detail_Set (id_rls rls)
14.247 + | tac_2tac (Tac.Rewrite_Set' (_, _, rls, _, _)) = Tac.Rewrite_Set (Celem.id_rls rls)
14.248 + | tac_2tac (Tac.Detail_Set' (_, _, rls, _, _)) = Tac.Detail_Set (Celem.id_rls rls)
14.249
14.250 | tac_2tac (Tac.Rewrite_Set_Inst' (_, _, sub, rls, _, _)) =
14.251 - Tac.Rewrite_Set_Inst (Selem.subst2subs sub,id_rls rls)
14.252 + Tac.Rewrite_Set_Inst (Selem.subst2subs sub, Celem.id_rls rls)
14.253 | tac_2tac (Tac.Detail_Set_Inst' (_, _, sub, rls, _, _)) =
14.254 - Tac.Detail_Set_Inst (Selem.subst2subs sub,id_rls rls)
14.255 + Tac.Detail_Set_Inst (Selem.subst2subs sub, Celem.id_rls rls)
14.256
14.257 | tac_2tac (Tac.Calculate' (_, op_, _, _)) = Tac.Calculate (op_)
14.258 | tac_2tac (Tac.Check_elementwise' (_, pred, _)) = Tac.Check_elementwise pred
14.259
14.260 | tac_2tac (Tac.Or_to_List' _) = Tac.Or_to_List
14.261 - | tac_2tac (Tac.Take' term) = Tac.Take (term2str term)
14.262 + | tac_2tac (Tac.Take' term) = Tac.Take (Celem.term2str term)
14.263 | tac_2tac (Tac.Substitute' (_, _, subte, _, _)) = Tac.Substitute (Selem.subte2sube subte)
14.264 | tac_2tac (Tac.Tac_ (_, _, id, _)) = Tac.Tac id
14.265
14.266 @@ -488,7 +488,7 @@
14.267
14.268 fun make_rule thy t =
14.269 let val ct = Thm.global_cterm_of thy (HOLogic.Trueprop $ t)
14.270 - in Thm (term_to_string''' thy (Thm.term_of ct), Thm.make_thm ct) end;
14.271 + in Celem.Thm (Celem.term_to_string''' thy (Thm.term_of ct), Thm.make_thm ct) end;
14.272
14.273 fun rep_tac_ (Tac.Rewrite_Inst' (thy', _, _, put, subs, (thmID, _), f, (f', _))) =
14.274 let val fT = type_of f;
14.275 @@ -498,32 +498,32 @@
14.276 val sT' = type_of subs';
14.277 val lhs = Const ("Script.Rewrite'_Inst", [sT', idT, HOLogic.boolT, fT] ---> fT)
14.278 $ subs' $ Free (thmID, idT) $ b $ f;
14.279 - in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs, f'), (lhs, f')) end
14.280 + in (((make_rule (Celem.assoc_thy thy')) o HOLogic.mk_eq) (lhs, f'), (lhs, f')) end
14.281 | rep_tac_ (Tac.Rewrite' (thy', _, _, put, (thmID, _), f, (f', _)))=
14.282 let
14.283 val fT = type_of f;
14.284 val b = if put then @{term True} else @{term False};
14.285 val lhs = Const ("Script.Rewrite", [idT, HOLogic.boolT, fT] ---> fT)
14.286 $ Free (thmID, idT) $ b $ f;
14.287 - in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs, f'), (lhs, f')) end
14.288 - | rep_tac_ (Tac.Rewrite_Set_Inst' (_, _, _, _, _, (f', _))) = (e_rule, (e_term, f'))
14.289 + in (((make_rule (Celem.assoc_thy thy')) o HOLogic.mk_eq) (lhs, f'), (lhs, f')) end
14.290 + | rep_tac_ (Tac.Rewrite_Set_Inst' (_, _, _, _, _, (f', _))) = (Celem.e_rule, (Celem.e_term, f'))
14.291 | rep_tac_ (Tac.Rewrite_Set' (thy', put, rls, f, (f', _))) =
14.292 let
14.293 val fT = type_of f;
14.294 val b = if put then @{term True} else @{term False};
14.295 val lhs = Const ("Script.Rewrite'_Set", [idT, HOLogic.boolT, fT] ---> fT)
14.296 - $ Free (id_rls rls, idT) $ b $ f;
14.297 - in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end
14.298 + $ Free (Celem.id_rls rls, idT) $ b $ f;
14.299 + in (((make_rule (Celem.assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end
14.300 | rep_tac_ (Tac.Calculate' (thy', op_, f, (f', _)))=
14.301 let
14.302 val fT = type_of f;
14.303 val lhs = Const ("Script.Calculate",[idT,fT] ---> fT) $ Free (op_,idT) $ f
14.304 - in (((make_rule (assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end
14.305 - | rep_tac_ (Tac.Check_elementwise' (_, _, (t', _))) = (Erule, (e_term, t'))
14.306 - | rep_tac_ (Tac.Subproblem' (_, _, _, _, _, t')) = (Erule, (e_term, t'))
14.307 - | rep_tac_ (Tac.Take' t') = (Erule, (e_term, t'))
14.308 - | rep_tac_ (Tac.Substitute' (_, _, _, t, t')) = (Erule, (t, t'))
14.309 - | rep_tac_ (Tac.Or_to_List' (t, t')) = (Erule, (t, t'))
14.310 + in (((make_rule (Celem.assoc_thy thy')) o HOLogic.mk_eq) (lhs,f'),(lhs,f')) end
14.311 + | rep_tac_ (Tac.Check_elementwise' (_, _, (t', _))) = (Celem.Erule, (Celem.e_term, t'))
14.312 + | rep_tac_ (Tac.Subproblem' (_, _, _, _, _, t')) = (Celem.Erule, (Celem.e_term, t'))
14.313 + | rep_tac_ (Tac.Take' t') = (Celem.Erule, (Celem.e_term, t'))
14.314 + | rep_tac_ (Tac.Substitute' (_, _, _, t, t')) = (Celem.Erule, (t, t'))
14.315 + | rep_tac_ (Tac.Or_to_List' (t, t')) = (Celem.Erule, (t, t'))
14.316 | rep_tac_ m = error ("rep_tac_: not impl.for " ^ Tac.tac_2str m)
14.317
14.318 fun tac_2res m = (snd o snd o rep_tac_) m;
14.319 @@ -540,19 +540,19 @@
14.320 case LTool.subst_stacexpr E a v t of
14.321 (a', LTool.STac stac) => (*script-tactic*)
14.322 let val stac' =
14.323 - Rewrite.eval_listexpr_ (assoc_thy thy) srls (subst_atomic (upd_env_opt E (a,v)) stac)
14.324 + Rewrite.eval_listexpr_ (Celem.assoc_thy thy) srls (subst_atomic (upd_env_opt E (a,v)) stac)
14.325 in
14.326 (if (! trace_script)
14.327 - then tracing ("@@@ "^call^" leaf '"^term2str t^"' ---> STac '"^term2str stac ^"'")
14.328 + then tracing ("@@@ "^call^" leaf '" ^ Celem.term2str t^"' ---> STac '" ^ Celem.term2str stac ^"'")
14.329 else ();
14.330 (a', LTool.STac stac'))
14.331 end
14.332 | (a', LTool.Expr lexpr) => (*leaf-expression*)
14.333 let val lexpr' =
14.334 - Rewrite.eval_listexpr_ (assoc_thy thy) srls (subst_atomic (upd_env_opt E (a,v)) lexpr)
14.335 + Rewrite.eval_listexpr_ (Celem.assoc_thy thy) srls (subst_atomic (upd_env_opt E (a,v)) lexpr)
14.336 in
14.337 (if (! trace_script)
14.338 - then tracing("@@@ "^call^" leaf '"^term2str t^"' ---> Expr '"^term2str lexpr'^"'")
14.339 + then tracing("@@@ "^call^" leaf '" ^ Celem.term2str t^"' ---> Expr '" ^ Celem.term2str lexpr'^"'")
14.340 else ();
14.341 (a', LTool.Expr lexpr')) (*lexpr' is the value of the Expr*)
14.342 end;
14.343 @@ -594,69 +594,69 @@
14.344 *)
14.345 (*WN161112 blanks between list elements left as is until istate is introduced here*)
14.346 fun assy ya ((E,l,a,v,S,b),ss) (Const ("HOL.Let",_) $ e $ (Abs (id,T,body))) =
14.347 - (case assy ya ((E , l @ [L, R], a,v,S,b),ss) e of
14.348 + (case assy ya ((E , l @ [Celem.L, Celem.R], a,v,S,b), ss) e of
14.349 NasApp ((E',l,a,v,S,_),ss) =>
14.350 let
14.351 val id' = TermC.mk_Free (id, T);
14.352 val E' = LTool.upd_env E' (id', v);
14.353 - in assy ya ((E', l @ [R, D], a,v,S,b),ss) body end
14.354 + in assy ya ((E', l @ [Celem.R, Celem.D], a,v,S,b),ss) body end
14.355 | NasNap (v,E) =>
14.356 let
14.357 val id' = TermC.mk_Free (id, T);
14.358 val E' = LTool.upd_env E (id', v);
14.359 - in assy ya ((E', l @ [R, D], a,v,S,b),ss) body end
14.360 + in assy ya ((E', l @ [Celem.R, Celem.D], a,v,S,b),ss) body end
14.361 | ay => ay)
14.362 | assy (ya as (thy,_,srls,_,_)) ((E,l,_,v,S,b),ss) (Const ("Script.While",_) $ c $ e $ a) =
14.363 if Rewrite.eval_true_ thy srls (subst_atomic (LTool.upd_env E (a,v)) c)
14.364 - then assy ya ((E, l @ [L, R], SOME a,v,S,b),ss) e
14.365 + then assy ya ((E, l @ [Celem.L, Celem.R], SOME a,v,S,b),ss) e
14.366 else NasNap (v, E)
14.367 | assy (ya as (thy,_,srls,_,_)) ((E,l,a,v,S,b),ss) (Const ("Script.While",_) $ c $ e) =
14.368 if Rewrite.eval_true_ thy srls (subst_atomic (upd_env_opt E (a,v)) c)
14.369 - then assy ya ((E, l @ [R], a,v,S,b),ss) e
14.370 + then assy ya ((E, l @ [Celem.R], a,v,S,b),ss) e
14.371 else NasNap (v, E)
14.372 | assy (ya as (thy,_,srls,_,_)) ((E,l,a,v,S,b),ss) (Const ("If",_) $ c $ e1 $ e2) =
14.373 if Rewrite.eval_true_ thy srls (subst_atomic (upd_env_opt E (a,v)) c)
14.374 - then assy ya ((E, l @ [L, R], a,v,S,b),ss) e1
14.375 - else assy ya ((E, l @ [R], a,v,S,b),ss) e2
14.376 + then assy ya ((E, l @ [Celem.L, Celem.R], a,v,S,b),ss) e1
14.377 + else assy ya ((E, l @ [Celem.R], a,v,S,b),ss) e2
14.378 | assy ya ((E,l,_,v,S,b),ss) (Const ("Script.Try",_) $ e $ a) =
14.379 - (case assy ya ((E, l @ [L, R], SOME a,v,S,b),ss) e of ay => ay)
14.380 + (case assy ya ((E, l @ [Celem.L, Celem.R], SOME a,v,S,b),ss) e of ay => ay)
14.381 | assy ya ((E,l,a,v,S,b),ss) (Const ("Script.Try",_) $ e) =
14.382 - (case assy ya ((E, l @ [R], a,v,S,b),ss) e of ay => ay)
14.383 + (case assy ya ((E, l @ [Celem.R], a,v,S,b),ss) e of ay => ay)
14.384 | assy ya ((E,l,_,v,S,b),ss) (Const ("Script.Seq",_) $e1 $ e2 $ a) =
14.385 - (case assy ya ((E, l @ [L, L, R], SOME a,v,S,b),ss) e1 of
14.386 - NasNap (v, E) => assy ya ((E, l @ [L, R], SOME a,v,S,b),ss) e2
14.387 - | NasApp ((E,_,_,v,_,_),ss) => assy ya ((E, l @ [L, R], SOME a,v,S,b),ss) e2
14.388 + (case assy ya ((E, l @ [Celem.L, Celem.L, Celem.R], SOME a,v,S,b),ss) e1 of
14.389 + NasNap (v, E) => assy ya ((E, l @ [Celem.L, Celem.R], SOME a,v,S,b),ss) e2
14.390 + | NasApp ((E,_,_,v,_,_),ss) => assy ya ((E, l @ [Celem.L, Celem.R], SOME a,v,S,b),ss) e2
14.391 | ay => ay)
14.392 | assy ya ((E,l,a,v,S,b),ss) (Const ("Script.Seq",_) $e1 $ e2) =
14.393 - (case assy ya ((E, l @ [L, R], a,v,S,b),ss) e1 of
14.394 - NasNap (v, E) => assy ya ((E, l @ [R], a,v,S,b),ss) e2
14.395 - | NasApp ((E,_,_,v,_,_),ss) => assy ya ((E, l @ [R], a,v,S,b),ss) e2
14.396 + (case assy ya ((E, l @ [Celem.L, Celem.R], a,v,S,b),ss) e1 of
14.397 + NasNap (v, E) => assy ya ((E, l @ [Celem.R], a,v,S,b),ss) e2
14.398 + | NasApp ((E,_,_,v,_,_),ss) => assy ya ((E, l @ [Celem.R], a,v,S,b),ss) e2
14.399 | ay => ay)
14.400 | assy ya ((E,l,_,v,S,b),ss) (Const ("Script.Repeat",_) $ e $ a) =
14.401 - assy ya ((E,(l @ [L, R]),SOME a,v,S,b),ss) e
14.402 + assy ya ((E,(l @ [Celem.L, Celem.R]),SOME a,v,S,b),ss) e
14.403 | assy ya ((E,l,a,v,S,b),ss) (Const ("Script.Repeat",_) $ e) =
14.404 - assy ya ((E,(l @ [R]),a,v,S,b),ss) e
14.405 + assy ya ((E,(l @ [Celem.R]),a,v,S,b),ss) e
14.406 | assy (y,x,s,sc,Aundef) ((E,l,_,v,S,b),ss) (Const ("Script.Or",_) $e1 $ e2 $ a) =
14.407 - (case assy (y,x,s,sc,AssOnly) ((E,(l @ [L, L, R]),SOME a,v,S,b),ss) e1 of
14.408 + (case assy (y,x,s,sc,AssOnly) ((E,(l @ [Celem.L, Celem.L, Celem.R]),SOME a,v,S,b),ss) e1 of
14.409 NasNap (v, E) =>
14.410 - (case assy (y,x,s,sc,AssOnly) ((E,(l @ [L, R]),SOME a,v,S,b),ss) e2 of
14.411 + (case assy (y,x,s,sc,AssOnly) ((E,(l @ [Celem.L, Celem.R]),SOME a,v,S,b),ss) e2 of
14.412 NasNap (v, E) =>
14.413 - (case assy (y,x,s,sc,AssGen) ((E,(l @ [L, L, R]),SOME a,v,S,b),ss) e1 of
14.414 + (case assy (y,x,s,sc,AssGen) ((E,(l @ [Celem.L, Celem.L, Celem.R]),SOME a,v,S,b),ss) e1 of
14.415 NasNap (v, E) =>
14.416 - assy (y,x,s,sc,AssGen) ((E, (l @ [L, R]), SOME a,v,S,b),ss) e2
14.417 + assy (y,x,s,sc,AssGen) ((E, (l @ [Celem.L, Celem.R]), SOME a,v,S,b),ss) e2
14.418 | ay => ay)
14.419 | ay =>ay)
14.420 | NasApp _ => error ("assy: FIXXXME ///must not return NasApp///")
14.421 | ay => (ay))
14.422 | assy ya ((E,l,a,v,S,b),ss) (Const ("Script.Or",_) $e1 $ e2) =
14.423 - (case assy ya ((E,(l @ [L, R]),a,v,S,b),ss) e1 of
14.424 - NasNap (v, E) => assy ya ((E,(l @ [R]),a,v,S,b),ss) e2
14.425 + (case assy ya ((E, (l @ [Celem.L, Celem.R]),a,v,S,b), ss) e1 of
14.426 + NasNap (v, E) => assy ya ((E,(l @ [Celem.R]),a,v,S,b), ss) e2
14.427 | ay => (ay))
14.428 (*here is not a tactical like TRY etc, but a tactic creating a step in calculation*)
14.429 | assy (thy',ctxt,sr,d,ap) ((E,l,a,v,S,_), (m,_,pt,(p,p_),c)::ss) t =
14.430 (case handle_leaf "locate" thy' sr E a v t of
14.431 (a', LTool.Expr _) =>
14.432 - (NasNap (Rewrite.eval_listexpr_ (assoc_thy thy') sr
14.433 + (NasNap (Rewrite.eval_listexpr_ (Celem.assoc_thy thy') sr
14.434 (subst_atomic (upd_env_opt E (a',v)) t), E))
14.435 | (a', LTool.STac stac) =>
14.436 let
14.437 @@ -668,40 +668,40 @@
14.438 case assod pt d m stac of
14.439 Ass (m,v') =>
14.440 let val (p'',c',f',pt') =
14.441 - Generate.generate1 (assoc_thy thy') m (Selem.ScrState (E,l,a',v',S,true), ctxt) (p',p_) pt;
14.442 + Generate.generate1 (Celem.assoc_thy thy') m (Selem.ScrState (E,l,a',v',S,true), ctxt) (p',p_) pt;
14.443 in Assoc ((E,l,a',v',S,true), (m,f',pt',p'',c @ c')::ss) end
14.444 | AssWeak (m,v') =>
14.445 let val (p'',c',f',pt') =
14.446 - Generate.generate1 (assoc_thy thy') m (Selem.ScrState (E,l,a',v',S,false), ctxt) (p',p_) pt;
14.447 + Generate.generate1 (Celem.assoc_thy thy') m (Selem.ScrState (E,l,a',v',S,false), ctxt) (p',p_) pt;
14.448 in Assoc ((E,l,a',v',S,false), (m,f',pt',p'',c @ c')::ss) end
14.449 | NotAss =>
14.450 (case ap of (*switch for Or: 1st AssOnly, 2nd AssGen*)
14.451 AssOnly => (NasNap (v, E))
14.452 | _ =>
14.453 - (case Applicable.applicable_in (p,p_) pt (stac2tac pt (assoc_thy thy') stac) of
14.454 + (case Applicable.applicable_in (p,p_) pt (stac2tac pt (Celem.assoc_thy thy') stac) of
14.455 Chead.Appl m' =>
14.456 let
14.457 val is = (E,l,a',tac_2res m',S,false(*FIXXXME.WN0?*))
14.458 val (p'',c',f',pt') =
14.459 - Generate.generate1 (assoc_thy thy') m' (Selem.ScrState is, ctxt) (p', p_) pt;
14.460 + Generate.generate1 (Celem.assoc_thy thy') m' (Selem.ScrState is, ctxt) (p', p_) pt;
14.461 in NasApp (is,(m,f',pt',p'',c @ c')::ss) end
14.462 | Chead.Notappl _ => (NasNap (v, E))
14.463 )
14.464 )
14.465 end)
14.466 - | assy _ (_, []) t = error ("assy: uncovered fun-def with " ^ term2str t);
14.467 + | assy _ (_, []) t = error ("assy: uncovered fun-def with " ^ Celem.term2str t);
14.468
14.469 (*WN161112 blanks between list elements left as is until istate is introduced here*)
14.470 -fun ass_up (ys as (y,ctxt,s,Prog sc,d)) ((E,l,a,v,S,b),ss) (Const ("HOL.Let",_) $ _) =
14.471 +fun ass_up (ys as (y,ctxt,s,Celem.Prog sc,d)) ((E,l,a,v,S,b),ss) (Const ("HOL.Let",_) $ _) =
14.472 let
14.473 val l = drop_last l; (*comes from e, goes to Abs*)
14.474 val (i, T, body) =
14.475 (case go l sc of
14.476 Const ("HOL.Let",_) $ _ $ (Abs (i, T, body)) => (i, T, body)
14.477 - | t => error ("ass_up..HOL.Let $ _ with " ^ term2str t))
14.478 + | t => error ("ass_up..HOL.Let $ _ with " ^ Celem.term2str t))
14.479 val i = TermC.mk_Free (i, T);
14.480 val E = LTool.upd_env E (i, v);
14.481 - in case assy (y,ctxt,s,d,Aundef) ((E, l @ [R, D], a,v,S,b),ss) body of
14.482 + in case assy (y,ctxt,s,d,Aundef) ((E, l @ [Celem.R, Celem.D], a,v,S,b),ss) body of
14.483 Assoc iss => Assoc iss
14.484 | NasApp iss => astep_up ys iss
14.485 | NasNap (v, E) => astep_up ys ((E,l,a,v,S,b),ss)
14.486 @@ -713,15 +713,15 @@
14.487 | ass_up ysa iss (Const ("Script.Seq",_) $ _ $ _) =
14.488 astep_up ysa iss (*2*: comes from e2*)
14.489
14.490 - | ass_up (ysa as (y,ctxt,s,Prog sc,d)) ((E,l,a,v,S,b),ss)
14.491 + | ass_up (ysa as (y,ctxt,s,Celem.Prog sc,d)) ((E,l,a,v,S,b),ss)
14.492 (Const ("Script.Seq",_) $ _ ) = (*2*: comes from e1, goes to e2*)
14.493 let
14.494 val up = drop_last l;
14.495 val e2 =
14.496 (case go up sc of
14.497 Const ("Script.Seq",_) $ _ $ e2 => e2
14.498 - | t => error ("ass_up..Script.Seq $ _ with " ^ term2str t))
14.499 - in case assy (y,ctxt,s,d,Aundef) ((E, up @ [R], a,v,S,b),ss) e2 of
14.500 + | t => error ("ass_up..Script.Seq $ _ with " ^ Celem.term2str t))
14.501 + in case assy (y,ctxt,s,d,Aundef) ((E, up @ [Celem.R], a,v,S,b),ss) e2 of
14.502 NasNap (v,E) => astep_up ysa ((E,up,a,v,S,b),ss)
14.503 | NasApp iss => astep_up ysa iss
14.504 | ay => ay
14.505 @@ -732,7 +732,7 @@
14.506 (*(Const ("Script.While",_) $ c $ e $ a) = WN050930 blind fix*)
14.507 (t as Const ("Script.While",_) $ c $ e $ a) =
14.508 if Rewrite.eval_true_ y s (subst_atomic (LTool.upd_env E (a,v)) c)
14.509 - then case assy (y,ctxt,s,d,Aundef) ((E, l @ [L, R], SOME a,v,S,b),ss) e of
14.510 + then case assy (y,ctxt,s,d,Aundef) ((E, l @ [Celem.L, Celem.R], SOME a,v,S,b),ss) e of
14.511 NasNap (v,E') => astep_up ys ((E',l, SOME a,v,S,b),ss)
14.512 | NasApp ((E',l,a,v,S,b),ss) =>
14.513 ass_up ys ((E',l,a,v,S,b),ss) t (*WN050930 't' was not assigned*)
14.514 @@ -742,7 +742,7 @@
14.515 (*(Const ("Script.While",_) $ c $ e) = WN050930 blind fix*)
14.516 (t as Const ("Script.While",_) $ c $ e) =
14.517 if Rewrite.eval_true_ y s (subst_atomic (upd_env_opt E (a,v)) c)
14.518 - then case assy (y,ctxt,s,d,Aundef) ((E, l @ [R], a,v,S,b),ss) e of
14.519 + then case assy (y,ctxt,s,d,Aundef) ((E, l @ [Celem.R], a,v,S,b),ss) e of
14.520 NasNap (v,E') => astep_up ys ((E',l, a,v,S,b),ss)
14.521 | NasApp ((E',l,a,v,S,b),ss) =>
14.522 ass_up ys ((E',l,a,v,S,b),ss) t (*WN050930 't' was not assigned*)
14.523 @@ -751,14 +751,14 @@
14.524 | ass_up y iss (Const ("If",_) $ _ $ _ $ _) = astep_up y iss
14.525 | ass_up (ys as (y,ctxt,s,_,d)) ((E,l,_,v,S,b),ss)
14.526 (t as Const ("Script.Repeat",_) $ e $ a) =
14.527 - (case assy (y,ctxt,s,d, Aundef) ((E, (l @ [L, R]), SOME a,v,S,b),ss) e of
14.528 + (case assy (y,ctxt,s,d, Aundef) ((E, (l @ [Celem.L, Celem.R]), SOME a,v,S,b),ss) e of
14.529 NasNap (v,E') => astep_up ys ((E',l, SOME a,v,S,b),ss)
14.530 | NasApp ((E',l,a,v,S,b),ss) =>
14.531 ass_up ys ((E',l,a,v,S,b),ss) t
14.532 | ay => ay)
14.533 | ass_up (ys as (y,ctxt,s,_,d)) ((E,l,a,v,S,b),ss)
14.534 (t as Const ("Script.Repeat",_) $ e) =
14.535 - (case assy (y,ctxt,s,d,Aundef) ((E, (l @ [R]), a,v,S,b),ss) e of
14.536 + (case assy (y,ctxt,s,d,Aundef) ((E, (l @ [Celem.R]), a,v,S,b),ss) e of
14.537 NasNap (v', E') => astep_up ys ((E',l,a,v',S,b),ss)
14.538 | NasApp ((E',l,a,v',S,_),ss) => ass_up ys ((E',l,a,v',S,b),ss) t
14.539 | ay => ay)
14.540 @@ -767,14 +767,14 @@
14.541 | ass_up y ((E,l,a,v,S,b),ss) (Const ("Script.Or",_) $ _ ) =
14.542 astep_up y ((E, (drop_last l), a,v,S,b),ss)
14.543 | ass_up _ _ t =
14.544 - error ("ass_up not impl for t= " ^ term2str t)
14.545 -and astep_up (ys as (_,_,_,Prog sc,_)) ((E,l,a,v,S,b),ss) =
14.546 + error ("ass_up not impl for t= " ^ Celem.term2str t)
14.547 +and astep_up (ys as (_,_,_,Celem.Prog sc,_)) ((E,l,a,v,S,b),ss) =
14.548 if 1 < length l
14.549 then
14.550 let val up = drop_last l;
14.551 in ass_up ys ((E,up,a,v,S,b),ss) (go up sc) end
14.552 else (NasNap (v, E))
14.553 - | astep_up _ ((_,l,_,_,_,_),_) = error ("astep_up: uncovered fun-def with " ^ loc_2str l)
14.554 + | astep_up _ ((_,l,_,_,_,_),_) = error ("astep_up: uncovered fun-def with " ^ Celem.loc_2str l)
14.555
14.556 (*check if there are tacs for rewriting only*)
14.557 fun rew_only ([]:step list) = true
14.558 @@ -816,16 +816,16 @@
14.559 *)
14.560 (*WN161112 blanks between list elements left as is until istate is introduced here*)
14.561 fun locate_gen (thy', _) (Tac.Rewrite' (_, ro, er, pa, thm, f, _)) (pt, p)
14.562 - (Rfuns {locate_rule=lo,...}, _) (Selem.RrlsState (_,f'',rss,rts), _) =
14.563 - (case lo rss f (Thm thm) of
14.564 + (Celem.Rfuns {locate_rule=lo,...}, _) (Selem.RrlsState (_,f'',rss,rts), _) =
14.565 + (case lo rss f (Celem.Thm thm) of
14.566 [] => NotLocatable
14.567 | rts' => Steps (rts2steps [] ((pt,p),(f,f'',rss,rts),(thy',ro,er,pa)) rts'))
14.568 | locate_gen (thy', srls) m (pt, p)
14.569 - (scr as Prog (_ $ body),d) (Selem.ScrState (E,l,a,v,S,b), ctxt) =
14.570 - let val thy = assoc_thy thy';
14.571 + (scr as Celem.Prog (_ $ body),d) (Selem.ScrState (E,l,a,v,S,b), ctxt) =
14.572 + let val thy = Celem.assoc_thy thy';
14.573 in case if l = [] orelse (
14.574 (*init.in solve..Apply_Method...*)(last_elem o fst) p = 0 andalso snd p = Res)
14.575 - then (assy (thy',ctxt,srls,d,Aundef) ((E,[R],a,v,S,b), [(m,Generate.EmptyMout,pt,p,[])]) body)
14.576 + then (assy (thy',ctxt,srls,d,Aundef) ((E,[Celem.R],a,v,S,b), [(m,Generate.EmptyMout,pt,p,[])]) body)
14.577 else (astep_up (thy',ctxt,srls,scr,d) ((E,l,a,v,S,b), [(m,Generate.EmptyMout,pt,p,[])]) ) of
14.578 Assoc ((is as (_,_,_,_,_,strong_ass), ss as (_ :: _))) =>
14.579 (if strong_ass
14.580 @@ -845,7 +845,7 @@
14.581 end
14.582 | locate_gen _ m _ (sc,_) (is, _) =
14.583 error ("locate_gen: wrong arguments,\n tac= " ^ Tac.tac_2str m ^ ",\n " ^
14.584 - "scr= " ^ scr2str sc ^ ",\n istate= " ^ Selem.istate2str is);
14.585 + "scr= " ^ Celem.scr2str sc ^ ",\n istate= " ^ Selem.istate2str is);
14.586
14.587 (** find the next stactic in a script **)
14.588
14.589 @@ -878,56 +878,56 @@
14.590 because 'nxt_up Or e1' treats as Appy *)
14.591
14.592 fun appy thy ptp E l (Const ("HOL.Let",_) $ e $ (Abs (i,T,b))) a v =
14.593 - (case appy thy ptp E (l @ [L, R]) e a v of
14.594 + (case appy thy ptp E (l @ [Celem.L, Celem.R]) e a v of
14.595 Skip (res, E) =>
14.596 let val E' = LTool.upd_env E (Free (i,T), res);
14.597 - in appy thy ptp E' (l @ [R, D]) b a v end
14.598 + in appy thy ptp E' (l @ [Celem.R, Celem.D]) b a v end
14.599 | ay => ay)
14.600 | appy (thy as (th,sr)) ptp E l (Const ("Script.While"(*1*),_) $ c $ e $ a) _ v =
14.601 (if Rewrite.eval_true_ th sr (subst_atomic (LTool.upd_env E (a,v)) c)
14.602 - then appy thy ptp E (l @ [L, R]) e (SOME a) v
14.603 + then appy thy ptp E (l @ [Celem.L, Celem.R]) e (SOME a) v
14.604 else Skip (v, E))
14.605 | appy (thy as (th,sr)) ptp E l (Const ("Script.While"(*2*),_) $ c $ e) a v =
14.606 (if Rewrite.eval_true_ th sr (subst_atomic (upd_env_opt E (a,v)) c)
14.607 - then appy thy ptp E (l @ [R]) e a v
14.608 + then appy thy ptp E (l @ [Celem.R]) e a v
14.609 else Skip (v, E))
14.610 | appy (thy as (th,sr)) ptp E l (Const ("If",_) $ c $ e1 $ e2) a v =
14.611 (if Rewrite.eval_true_ th sr (subst_atomic (upd_env_opt E (a,v)) c)
14.612 - then appy thy ptp E (l @ [L, R]) e1 a v
14.613 - else appy thy ptp E (l @ [R]) e2 a v)
14.614 + then appy thy ptp E (l @ [Celem.L, Celem.R]) e1 a v
14.615 + else appy thy ptp E (l @ [Celem.R]) e2 a v)
14.616 | appy thy ptp E l (Const ("Script.Repeat"(*1*),_) $ e $ a) _ v =
14.617 - appy thy ptp E (l @ [L, R]) e (SOME a) v
14.618 - | appy thy ptp E l (Const ("Script.Repeat"(*2*),_) $ e) a v = appy thy ptp E (l @ [R]) e a v
14.619 + appy thy ptp E (l @ [Celem.L, Celem.R]) e (SOME a) v
14.620 + | appy thy ptp E l (Const ("Script.Repeat"(*2*),_) $ e) a v = appy thy ptp E (l @ [Celem.R]) e a v
14.621 | appy thy ptp E l (Const ("Script.Try",_) $ e $ a) _ v =
14.622 - (case appy thy ptp E (l @ [L, R]) e (SOME a) v of
14.623 + (case appy thy ptp E (l @ [Celem.L, Celem.R]) e (SOME a) v of
14.624 Napp E => (Skip (v, E))
14.625 | ay => ay)
14.626 | appy thy ptp E l(Const ("Script.Try",_) $ e) a v =
14.627 - (case appy thy ptp E (l @ [R]) e a v of
14.628 + (case appy thy ptp E (l @ [Celem.R]) e a v of
14.629 Napp E => (Skip (v, E))
14.630 | ay => ay)
14.631 | appy thy ptp E l (Const ("Script.Or"(*1*),_) $e1 $ e2 $ a) _ v =
14.632 - (case appy thy ptp E (l @ [L, L, R]) e1 (SOME a) v of
14.633 + (case appy thy ptp E (l @ [Celem.L, Celem.L, Celem.R]) e1 (SOME a) v of
14.634 Appy lme => Appy lme
14.635 - | _ => appy thy ptp E (*LTool.env*) (l @ [L, R]) e2 (SOME a) v)
14.636 + | _ => appy thy ptp E (*LTool.env*) (l @ [Celem.L, Celem.R]) e2 (SOME a) v)
14.637 | appy thy ptp E l (Const ("Script.Or"(*2*),_) $e1 $ e2) a v =
14.638 - (case appy thy ptp E (l @ [L, R]) e1 a v of
14.639 + (case appy thy ptp E (l @ [Celem.L, Celem.R]) e1 a v of
14.640 Appy lme => Appy lme
14.641 - | _ => appy thy ptp E (l @ [R]) e2 a v)
14.642 + | _ => appy thy ptp E (l @ [Celem.R]) e2 a v)
14.643 | appy thy ptp E l (Const ("Script.Seq"(*1*),_) $ e1 $ e2 $ a) _ v =
14.644 - (case appy thy ptp E (l @ [L, L, R]) e1 (SOME a) v of
14.645 - Skip (v,E) => appy thy ptp E (l @ [L, R]) e2 (SOME a) v
14.646 + (case appy thy ptp E (l @ [Celem.L, Celem.L, Celem.R]) e1 (SOME a) v of
14.647 + Skip (v,E) => appy thy ptp E (l @ [Celem.L, Celem.R]) e2 (SOME a) v
14.648 | ay => ay)
14.649 | appy thy ptp E l (Const ("Script.Seq",_) $ e1 $ e2) a v =
14.650 - (case appy thy ptp E (l @ [L,R]) e1 a v of
14.651 - Skip (v,E) => appy thy ptp E (l @ [R]) e2 a v
14.652 + (case appy thy ptp E (l @ [Celem.L, Celem.R]) e1 a v of
14.653 + Skip (v,E) => appy thy ptp E (l @ [Celem.R]) e2 a v
14.654 | ay => ay)
14.655 (* a leaf has been found *)
14.656 | appy ((th,sr)) (pt, p) E l t a v =
14.657 case handle_leaf "next " th sr E a v t of
14.658 (_, LTool.Expr s) => Skip (s, E)
14.659 | (a', LTool.STac stac) =>
14.660 - let val (m,m') = stac2tac_ pt (assoc_thy th) stac
14.661 + let val (m,m') = stac2tac_ pt (Celem.assoc_thy th) stac
14.662 in case m of
14.663 Tac.Subproblem _ => Appy (m', (E,l,a',tac_2res m',Selem.Sundef,false))
14.664 | _ =>
14.665 @@ -936,7 +936,7 @@
14.666 | _ => Napp E)
14.667 end
14.668 (*GOON*)
14.669 -fun nxt_up thy ptp (scr as (Prog sc)) E l ay (Const ("HOL.Let", _) $ _) a v = (*comes from let=...*)
14.670 +fun nxt_up thy ptp (scr as (Celem.Prog sc)) E l ay (Const ("HOL.Let", _) $ _) a v = (*comes from let=...*)
14.671 if ay = Napp_
14.672 then nstep_up thy ptp scr E (drop_last l) Napp_ a v
14.673 else (*Skip_*)
14.674 @@ -945,11 +945,11 @@
14.675 val (i, T, body) =
14.676 (case go up sc of
14.677 Const ("HOL.Let",_) $ _ $ (Abs aa) => aa
14.678 - | t => error ("nxt_up..HOL.Let $ _ with " ^ term2str t))
14.679 + | t => error ("nxt_up..HOL.Let $ _ with " ^ Celem.term2str t))
14.680 val i = TermC.mk_Free (i, T)
14.681 val E = LTool.upd_env E (i, v)
14.682 in
14.683 - case appy thy ptp E (up @ [R,D]) body a v of
14.684 + case appy thy ptp E (up @ [Celem.R, Celem.D]) body a v of
14.685 Appy lre => Appy lre
14.686 | Napp E => nstep_up thy ptp scr E up Napp_ a v
14.687 | Skip (v,E) => nstep_up thy ptp scr E up Skip_ a v
14.688 @@ -960,7 +960,7 @@
14.689 (*no appy_: never causes Napp -> Helpless*)
14.690 | nxt_up (thy as (th, sr)) ptp scr E l _ (Const ("Script.While"(*1*), _) $ c $ e $ _) a v =
14.691 if Rewrite.eval_true_ th sr (subst_atomic (upd_env_opt E (a, v)) c)
14.692 - then case appy thy ptp E (l @ [L,R]) e a v of
14.693 + then case appy thy ptp E (l @ [Celem.L, Celem.R]) e a v of
14.694 Appy lr => Appy lr
14.695 | Napp E => nstep_up thy ptp scr E l Skip_ a v
14.696 | Skip (v,E) => nstep_up thy ptp scr E l Skip_ a v
14.697 @@ -968,7 +968,7 @@
14.698 (*no appy_: never causes Napp - Helpless*)
14.699 | nxt_up (thy as (th, sr)) ptp scr E l _ (Const ("Script.While"(*2*), _) $ c $ e) a v =
14.700 if Rewrite.eval_true_ th sr (subst_atomic (upd_env_opt E (a, v)) c)
14.701 - then case appy thy ptp E (l @ [R]) e a v of
14.702 + then case appy thy ptp E (l @ [Celem.R]) e a v of
14.703 Appy lr => Appy lr
14.704 | Napp E => nstep_up thy ptp scr E l Skip_ a v
14.705 | Skip (v,E) => nstep_up thy ptp scr E l Skip_ a v
14.706 @@ -976,13 +976,13 @@
14.707 | nxt_up thy ptp scr E l ay (Const ("If", _) $ _ $ _ $ _) a v = nstep_up thy ptp scr E l ay a v
14.708 | nxt_up thy ptp scr E l _ (*no appy_: there was already a stac below*)
14.709 (Const ("Script.Repeat"(*1*), _) $ e $ _) a v =
14.710 - (case appy thy ptp (*upd_env*) E (*a,v)*) ((l @ [L, R]):loc_) e a v of
14.711 + (case appy thy ptp (*upd_env*) E (*a,v)*) (l @ [Celem.L, Celem.R]) e a v of
14.712 Appy lr => Appy lr
14.713 | Napp E => nstep_up thy ptp scr E l Skip_ a v
14.714 | Skip (v,E) => nstep_up thy ptp scr E l Skip_ a v)
14.715 | nxt_up thy ptp scr E l _ (*no appy_: there was already a stac below*)
14.716 (Const ("Script.Repeat"(*2*), _) $ e) a v =
14.717 - (case appy thy ptp (*upd_env*) E (*a,v)*) (l @ [R]) e a v of
14.718 + (case appy thy ptp (*upd_env*) E (*a,v)*) (l @ [Celem.R]) e a v of
14.719 Appy lr => Appy lr
14.720 | Napp E => nstep_up thy ptp scr E l Skip_ a v
14.721 | Skip (v,E) => nstep_up thy ptp scr E l Skip_ a v)
14.722 @@ -1000,7 +1000,7 @@
14.723 (*all has been done in (*2*) below*) nstep_up thy ptp scr E l ay a v
14.724 | nxt_up thy ptp scr E l ay (Const ("Script.Seq"(*2*),_) $ _ $ _) a v = (*comes from e2*)
14.725 nstep_up thy ptp scr E l ay a v
14.726 - | nxt_up thy ptp (scr as Prog sc) E l ay (Const ("Script.Seq",_) $ _) a v = (*comes from e1*)
14.727 + | nxt_up thy ptp (scr as Celem.Prog sc) E l ay (Const ("Script.Seq",_) $ _) a v = (*comes from e1*)
14.728 if ay = Napp_
14.729 then nstep_up thy ptp scr E (drop_last l) Napp_ a v
14.730 else (*Skip_*)
14.731 @@ -1008,20 +1008,20 @@
14.732 val e2 =
14.733 (case go up sc of
14.734 Const ("Script.Seq"(*2*), _) $ _ $ e2 => e2
14.735 - | t => error ("nxt_up..Script.Seq $ _ with " ^ term2str t))
14.736 - in case appy thy ptp E (up @ [R]) e2 a v of
14.737 + | t => error ("nxt_up..Script.Seq $ _ with " ^ Celem.term2str t))
14.738 + in case appy thy ptp E (up @ [Celem.R]) e2 a v of
14.739 Appy lr => Appy lr
14.740 | Napp E => nstep_up thy ptp scr E up Napp_ a v
14.741 | Skip (v,E) => nstep_up thy ptp scr E up Skip_ a v end
14.742 - | nxt_up _ _ _ _ _ _ t _ _ = error ("nxt_up not impl for " ^ term2str t)
14.743 -and nstep_up thy ptp (Prog sc) E l ay a v =
14.744 + | nxt_up _ _ _ _ _ _ t _ _ = error ("nxt_up not impl for " ^ Celem.term2str t)
14.745 +and nstep_up thy ptp (Celem.Prog sc) E l ay a v =
14.746 if 1 < length l
14.747 then
14.748 let val up = drop_last l;
14.749 - in (nxt_up thy ptp (Prog sc) E up ay (go up sc) a v ) end
14.750 + in (nxt_up thy ptp (Celem.Prog sc) E up ay (go up sc) a v ) end
14.751 else (*interpreted to end*)
14.752 if ay = Skip_ then Skip (v, E) else Napp E
14.753 - | nstep_up _ _ _ _ l _ _ _ = error ("nstep_up: uncovered fun-def at " ^ loc_2str l)
14.754 + | nstep_up _ _ _ _ l _ _ _ = error ("nstep_up: uncovered fun-def at " ^ Celem.loc_2str l)
14.755
14.756 (* decide for the next applicable stac in the script;
14.757 returns (stactic, value) - the value in case the script is finished
14.758 @@ -1033,20 +1033,20 @@
14.759 (.. not true for other details ..PrfObj ??????????????????
14.760 20.8.02: do NOT return safe (is only changed in locate !!!)
14.761 *)
14.762 -fun next_tac (thy,_) _ (Rfuns {next_rule, ...}) (Selem.RrlsState(f, f', rss, _), ctxt) =
14.763 +fun next_tac (thy,_) _ (Celem.Rfuns {next_rule, ...}) (Selem.RrlsState(f, f', rss, _), ctxt) =
14.764 if f = f'
14.765 then (Tac.End_Detail' (f',[])(*8.6.03*), (Selem.Uistate, ctxt),
14.766 (f', Selem.Sundef(*FIXME is no value of next_tac! vor 8.6.03*))) (*finished*)
14.767 else
14.768 (case next_rule rss f of
14.769 - NONE => (Tac.Empty_Tac_, (Selem.Uistate, ctxt), (e_term, Selem.Sundef)) (*helpless*)
14.770 - | SOME (Thm thm'')(*8.6.03: muss auch f' liefern ?!!*) =>
14.771 - (Tac.Rewrite' (thy, "e_rew_ord", e_rls, false, thm'', f, (e_term, [(*!?!8.6.03*)])),
14.772 - (Selem.Uistate, ctxt), (e_term, Selem.Sundef)) (*next stac*)
14.773 + NONE => (Tac.Empty_Tac_, (Selem.Uistate, ctxt), (Celem.e_term, Selem.Sundef)) (*helpless*)
14.774 + | SOME (Celem.Thm thm'')(*8.6.03: muss auch f' liefern ?!!*) =>
14.775 + (Tac.Rewrite' (thy, "e_rew_ord", Celem.e_rls, false, thm'', f, (Celem.e_term, [(*!?!8.6.03*)])),
14.776 + (Selem.Uistate, ctxt), (Celem.e_term, Selem.Sundef)) (*next stac*)
14.777 | _ => error "next_tac: uncovered case next_rule")
14.778 - | next_tac thy (ptp as (pt, (p, _)):ctree * pos') (sc as Prog (_ $ body))
14.779 + | next_tac thy (ptp as (pt, (p, _)):ctree * pos') (sc as Celem.Prog (_ $ body))
14.780 (Selem.ScrState (E,l,a,v,s,_), ctxt) =
14.781 - (case if l = [] then appy thy ptp E [R] body NONE v
14.782 + (case if l = [] then appy thy ptp E [Celem.R] body NONE v
14.783 else nstep_up thy ptp sc E l Skip_ a v of
14.784 Skip (v, _) => (*finished*)
14.785 (case par_pbl_det pt p of
14.786 @@ -1056,8 +1056,8 @@
14.787 in (Tac.Check_Postcond' (pblID, (v, [(*assigned in next step*)])),
14.788 (Selem.e_istate, ctxt), (v,s))
14.789 end
14.790 - | _ => (Tac.End_Detail' (e_term,[])(*8.6.03*), (Selem.e_istate, ctxt), (v,s)))
14.791 - | Napp _ => (Tac.Empty_Tac_, (Selem.e_istate, ctxt), (e_term, Selem.Sundef)) (*helpless*)
14.792 + | _ => (Tac.End_Detail' (Celem.e_term,[])(*8.6.03*), (Selem.e_istate, ctxt), (v,s)))
14.793 + | Napp _ => (Tac.Empty_Tac_, (Selem.e_istate, ctxt), (Celem.e_term, Selem.Sundef)) (*helpless*)
14.794 | Appy (m', scrst as (_,_,_,v,_,_)) =>
14.795 (m', (Selem.ScrState scrst, ctxt), (v, Selem.Sundef))) (*next stac*)
14.796 | next_tac _ _ _ (is, _) = error ("next_tac: not impl for " ^ (Selem.istate2str is));
14.797 @@ -1067,28 +1067,28 @@
14.798 val errmsg = "ERROR: found no actual arguments for prog. of "
14.799 fun msg_miss (sc, metID, formals, actuals) =
14.800 "ERROR in creating the environment for '" ^ id_of_scr sc ^
14.801 - "' from \nthe items of the guard of " ^ metID2str metID ^ ",\n" ^
14.802 + "' from \nthe items of the guard of " ^ Celem.metID2str metID ^ ",\n" ^
14.803 "formal arg(s), from the script, miss actual arg(s), from the guards LTool.env:\n" ^
14.804 - (string_of_int o length) formals ^ " formals: " ^ terms2str formals ^ "\n" ^
14.805 - (string_of_int o length) actuals ^ " actuals: " ^ terms2str actuals
14.806 + (string_of_int o length) formals ^ " formals: " ^ Celem.terms2str formals ^ "\n" ^
14.807 + (string_of_int o length) actuals ^ " actuals: " ^ Celem.terms2str actuals
14.808 fun msg_type (sc, metID, a, f, formals, actuals) =
14.809 "ERROR in creating the environment for '" ^
14.810 id_of_scr sc ^ "' from \nthe items of the guard of " ^
14.811 - metID2str metID ^ ",\n" ^
14.812 + Celem.metID2str metID ^ ",\n" ^
14.813 "different types of formal arg, from the script, " ^
14.814 "and actual arg, from the guards LTool.env:'\n" ^
14.815 - "formal: '" ^ term2str a ^ "::" ^ (type2str o type_of) a ^ "'\n" ^
14.816 - "actual: '" ^ term2str f ^ "::" ^ (type2str o type_of) f ^ "'\n" ^
14.817 + "formal: '" ^ Celem.term2str a ^ "::" ^ (Celem.type2str o type_of) a ^ "'\n" ^
14.818 + "actual: '" ^ Celem.term2str f ^ "::" ^ (Celem.type2str o type_of) f ^ "'\n" ^
14.819 "in\n" ^
14.820 - "formals: " ^ terms2str formals ^ "\n" ^
14.821 - "actuals: " ^ terms2str actuals
14.822 + "formals: " ^ Celem.terms2str formals ^ "\n" ^
14.823 + "actuals: " ^ Celem.terms2str actuals
14.824 in
14.825 fun init_scrstate thy itms metID =
14.826 let
14.827 val actuals = itms2args thy metID itms
14.828 val _ = if actuals <> [] then () else raise ERROR (errmsg ^ strs2str' metID)
14.829 val (scr, sc) = (case (#scr o Specify.get_met) metID of
14.830 - scr as Prog sc => (scr, sc) | _ => raise ERROR ("init_scrstate with " ^ metID2str metID))
14.831 + scr as Celem.Prog sc => (scr, sc) | _ => raise ERROR ("init_scrstate with " ^ Celem.metID2str metID))
14.832 val formals = formal_args sc
14.833 (*expects same sequence of (actual) args in itms and (formal) args in met*)
14.834 fun relate_args env [] [] = env
14.835 @@ -1103,7 +1103,7 @@
14.836 val {pre, prls, ...} = Specify.get_met metID;
14.837 val pres = Stool.check_preconds thy prls pre itms |> map snd;
14.838 val ctxt = ctxt |> Stool.insert_assumptions pres;
14.839 - in (Selem.ScrState (env, [], NONE, e_term, Selem.Safe, true), ctxt, scr) end;
14.840 + in (Selem.ScrState (env, [], NONE, Celem.e_term, Selem.Safe, true), ctxt, scr) end;
14.841 end (*local*)
14.842
14.843 (* decide, where to get script/istate from:
14.844 @@ -1128,19 +1128,19 @@
14.845 val {srls,...} = Specify.get_met metID
14.846 in (srls, get_loc pt (p,p_), (#scr o Specify.get_met) metID) end
14.847 else (*FIXME.WN0?: get from pbl or met !!! unused for Rrls in locate_gen, next_tac*) (* 3 *)
14.848 - (e_rls, get_loc pt (p,p_),
14.849 + (Celem.e_rls, get_loc pt (p,p_),
14.850 case rls' of
14.851 - Rls {scr = scr,...} => scr
14.852 - | Seq {scr = scr,...} => scr
14.853 - | Rrls {scr=rfuns,...} => rfuns
14.854 - | Erls => error "from_pblobj_or_detail' with Erls")
14.855 + Celem.Rls {scr = scr,...} => scr
14.856 + | Celem.Seq {scr = scr,...} => scr
14.857 + | Celem.Rrls {scr=rfuns,...} => rfuns
14.858 + | Celem.Erls => error "from_pblobj_or_detail' with Erls")
14.859 end
14.860
14.861 (*.get script and istate from PblObj, see ( * 1 *)
14.862 fun from_pblobj' thy' (p,p_) pt =
14.863 let
14.864 val p' = par_pblobj pt p
14.865 - val thy = assoc_thy thy'
14.866 + val thy = Celem.assoc_thy thy'
14.867 val itms =
14.868 (case get_obj I pt p' of
14.869 PblObj {meth = itms, ...} => itms
14.870 @@ -1172,12 +1172,12 @@
14.871 else
14.872 let
14.873 val pp = par_pblobj pt p;
14.874 - val thy' = (get_obj g_domID pt pp):theory';
14.875 - val thy = assoc_thy thy';
14.876 + val thy' = get_obj g_domID pt pp;
14.877 + val thy = Celem.assoc_thy thy';
14.878 val metID = get_obj g_metID pt pp;
14.879 - val metID' = if metID =e_metID then (thd3 o snd3) (get_obj g_origin pt pp) else metID
14.880 + val metID' = if metID = Celem.e_metID then (thd3 o snd3) (get_obj g_origin pt pp) else metID
14.881 val (sc, srls) = (case Specify.get_met metID' of
14.882 - {scr = Prog sc, srls, ...} => (sc, srls) | _ => error "sel_rules 1")
14.883 + {scr = Celem.Prog sc, srls, ...} => (sc, srls) | _ => error "sel_rules 1")
14.884 val (env, a, v) = (case get_istate pt (p, p_) of
14.885 Selem.ScrState (env, _, a, v, _, _) => (env, a, v) | _ => error "sel_rules 2")
14.886 in map ((stac2tac pt thy) o LTool.rep_stacexpr o #2 o
14.887 @@ -1194,15 +1194,15 @@
14.888 else
14.889 let
14.890 val pp = par_pblobj pt p
14.891 - val thy' = (get_obj g_domID pt pp):theory'
14.892 - val thy = assoc_thy thy'
14.893 + val thy' = get_obj g_domID pt pp
14.894 + val thy = Celem.assoc_thy thy'
14.895 val metID = get_obj g_metID pt pp
14.896 val metID' =
14.897 - if metID = e_metID
14.898 + if metID = Celem.e_metID
14.899 then (thd3 o snd3) (get_obj g_origin pt pp)
14.900 else metID
14.901 val (sc, srls, erls, ro) = (case Specify.get_met metID' of
14.902 - {scr = Prog sc, srls, erls, rew_ord' = ro, ...} => (sc, srls, erls, ro)
14.903 + {scr = Celem.Prog sc, srls, erls, rew_ord' = ro, ...} => (sc, srls, erls, ro)
14.904 | _ => error "sel_appl_atomic_tacs 1")
14.905 val (env, a, v) = (case get_istate pt (p, p_) of
14.906 Selem.ScrState (env, _, a, v, _, _) => (env, a, v) | _ => error "sel_appl_atomic_tacs 2")
15.1 --- a/src/Tools/isac/Interpret/solve.sml Tue Mar 13 15:04:27 2018 +0100
15.2 +++ b/src/Tools/isac/Interpret/solve.sml Thu Mar 15 10:17:44 2018 +0100
15.3 @@ -121,7 +121,7 @@
15.4 PblObj {meth=itms, ...} => itms
15.5 | _ => error "solve Apply_Method: uncovered case get_obj"
15.6 val thy' = get_obj g_domID pt p;
15.7 - val thy = assoc_thy thy';
15.8 + val thy = Celem.assoc_thy thy';
15.9 val (is, env, ctxt, sc) = case Lucin.init_scrstate thy itms mI of
15.10 (is as Selem.ScrState (env,_,_,_,_,_), ctxt, sc) => (is, env, ctxt, sc)
15.11 | _ => error "solve Apply_Method: uncovered case init_scrstate"
15.12 @@ -139,13 +139,13 @@
15.13 | NONE => (*execute the first tac in the Script, compare solve m*)
15.14 let
15.15 val (m', (is', ctxt'), _) = Lucin.next_tac (thy', srls) (pt, (p, Res)) sc (is, ctxt);
15.16 - val d = e_rls (*FIXME: get simplifier from domID*);
15.17 + val d = Celem.e_rls (*FIXME: get simplifier from domID*);
15.18 in
15.19 case Lucin.locate_gen (thy',srls) m' (pt,(p, Res)) (sc,d) (is', ctxt') of
15.20 Lucin.Steps (_, ss as (_, _, pt', p', c') :: _) =>
15.21 ("ok", (map step2taci ss, c', (pt', p')))
15.22 | _ => (* NotLocatable *)
15.23 - let val (p, ps, _, pt) = Generate.generate_hard (assoc_thy "Isac") m (p, Frm) pt;
15.24 + let val (p, ps, _, pt) = Generate.generate_hard (Celem.assoc_thy "Isac") m (p, Frm) pt;
15.25 in
15.26 ("not-found-in-script",([(Lucin.tac_2tac m, m, (pos, (is, ctxt)))], ps, (pt, p)))
15.27 end
15.28 @@ -154,7 +154,7 @@
15.29 | solve ("Free_Solve", Tac.Free_Solve') (pt, po as (p, _)) =
15.30 let
15.31 val p' = lev_dn_ (p, Res);
15.32 - val pt = update_metID pt (par_pblobj pt p) e_metID;
15.33 + val pt = update_metID pt (par_pblobj pt p) Celem.e_metID;
15.34 in
15.35 ("ok", ([(Tac.Empty_Tac, Tac.Empty_Tac_, (po, (Selem.Uistate, Selem.e_ctxt)))], [], (pt,p')))
15.36 end
15.37 @@ -173,7 +173,7 @@
15.38 loc as (Selem.ScrState (E, l, a, _, _, b), ctxt) => (loc, E, l, a, b, ctxt)
15.39 | _ => error "solve Check_Postcond: uncovered case get_loc"
15.40 val thy' = get_obj g_domID pt pp;
15.41 - val thy = assoc_thy thy';
15.42 + val thy = Celem.assoc_thy thy';
15.43 val (_, _, (scval, scsaf)) = Lucin.next_tac (thy', srls) (pt, (p, p_)) sc loc;
15.44 in
15.45 if pp = []
15.46 @@ -187,7 +187,7 @@
15.47 let (*resume script of parpbl, transfer value of subpbl-script*)
15.48 val ppp = par_pblobj pt (lev_up p);
15.49 val thy' = get_obj g_domID pt ppp;
15.50 - val thy = assoc_thy thy';
15.51 + val thy = Celem.assoc_thy thy';
15.52 val (E, l, a, b, ctxt') = case get_loc pt (pp, Frm) of
15.53 (Selem.ScrState (E, l, a, _, _, b), ctxt') => (E, l, a, b, ctxt')
15.54 | _ => error "solve Check_Postcond resume script of parpbl: uncovered case get_loc"
15.55 @@ -206,11 +206,11 @@
15.56 ("ok", ([(Tac.End_Detail, Tac.End_Detail' t , ((p, p_), get_loc pt (p, p_)))], [], (pt, pr)))
15.57 end
15.58 | solve (_, m) (pt, po as (p, p_)) =
15.59 - if e_metID = get_obj g_metID pt (par_pblobj pt p) (*29.8.02: could be detail, too !!*)
15.60 + if Celem.e_metID = get_obj g_metID pt (par_pblobj pt p) (*29.8.02: could be detail, too !!*)
15.61 then
15.62 let
15.63 val ctxt = get_ctxt pt po
15.64 - val ((p,p_),ps,_,pt) = Generate.generate1 (assoc_thy (get_obj g_domID pt (par_pblobj pt p)))
15.65 + val ((p,p_),ps,_,pt) = Generate.generate1 (Celem.assoc_thy (get_obj g_domID pt (par_pblobj pt p)))
15.66 m (Selem.e_istate, ctxt) (p, p_) pt;
15.67 in ("no-method-specified", (*Free_Solve*)
15.68 ([(Tac.Empty_Tac, Tac.Empty_Tac_, ((p, p_), (Selem.Uistate, ctxt)))], ps, (pt, (p, p_))))
15.69 @@ -219,7 +219,7 @@
15.70 let
15.71 val thy' = get_obj g_domID pt (par_pblobj pt p);
15.72 val (srls, is, sc) = Lucin.from_pblobj_or_detail' thy' (p,p_) pt;
15.73 - val d = e_rls; (*FIXME.WN0108: canon.simplifier for domain is missing: generate from domID?*)
15.74 + val d = Celem.e_rls; (*FIXME.WN0108: canon.simplifier for domain is missing: generate from domID?*)
15.75 in
15.76 case Lucin.locate_gen (thy',srls) m (pt,(p, p_)) (sc,d) is of
15.77 Lucin.Steps (_, ss as (_, _, pt', p', c') :: _) =>
15.78 @@ -227,7 +227,7 @@
15.79 (*27.8.02:next_tac may change to other branches in pt FIXXXXME*)
15.80 | _ => (* NotLocatable *)
15.81 let
15.82 - val (p,ps, _, pt) = Generate.generate_hard (assoc_thy "Isac") m (p, p_) pt;
15.83 + val (p,ps, _, pt) = Generate.generate_hard (Celem.assoc_thy "Isac") m (p, p_) pt;
15.84 in
15.85 ("not-found-in-script", ([(Lucin.tac_2tac m, m, (po, is))], ps, (pt, p)))
15.86 end
15.87 @@ -243,7 +243,7 @@
15.88 | _ => error "nxt_solv Apply_Method': uncovered case get_obj"
15.89 val itms = if itms <> [] then itms else Chead.complete_metitms oris probl [] ppc
15.90 val thy' = get_obj g_domID pt p;
15.91 - val thy = assoc_thy thy';
15.92 + val thy = Celem.assoc_thy thy';
15.93 val (is, env, ctxt, scr) = case Lucin.init_scrstate thy itms mI of
15.94 (is as Selem.ScrState (env,_,_,_,_,_), ctxt, scr) => (is, env, ctxt, scr)
15.95 | _ => error "nxt_solv Apply_Method': uncovered case init_scrstate"
15.96 @@ -279,7 +279,7 @@
15.97 loc as (Selem.ScrState (E,l,a,_,_,b), ctxt) => (loc, E, l, a, b, ctxt)
15.98 | _ => error "nxt_solv Check_Postcond': uncovered case get_loc"
15.99 val thy' = get_obj g_domID pt pp;
15.100 - val thy = assoc_thy thy';
15.101 + val thy = Celem.assoc_thy thy';
15.102 val (_, _, (scval, scsaf)) = Lucin.next_tac (thy', srls) (pt, (p, p_)) sc loc;
15.103 in
15.104 if pp = []
15.105 @@ -293,7 +293,7 @@
15.106 let (*resume script of parpbl, transfer value of subpbl-script*)
15.107 val ppp = par_pblobj pt (lev_up p);
15.108 val thy' = get_obj g_domID pt ppp;
15.109 - val thy = assoc_thy thy';
15.110 + val thy = Celem.assoc_thy thy';
15.111 val (E, l, a, b, ctxt') = case get_loc pt (pp, Frm) of
15.112 (Selem.ScrState (E,l,a,_,_,b), ctxt') => (E, l, a, b, ctxt')
15.113 | _ => error "nxt_solv Check_Postcond' script of parpbl: uncovered case get_loc"
15.114 @@ -310,13 +310,13 @@
15.115 (p, Met) => ((lev_on o lev_dn) p, Frm) (* begin script *)
15.116 | (p, Res) => (lev_on p, Res) (* somewhere in script *)
15.117 | _ => pos
15.118 - val (pos', c, _, pt) = Generate.generate1 (assoc_thy "Isac") tac_ is pos pt;
15.119 + val (pos', c, _, pt) = Generate.generate1 (Celem.assoc_thy "Isac") tac_ is pos pt;
15.120 in
15.121 ([(Lucin.tac_2tac tac_, tac_, (pos, is))], c, (pt, pos'))
15.122 end
15.123 (* find the next tac from the script, nxt_solv will update the ctree *)
15.124 and nxt_solve_ (ptp as (pt, pos as (p, p_))) =
15.125 - if e_metID = get_obj g_metID pt (par_pblobj pt p)
15.126 + if Celem.e_metID = get_obj g_metID pt (par_pblobj pt p)
15.127 then ([], [], (pt, (p, p_)))
15.128 else
15.129 let
15.130 @@ -403,7 +403,7 @@
15.131 val ctxt = get_ctxt pt pos
15.132 in
15.133 case rls of
15.134 - Rrls {scr = Rfuns {init_state,...},...} =>
15.135 + Celem.Rrls {scr = Celem.Rfuns {init_state,...},...} =>
15.136 let
15.137 val (_, _, _, rul_terms) = init_state t
15.138 val newnds = rul_terms_2nds (Proof_Context.theory_of ctxt) [] t rul_terms
15.139 @@ -414,9 +414,9 @@
15.140 val is = Generate.init_istate tac t
15.141 (*TODO.WN060602 ScrState (["(t_, Problem (Isac,[equation,univar]))"]
15.142 is wrong for simpl, but working ?!? *)
15.143 - val tac_ = Tac.Apply_Method' (e_metID(*WN0402: see generate1 !?!*), SOME t, is, ctxt)
15.144 + val tac_ = Tac.Apply_Method' (Celem.e_metID(*WN0402: see generate1 !?!*), SOME t, is, ctxt)
15.145 val pos' = ((lev_on o lev_dn) p, Frm)
15.146 - val thy = assoc_thy "Isac"
15.147 + val thy = Celem.assoc_thy "Isac"
15.148 val (_, _, _, pt') = Generate.generate1 thy tac_ (is, ctxt) pos' pt (* implicit Take *)
15.149 val (_,_, (pt'', _)) = complete_solve CompleteSubpbl [] (pt', pos')
15.150 val newnds = children (get_nd pt'' p)
16.1 --- a/src/Tools/isac/Interpret/specification-elems.sml Tue Mar 13 15:04:27 2018 +0100
16.2 +++ b/src/Tools/isac/Interpret/specification-elems.sml Thu Mar 15 10:17:44 2018 +0100
16.3 @@ -13,20 +13,20 @@
16.4 datatype safe = Sundef | Safe | Unsafe | Helpless;
16.5 val safe2str : safe -> string
16.6 type scrstate
16.7 - datatype istate = RrlsState of rrlsstate | ScrState of scrstate | Uistate
16.8 + datatype istate = RrlsState of Celem.rrlsstate | ScrState of scrstate | Uistate
16.9 val istate2str : istate -> string
16.10 val e_istate : istate
16.11 type subs
16.12 type sube
16.13 type subte
16.14 - val sube2str : cterm' list -> string
16.15 - val sube2subst : theory -> cterm' list -> (term * term) list
16.16 - val sube2subte : cterm' list -> term list
16.17 - val subs2subst : theory -> cterm' list -> (term * term) list
16.18 - val subst2sube : (term * term) list -> cterm' list (* for datatypes.sml *)
16.19 - val subst2subs : (term * term) list -> cterm' list
16.20 + val sube2str : Celem.cterm' list -> string
16.21 + val sube2subst : theory -> Celem.cterm' list -> (term * term) list
16.22 + val sube2subte : Celem.cterm' list -> term list
16.23 + val subs2subst : theory -> Celem.cterm' list -> (term * term) list
16.24 + val subst2sube : (term * term) list -> Celem.cterm' list (* for datatypes.sml *)
16.25 + val subst2subs : (term * term) list -> Celem.cterm' list
16.26 val subst2subs' : (term * term) list -> (string * string) list
16.27 - val subte2sube : term list -> cterm' list
16.28 + val subte2sube : term list -> Celem.cterm' list
16.29 val e_ctxt : Proof.context
16.30 (*----- needed for tac, tac_ immediately (probably pre-requisites missing)
16.31 type istate
16.32 @@ -35,10 +35,10 @@
16.33 type sube
16.34 *)
16.35 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
16.36 - val e_fmz : fmz_ * spec (* for datatypes.sml *)
16.37 - val e_sube : cterm' list
16.38 + val e_fmz : fmz_ * Celem.spec (* for datatypes.sml *)
16.39 + val e_sube : Celem.cterm' list
16.40 val e_subs : string list
16.41 - val scrstate2str : subst * loc_ * term option * term * safe * bool -> string
16.42 + val scrstate2str : Celem.subst * Celem.loc_ * term option * term * safe * bool -> string
16.43 val istates2str : istate option * istate option -> string
16.44 val subte2subst : term list -> (term * term) list
16.45 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
16.46 @@ -53,15 +53,15 @@
16.47 structure Selem(**): SPECIFY_ELEMENT(**) =
16.48 struct
16.49
16.50 -type fmz_ = cterm' list;
16.51 +type fmz_ = Celem.cterm' list;
16.52 (* a formalization of an example containing data
16.53 sufficient for mechanically finding the solution for the example
16.54 FIXME.WN051014: dont store fmz = (_,spec) in the PblObj, this is done in origin *)
16.55 -type fmz = fmz_ * spec;
16.56 -val e_fmz = ([], e_spec);
16.57 +type fmz = fmz_ * Celem.spec;
16.58 +val e_fmz = ([], Celem.e_spec);
16.59
16.60 type result = term * term list
16.61 -fun res2str (t, ts) = pair2str (term2str t, terms2str ts); (* for tests only *)
16.62 +fun res2str (t, ts) = pair2str (Celem.term2str t, Celem.terms2str ts); (* for tests only *)
16.63
16.64 datatype safe = Sundef | Safe | Unsafe | Helpless;
16.65 fun safe2str Sundef = "Sundef"
16.66 @@ -72,7 +72,7 @@
16.67 type scrstate = (* state for script interpreter *)
16.68 LTool.env(*stack*) (* used to instantiate tac for checking assod
16.69 12.03.noticed: e_ not updated during execution ?!? *)
16.70 - * loc_ (* location of tac in script *)
16.71 + * Celem.loc_ (* location of tac in script *)
16.72 * term option (* argument of curried functions *)
16.73 * term (* value obtained by tac executed
16.74 updated also after a derivation by 'new_val' *)
16.75 @@ -80,48 +80,48 @@
16.76 * bool; (* true = strongly .., false = weakly associated:
16.77 only used during ass_dn/up *)
16.78 fun topt2str NONE = "NONE"
16.79 - | topt2str (SOME t) = "SOME" ^ term2str t;
16.80 + | topt2str (SOME t) = "SOME" ^ Celem.term2str t;
16.81 fun scrstate2str (env, loc_, topt, t, safe, bool) = (* for tests only *)
16.82 - "(" ^ env2str env ^ ", " ^ loc_2str loc_ ^ ", " ^ topt2str topt ^ ", \n" ^
16.83 - term2str t ^ ", " ^ safe2str safe ^ ", " ^ bool2str bool ^ ")";
16.84 + "(" ^ Celem.env2str env ^ ", " ^ Celem.loc_2str loc_ ^ ", " ^ topt2str topt ^ ", \n" ^
16.85 + Celem.term2str t ^ ", " ^ safe2str safe ^ ", " ^ bool2str bool ^ ")";
16.86
16.87 (* for handling type istate see fun from_pblobj_or_detail', +? *)
16.88 -datatype istate = (*interpreter state*)
16.89 - Uistate (*undefined in modspec, in '_deriv'ation*)
16.90 - | ScrState of scrstate (*for script interpreter*)
16.91 - | RrlsState of rrlsstate; (*for reverse rewriting*)
16.92 -val e_istate = (ScrState ([], [], NONE, e_term, Sundef, false));
16.93 +datatype istate = (*interpreter state*)
16.94 + Uistate (*undefined in modspec, in '_deriv'ation*)
16.95 + | ScrState of scrstate (*for script interpreter*)
16.96 + | RrlsState of Celem.rrlsstate; (*for reverse rewriting*)
16.97 +val e_istate = (ScrState ([], [], NONE, Celem.e_term, Sundef, false));
16.98
16.99 -fun rta2str (r, (t, a)) = "\n(" ^ rule2str r ^ ",(" ^ term2str t ^", " ^ terms2str a ^ "))";
16.100 +fun rta2str (r, (t, a)) = "\n(" ^ Celem.rule2str r ^ ",(" ^ Celem.term2str t ^", " ^ Celem.terms2str a ^ "))";
16.101 fun istate2str Uistate = "Uistate"
16.102 | istate2str (ScrState (e, l, to, t, s, b)) =
16.103 - "ScrState ("^ subst2str e ^ ",\n " ^
16.104 - loc_2str l ^ ", " ^ termopt2str to ^ ",\n " ^
16.105 - term2str t ^ ", " ^ safe2str s ^ ", " ^ bool2str b ^ ")"
16.106 + "ScrState ("^ Celem.subst2str e ^ ",\n " ^
16.107 + Celem.loc_2str l ^ ", " ^ Celem.termopt2str to ^ ",\n " ^
16.108 + Celem.term2str t ^ ", " ^ safe2str s ^ ", " ^ bool2str b ^ ")"
16.109 | istate2str (RrlsState (t, t1, rss, rtas)) =
16.110 - "RrlsState (" ^ term2str t ^ ", " ^ term2str t1 ^ ", " ^
16.111 - (strs2str o (map (strs2str o (map rule2str)))) rss ^ ", " ^
16.112 + "RrlsState (" ^ Celem.term2str t ^ ", " ^ Celem.term2str t1 ^ ", " ^
16.113 + (strs2str o (map (strs2str o (map Celem.rule2str)))) rss ^ ", " ^
16.114 (strs2str o (map rta2str)) rtas ^ ")";
16.115 fun istates2str (NONE, NONE) = "(#NONE, #NONE)" (* for tests only *)
16.116 | istates2str (NONE, SOME ist) = "(#NONE,\n#SOME " ^ istate2str ist ^ ")"
16.117 | istates2str (SOME ist, NONE) = "(#SOME " ^ istate2str ist ^ ",\n #NONE)"
16.118 | istates2str (SOME i1, SOME i2) = "(#SOME " ^ istate2str i1 ^ ",\n #SOME " ^ istate2str i2 ^ ")";
16.119
16.120 -type subs = cterm' list; (*16.11.00 for FE-KE*)
16.121 +type subs = Celem.cterm' list; (*16.11.00 for FE-KE*)
16.122 val e_subs = ["(bdv, x)"]; (* for tests only *)
16.123
16.124 (* argument type of tac Rewrite_Inst *)
16.125 -type sube = cterm' list;
16.126 -val e_sube = []: cterm' list; (* for tests only *)
16.127 +type sube = Celem.cterm' list;
16.128 +val e_sube = []: Celem.cterm' list; (* for tests only *)
16.129 fun sube2str s = strs2str s;
16.130
16.131 (* _sub_stitution as _t_erms of _e_qualities *)
16.132 type subte = term list;
16.133
16.134 -val subte2sube = map term2str;
16.135 -val subst2subs = map (pair2str o (apfst term2str) o (apsnd term2str));
16.136 -fun subst2sube subst = map term2str (map HOLogic.mk_eq subst)
16.137 -val subst2subs' = map ((apfst term2str) o (apsnd term2str));
16.138 +val subte2sube = map Celem.term2str;
16.139 +val subst2subs = map (pair2str o (apfst Celem.term2str) o (apsnd Celem.term2str));
16.140 +fun subst2sube subst = map Celem.term2str (map HOLogic.mk_eq subst)
16.141 +val subst2subs' = map ((apfst Celem.term2str) o (apsnd Celem.term2str));
16.142 fun subs2subst thy s = map (TermC.isapair2pair o (TermC.parse_patt thy)) s;
16.143 fun sube2subst thy s = map (TermC.dest_equals o (TermC.parse_patt thy)) s;
16.144 val sube2subte = map TermC.str2term;
17.1 --- a/src/Tools/isac/Interpret/tactic.sml Tue Mar 13 15:04:27 2018 +0100
17.2 +++ b/src/Tools/isac/Interpret/tactic.sml Thu Mar 15 10:17:44 2018 +0100
17.3 @@ -10,10 +10,10 @@
17.4 signature TACTIC =
17.5 sig
17.6 datatype tac_ =
17.7 - Add_Find' of cterm' * Model.itm list | Add_Given' of cterm' * Model.itm list
17.8 - | Add_Relation' of cterm' * Model.itm list
17.9 + Add_Find' of Celem.cterm' * Model.itm list | Add_Given' of Celem.cterm' * Model.itm list
17.10 + | Add_Relation' of Celem.cterm' * Model.itm list
17.11 | Apply_Assumption' of term list * term
17.12 - | Apply_Method' of metID * term option * Selem.istate * Proof.context
17.13 + | Apply_Method' of Celem.metID * term option * Selem.istate * Proof.context
17.14
17.15 | Begin_Sequ' | Begin_Trans' of term
17.16 | Split_And' of term | Split_Or' of term | Split_Intersect' of term
17.17 @@ -22,44 +22,44 @@
17.18 | End_Ruleset' of term | End_Subproblem' of term | End_Intersect' of term | End_Proof''
17.19
17.20 | CAScmd' of term
17.21 - | Calculate' of theory' * string * term * (term * thm')
17.22 - | Check_Postcond' of pblID * Selem.result
17.23 - | Check_elementwise' of term * cterm' * Selem.result
17.24 - | Del_Find' of cterm' | Del_Given' of cterm' | Del_Relation' of cterm'
17.25 + | Calculate' of Celem.theory' * string * term * (term * Celem.thm')
17.26 + | Check_Postcond' of Celem.pblID * Selem.result
17.27 + | Check_elementwise' of term * Celem.cterm' * Selem.result
17.28 + | Del_Find' of Celem.cterm' | Del_Given' of Celem.cterm' | Del_Relation' of Celem.cterm'
17.29
17.30 - | Derive' of rls
17.31 - | Detail_Set' of theory' * bool * rls * term * Selem.result
17.32 - | Detail_Set_Inst' of theory' * bool * subst * rls * term * Selem.result
17.33 + | Derive' of Celem.rls
17.34 + | Detail_Set' of Celem.theory' * bool * Celem.rls * term * Selem.result
17.35 + | Detail_Set_Inst' of Celem.theory' * bool * Celem.subst * Celem.rls * term * Selem.result
17.36 | End_Detail' of Selem.result
17.37
17.38 | Empty_Tac_
17.39 | Free_Solve'
17.40
17.41 - | Init_Proof' of cterm' list * spec
17.42 - | Model_Problem' of pblID * Model.itm list * Model.itm list
17.43 + | Init_Proof' of Celem.cterm' list * Celem.spec
17.44 + | Model_Problem' of Celem.pblID * Model.itm list * Model.itm list
17.45 | Or_to_List' of term * term
17.46 - | Refine_Problem' of pblID * (Model.itm list * (bool * term) list)
17.47 - | Refine_Tacitly' of pblID * pblID * domID * metID * Model.itm list
17.48 + | Refine_Problem' of Celem.pblID * (Model.itm list * (bool * term) list)
17.49 + | Refine_Tacitly' of Celem.pblID * Celem.pblID * Celem.domID * Celem.metID * Model.itm list
17.50
17.51 - | Rewrite' of theory' * rew_ord' * rls * bool * thm'' * term * Selem.result
17.52 - | Rewrite_Asm' of theory' * rew_ord' * rls * bool * thm'' * term * Selem.result
17.53 - | Rewrite_Inst' of theory' * rew_ord' * rls * bool * subst * thm'' * term * Selem.result
17.54 - | Rewrite_Set' of theory' * bool * rls * term * Selem.result
17.55 - | Rewrite_Set_Inst' of theory' * bool * subst * rls * term * Selem.result
17.56 + | Rewrite' of Celem.theory' * Celem.rew_ord' * Celem.rls * bool * Celem.thm'' * term * Selem.result
17.57 + | Rewrite_Asm' of Celem.theory' * Celem.rew_ord' * Celem.rls * bool * Celem.thm'' * term * Selem.result
17.58 + | Rewrite_Inst' of Celem.theory' * Celem.rew_ord' * Celem.rls * bool * Celem.subst * Celem.thm'' * term * Selem.result
17.59 + | Rewrite_Set' of Celem.theory' * bool * Celem.rls * term * Selem.result
17.60 + | Rewrite_Set_Inst' of Celem.theory' * bool * Celem.subst * Celem.rls * term * Selem.result
17.61
17.62 - | Specify_Method' of metID * Model.ori list * Model.itm list
17.63 - | Specify_Problem' of pblID * (bool * (Model.itm list * (bool * term) list))
17.64 - | Specify_Theory' of domID
17.65 - | Subproblem' of spec * Model.ori list * term * Selem.fmz_ * Proof.context * term
17.66 - | Substitute' of rew_ord_ * rls * Selem.subte * term * term
17.67 + | Specify_Method' of Celem.metID * Model.ori list * Model.itm list
17.68 + | Specify_Problem' of Celem.pblID * (bool * (Model.itm list * (bool * term) list))
17.69 + | Specify_Theory' of Celem.domID
17.70 + | Subproblem' of Celem.spec * Model.ori list * term * Selem.fmz_ * Proof.context * term
17.71 + | Substitute' of Celem.rew_ord_ * Celem.rls * Selem.subte * term * term
17.72 | Tac_ of theory * string * string * string
17.73 | Take' of term | Take_Inst' of term
17.74 val tac_2str : tac_ -> string
17.75
17.76 datatype tac =
17.77 - Add_Find of cterm' | Add_Given of cterm' | Add_Relation of cterm'
17.78 - | Apply_Assumption of cterm' list
17.79 - | Apply_Method of metID
17.80 + Add_Find of Celem.cterm' | Add_Given of Celem.cterm' | Add_Relation of Celem.cterm'
17.81 + | Apply_Assumption of Celem.cterm' list
17.82 + | Apply_Method of Celem.metID
17.83 (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
17.84 | Begin_Sequ | Begin_Trans
17.85 | Split_And | Split_Or | Split_Intersect
17.86 @@ -67,49 +67,49 @@
17.87 | End_Sequ | End_Trans
17.88 | End_Ruleset | End_Subproblem | End_Intersect | End_Proof'
17.89 (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
17.90 - | CAScmd of cterm'
17.91 + | CAScmd of Celem.cterm'
17.92 | Calculate of string
17.93 - | Check_Postcond of pblID
17.94 - | Check_elementwise of cterm'
17.95 - | Del_Find of cterm' | Del_Given of cterm' | Del_Relation of cterm'
17.96 + | Check_Postcond of Celem.pblID
17.97 + | Check_elementwise of Celem.cterm'
17.98 + | Del_Find of Celem.cterm' | Del_Given of Celem.cterm' | Del_Relation of Celem.cterm'
17.99
17.100 - | Derive of rls'
17.101 - | Detail_Set of rls'
17.102 - | Detail_Set_Inst of Selem.subs * rls'
17.103 + | Derive of Celem.rls'
17.104 + | Detail_Set of Celem.rls'
17.105 + | Detail_Set_Inst of Selem.subs * Celem.rls'
17.106 | End_Detail
17.107
17.108 | Empty_Tac
17.109 | Free_Solve
17.110
17.111 - | Init_Proof of cterm' list * spec
17.112 + | Init_Proof of Celem.cterm' list * Celem.spec
17.113 | Model_Problem
17.114 | Or_to_List
17.115 - | Refine_Problem of pblID
17.116 - | Refine_Tacitly of pblID
17.117 + | Refine_Problem of Celem.pblID
17.118 + | Refine_Tacitly of Celem.pblID
17.119
17.120 - | Rewrite of thm''
17.121 - | Rewrite_Asm of thm''
17.122 - | Rewrite_Inst of Selem.subs * thm''
17.123 - | Rewrite_Set of rls'
17.124 - | Rewrite_Set_Inst of Selem.subs * rls'
17.125 + | Rewrite of Celem.thm''
17.126 + | Rewrite_Asm of Celem.thm''
17.127 + | Rewrite_Inst of Selem.subs * Celem.thm''
17.128 + | Rewrite_Set of Celem.rls'
17.129 + | Rewrite_Set_Inst of Selem.subs * Celem.rls'
17.130
17.131 - | Specify_Method of metID
17.132 - | Specify_Problem of pblID
17.133 - | Specify_Theory of domID
17.134 - | Subproblem of domID * pblID
17.135 + | Specify_Method of Celem.metID
17.136 + | Specify_Problem of Celem.pblID
17.137 + | Specify_Theory of Celem.domID
17.138 + | Subproblem of Celem.domID * Celem.pblID
17.139
17.140 | Substitute of Selem.sube
17.141 | Tac of string
17.142 - | Take of cterm' | Take_Inst of cterm'
17.143 + | Take of Celem.cterm' | Take_Inst of Celem.cterm'
17.144 val tac2str : tac -> string
17.145
17.146 val eq_tac : tac * tac -> bool (* for script.sml *)
17.147 val is_empty_tac : tac -> bool (* also for tests *)
17.148 val is_rewtac : tac -> bool (* for interface.sml *)
17.149 val is_rewset : tac -> bool (* for mathengine.sml *)
17.150 - val rls_of : tac -> rls' (* for solve.sml *)
17.151 + val rls_of : tac -> Celem.rls' (* for solve.sml *)
17.152 val tac2IDstr : tac -> string
17.153 - val rule2tac : theory -> (term * term) list -> rule -> tac (* for rewtools.sml *)
17.154 + val rule2tac : theory -> (term * term) list -> Celem.rule -> tac (* for rewtools.sml *)
17.155 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
17.156 (* NONE *)
17.157 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
17.158 @@ -133,9 +133,9 @@
17.159 TODO.WN161219: replace *every* cterm' by term
17.160 *)
17.161 datatype tac =
17.162 - Add_Find of cterm' | Add_Given of cterm' | Add_Relation of cterm'
17.163 - | Apply_Assumption of cterm' list
17.164 - | Apply_Method of metID
17.165 + Add_Find of Celem.cterm' | Add_Given of Celem.cterm' | Add_Relation of Celem.cterm'
17.166 + | Apply_Assumption of Celem.cterm' list
17.167 + | Apply_Method of Celem.metID
17.168 (* creates an "istate" in PblObj.env; in case of "init_form"
17.169 creates a formula at ((lev_on o lev_dn) p, Frm) and in this "ppobj.loc"
17.170 a "SOME istate" at fst of "loc".
17.171 @@ -148,48 +148,48 @@
17.172 | End_Sequ | End_Trans
17.173 | End_Ruleset | End_Subproblem (* WN0509 drop *) | End_Intersect | End_Proof'
17.174 (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
17.175 - | CAScmd of cterm'
17.176 + | CAScmd of Celem.cterm'
17.177 | Calculate of string
17.178 - | Check_Postcond of pblID
17.179 - | Check_elementwise of cterm'
17.180 - | Del_Find of cterm' | Del_Given of cterm' | Del_Relation of cterm'
17.181 + | Check_Postcond of Celem.pblID
17.182 + | Check_elementwise of Celem.cterm'
17.183 + | Del_Find of Celem.cterm' | Del_Given of Celem.cterm' | Del_Relation of Celem.cterm'
17.184
17.185 - | Derive of rls' (* WN0509 drop *)
17.186 - | Detail_Set of rls' (* WN0509 drop *)
17.187 - | Detail_Set_Inst of Selem.subs * rls' (* WN0509 drop *)
17.188 + | Derive of Celem.rls' (* WN0509 drop *)
17.189 + | Detail_Set of Celem.rls' (* WN0509 drop *)
17.190 + | Detail_Set_Inst of Selem.subs * Celem.rls' (* WN0509 drop *)
17.191 | End_Detail (* WN0509 drop *)
17.192
17.193 | Empty_Tac
17.194 | Free_Solve
17.195
17.196 - | Init_Proof of cterm' list * spec
17.197 + | Init_Proof of Celem.cterm' list * Celem.spec
17.198 | Model_Problem
17.199 | Or_to_List
17.200 - | Refine_Problem of pblID
17.201 - | Refine_Tacitly of pblID
17.202 + | Refine_Problem of Celem.pblID
17.203 + | Refine_Tacitly of Celem.pblID
17.204
17.205 (* rewrite-tactics can transport a (thmID, thm) to and (!) from the java-front-end
17.206 because there all the thms are present with both (thmID, thm)
17.207 (where user-views can show both or only one of (thmID, thm)),
17.208 and thm is created from ThmID by assoc_thm'' when entering isabisac *)
17.209 - | Rewrite of thm''
17.210 - | Rewrite_Asm of thm''
17.211 - | Rewrite_Inst of Selem.subs * thm''
17.212 - | Rewrite_Set of rls'
17.213 - | Rewrite_Set_Inst of Selem.subs * rls'
17.214 + | Rewrite of Celem.thm''
17.215 + | Rewrite_Asm of Celem.thm''
17.216 + | Rewrite_Inst of Selem.subs * Celem.thm''
17.217 + | Rewrite_Set of Celem.rls'
17.218 + | Rewrite_Set_Inst of Selem.subs * Celem.rls'
17.219
17.220 - | Specify_Method of metID
17.221 - | Specify_Problem of pblID
17.222 - | Specify_Theory of domID
17.223 - | Subproblem of domID * pblID (* WN0509 drop *)
17.224 + | Specify_Method of Celem.metID
17.225 + | Specify_Problem of Celem.pblID
17.226 + | Specify_Theory of Celem.domID
17.227 + | Subproblem of Celem.domID * Celem.pblID (* WN0509 drop *)
17.228
17.229 | Substitute of Selem.sube
17.230 | Tac of string (* WN0509 drop *)
17.231 - | Take of cterm' | Take_Inst of cterm'
17.232 + | Take of Celem.cterm' | Take_Inst of Celem.cterm'
17.233
17.234 fun tac2str ma = case ma of
17.235 Init_Proof (ppc, spec) =>
17.236 - "Init_Proof "^(pair2str (strs2str ppc, spec2str spec))
17.237 + "Init_Proof "^(pair2str (strs2str ppc, Celem.spec2str spec))
17.238 | Model_Problem => "Model_Problem "
17.239 | Refine_Tacitly pblID => "Refine_Tacitly " ^ strs2str pblID
17.240 | Refine_Problem pblID => "Refine_Problem " ^ strs2str pblID
17.241 @@ -208,9 +208,9 @@
17.242 | Free_Solve => "Free_Solve"
17.243
17.244 | Rewrite_Inst (subs, (id, thm)) =>
17.245 - "Rewrite_Inst " ^ (pair2str (subs2str subs, spair2str (id, thm |> Thm.prop_of |> term2str)))
17.246 - | Rewrite (id, thm) => "Rewrite " ^ spair2str (id, thm |> Thm.prop_of |> term2str)
17.247 - | Rewrite_Asm (id, thm) => "Rewrite_Asm " ^ spair2str (id, thm |> Thm.prop_of |> term2str)
17.248 + "Rewrite_Inst " ^ (pair2str (subs2str subs, spair2str (id, thm |> Thm.prop_of |> Celem.term2str)))
17.249 + | Rewrite (id, thm) => "Rewrite " ^ spair2str (id, thm |> Thm.prop_of |> Celem.term2str)
17.250 + | Rewrite_Asm (id, thm) => "Rewrite_Asm " ^ spair2str (id, thm |> Thm.prop_of |> Celem.term2str)
17.251 | Rewrite_Set_Inst (subs, rls) =>
17.252 "Rewrite_Set_Inst " ^ pair2str (subs2str subs, quote rls)
17.253 | Rewrite_Set rls => "Rewrite_Set " ^ quote rls
17.254 @@ -303,15 +303,15 @@
17.255 | rls_of (Rewrite_Set rls) = rls
17.256 | rls_of tac = error ("rls_of: called with tac \"" ^ tac2IDstr tac ^ "\"");
17.257
17.258 -fun rule2tac thy _ (Calc (opID, _)) = Calculate (assoc_calc thy opID)
17.259 - | rule2tac _ [] (Thm thm'') = Rewrite thm''
17.260 - | rule2tac _ subst (Thm thm'') =
17.261 +fun rule2tac thy _ (Celem.Calc (opID, _)) = Calculate (assoc_calc thy opID)
17.262 + | rule2tac _ [] (Celem.Thm thm'') = Rewrite thm''
17.263 + | rule2tac _ subst (Celem.Thm thm'') =
17.264 Rewrite_Inst (Selem.subst2subs subst, thm'')
17.265 - | rule2tac _ [] (Rls_ rls) = Rewrite_Set (id_rls rls)
17.266 - | rule2tac _ subst (Rls_ rls) =
17.267 - Rewrite_Set_Inst (Selem.subst2subs subst, (id_rls rls))
17.268 + | rule2tac _ [] (Celem.Rls_ rls) = Rewrite_Set (Celem.id_rls rls)
17.269 + | rule2tac _ subst (Celem.Rls_ rls) =
17.270 + Rewrite_Set_Inst (Selem.subst2subs subst, (Celem.id_rls rls))
17.271 | rule2tac _ _ rule =
17.272 - error ("rule2tac: called with \"" ^ rule2str rule ^ "\"");
17.273 + error ("rule2tac: called with \"" ^ Celem.rule2str rule ^ "\"");
17.274
17.275 (* tactics for for internal use, compare "tac" for user at the front-end.
17.276 tac_ contains results from check in 'fun applicable_in'.
17.277 @@ -327,10 +327,10 @@
17.278 TODO.WN161219: replace *every* cterm' by term
17.279 *)
17.280 datatype tac_ =
17.281 - Add_Find' of cterm' * Model.itm list | Add_Given' of cterm' * Model.itm list
17.282 - | Add_Relation' of cterm' * Model.itm list
17.283 + Add_Find' of Celem.cterm' * Model.itm list | Add_Given' of Celem.cterm' * Model.itm list
17.284 + | Add_Relation' of Celem.cterm' * Model.itm list
17.285 | Apply_Assumption' of term list * term
17.286 - | Apply_Method' of metID * term option * Selem.istate * Proof.context
17.287 + | Apply_Method' of Celem.metID * term option * Selem.istate * Proof.context
17.288 (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
17.289 | Begin_Sequ' | Begin_Trans' of term
17.290 | Split_And' of term | Split_Or' of term | Split_Intersect' of term
17.291 @@ -339,65 +339,65 @@
17.292 | End_Ruleset' of term | End_Subproblem' of term | End_Intersect' of term | End_Proof''
17.293 (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
17.294 | CAScmd' of term
17.295 - | Calculate' of theory' * string * term * (term * thm')
17.296 - | Check_Postcond' of pblID *
17.297 + | Calculate' of Celem.theory' * string * term * (term * Celem.thm')
17.298 + | Check_Postcond' of Celem.pblID *
17.299 Selem.result (* returnvalue of script in solve *)
17.300 | Check_elementwise' of (*special case:*)
17.301 term * (* (1) the current formula: [x=1,x=...] *)
17.302 string * (* (2) the pred from Check_elementwise *)
17.303 Selem.result (* (3) composed from (1) and (2): {x. pred} *)
17.304 - | Del_Find' of cterm' | Del_Given' of cterm' | Del_Relation' of cterm'
17.305 + | Del_Find' of Celem.cterm' | Del_Given' of Celem.cterm' | Del_Relation' of Celem.cterm'
17.306
17.307 - | Derive' of rls
17.308 - | Detail_Set' of theory' * bool * rls * term * Selem.result
17.309 - | Detail_Set_Inst' of theory' * bool * subst * rls * term * Selem.result
17.310 + | Derive' of Celem.rls
17.311 + | Detail_Set' of Celem.theory' * bool * Celem.rls * term * Selem.result
17.312 + | Detail_Set_Inst' of Celem.theory' * bool * Celem.subst * Celem.rls * term * Selem.result
17.313 | End_Detail' of Selem.result
17.314
17.315 | Empty_Tac_
17.316 | Free_Solve'
17.317
17.318 - | Init_Proof' of cterm' list * spec
17.319 - | Model_Problem' of pblID *
17.320 + | Init_Proof' of Celem.cterm' list * Celem.spec
17.321 + | Model_Problem' of Celem.pblID *
17.322 Model.itm list * (* the 'untouched' pbl *)
17.323 Model.itm list (* the casually completed met *)
17.324 | Or_to_List' of term * term
17.325 - | Refine_Problem' of pblID * (Model.itm list * (bool * term) list)
17.326 + | Refine_Problem' of Celem.pblID * (Model.itm list * (bool * term) list)
17.327 | Refine_Tacitly' of
17.328 - pblID * (* input*)
17.329 - pblID * (* the refined from applicable_in *)
17.330 - domID * (* from new pbt?! filled in specify *)
17.331 - metID * (* from new pbt?! filled in specify *)
17.332 + Celem.pblID * (* input*)
17.333 + Celem.pblID * (* the refined from applicable_in *)
17.334 + Celem.domID * (* from new pbt?! filled in specify *)
17.335 + Celem.metID * (* from new pbt?! filled in specify *)
17.336 Model.itm list (* drop ! 9.03: remains [] for Model_Problem recognizing its activation *)
17.337 - | Rewrite' of theory' * rew_ord' * rls * bool * thm'' * term * Selem.result
17.338 - | Rewrite_Asm' of theory' * rew_ord' * rls * bool * thm'' * term * Selem.result
17.339 - | Rewrite_Inst' of theory' * rew_ord' * rls * bool * subst * thm'' * term * Selem.result
17.340 - | Rewrite_Set' of theory' * bool * rls * term * Selem.result
17.341 - | Rewrite_Set_Inst' of theory' * bool * subst * rls * term * Selem.result
17.342 + | Rewrite' of Celem.theory' * Celem.rew_ord' * Celem.rls * bool * Celem.thm'' * term * Selem.result
17.343 + | Rewrite_Asm' of Celem.theory' * Celem.rew_ord' * Celem.rls * bool * Celem.thm'' * term * Selem.result
17.344 + | Rewrite_Inst' of Celem.theory' * Celem.rew_ord' * Celem.rls * bool * Celem.subst * Celem.thm'' * term * Selem.result
17.345 + | Rewrite_Set' of Celem.theory' * bool * Celem.rls * term * Selem.result
17.346 + | Rewrite_Set_Inst' of Celem.theory' * bool * Celem.subst * Celem.rls * term * Selem.result
17.347
17.348 - | Specify_Method' of metID * Model.ori list * Model.itm list
17.349 - | Specify_Problem' of pblID *
17.350 + | Specify_Method' of Celem.metID * Model.ori list * Model.itm list
17.351 + | Specify_Problem' of Celem.pblID *
17.352 (bool * (* matches *)
17.353 (Model.itm list * (* ppc *)
17.354 (bool * term) list)) (* preconditions *)
17.355 - | Specify_Theory' of domID
17.356 + | Specify_Theory' of Celem.domID
17.357 | Subproblem' of
17.358 - spec *
17.359 + Celem.spec *
17.360 (Model.ori list) * (* filled in assod Subproblem' *)
17.361 term * (* -"-, headline of calc-head *)
17.362 - Selem.fmz_ *
17.363 - Proof.context * (* transported from assod to generate1*)
17.364 - term (* Subproblem(dom,pbl) OR cascmd *)
17.365 - | Substitute' of
17.366 - rew_ord_ * (* for re-calculation *)
17.367 - rls * (* for re-calculation *)
17.368 - Selem.subte * (* the 'substitution': terms of type bool *)
17.369 - term * (* to be substituted in *)
17.370 - term (* resulting from the substitution *)
17.371 + Selem.fmz_ *
17.372 + Proof.context * (* transported from assod to generate1*)
17.373 + term (* Subproblem(dom,pbl) OR cascmd *)
17.374 + | Substitute' of
17.375 + Celem.rew_ord_ * (* for re-calculation *)
17.376 + Celem.rls * (* for re-calculation *)
17.377 + Selem.subte * (* the 'substitution': terms of type bool *)
17.378 + term * (* to be substituted in *)
17.379 + term (* resulting from the substitution *)
17.380 | Tac_ of theory * string * string * string
17.381 | Take' of term | Take_Inst' of term
17.382
17.383 fun tac_2str ma = case ma of
17.384 - Init_Proof' (ppc, spec) => "Init_Proof' " ^ pair2str (strs2str ppc, spec2str spec)
17.385 + Init_Proof' (ppc, spec) => "Init_Proof' " ^ pair2str (strs2str ppc, Celem.spec2str spec)
17.386 | Model_Problem' (pblID, _, _) => "Model_Problem' " ^ strs2str pblID
17.387 | Refine_Tacitly'(p, prefin, domID, metID, _) => "Refine_Tacitly' (" ^ strs2str p ^ ", " ^
17.388 strs2str prefin ^ ", " ^ domID ^ ", " ^ strs2str metID ^ ", pbl-itms)"
17.389 @@ -413,11 +413,11 @@
17.390 | Specify_Problem' (pI, (ok, _)) => "Specify_Problem' " ^
17.391 spair2str (strs2str pI, spair2str (bool2str ok, spair2str ("itms2str_ itms", "items2str pre")))
17.392 | Specify_Method' (pI, oris, _) => "Specify_Method' (" ^
17.393 - metID2str pI ^ ", " ^ Model.oris2str oris ^ ", )"
17.394 + Celem.metID2str pI ^ ", " ^ Model.oris2str oris ^ ", )"
17.395
17.396 | Apply_Method' (metID, _, _, _) => "Apply_Method' " ^ strs2str metID
17.397 | Check_Postcond' (pblID, (scval, asm)) => "Check_Postcond' " ^
17.398 - (spair2str (strs2str pblID, spair2str (term2str scval, terms2str asm)))
17.399 + (spair2str (strs2str pblID, spair2str (Celem.term2str scval, Celem.terms2str asm)))
17.400
17.401 | Free_Solve' => "Free_Solve'"
17.402
17.403 @@ -426,12 +426,12 @@
17.404 | Rewrite_Asm' _(*thm'*) => "Rewrite_Asm' "(*^(spair2str thm')*)
17.405 | Rewrite_Set_Inst' _(*subs,thm'*) => "Rewrite_Set_Inst' "(*^(pair2str (subs2str subs, quote rls))*)
17.406 | Rewrite_Set' (thy', pasm, rls', f, (f', asm)) => "Rewrite_Set' (" ^ thy' ^ "," ^ bool2str pasm ^
17.407 - "," ^ id_rls rls' ^ "," ^ term2str f ^ ",(" ^ term2str f' ^ "," ^ terms2str asm ^ "))"
17.408 + "," ^ Celem.id_rls rls' ^ "," ^ Celem.term2str f ^ ",(" ^ Celem.term2str f' ^ "," ^ Celem.terms2str asm ^ "))"
17.409 | End_Detail' _ => "End_Detail' xxx"
17.410 | Detail_Set' _ => "Detail_Set' xxx"
17.411 | Detail_Set_Inst' _ => "Detail_Set_Inst' xxx"
17.412
17.413 - | Derive' rls => "Derive' " ^ id_rls rls
17.414 + | Derive' rls => "Derive' " ^ Celem.id_rls rls
17.415 | Calculate' _ => "Calculate' "
17.416 | Substitute' _ => "Substitute' "(*^(subs2str subs)*)
17.417 | Apply_Assumption' _(* ct's*) => "Apply_Assumption' "(*^(strs2str ct's)*)
18.1 --- a/src/Tools/isac/KEStore.thy Tue Mar 13 15:04:27 2018 +0100
18.2 +++ b/src/Tools/isac/KEStore.thy Thu Mar 15 10:17:44 2018 +0100
18.3 @@ -6,6 +6,31 @@
18.4 imports "~~/src/HOL/Complex_Main"
18.5 begin
18.6 ML_file "~~/src/Tools/isac/library.sml"
18.7 +
18.8 +
18.9 +ML {*
18.10 +*} ML {* (* how declare a recursive datatype *)
18.11 +*} ML {*
18.12 +datatype rls = Erls | Rls of {rules: rule list, erls: rls}
18.13 +and rule = Rls_ of rls
18.14 +*} ML {*
18.15 +*} ML {*
18.16 +*} ML {*
18.17 +*}
18.18 +
18.19 +
18.20 +
18.21 +
18.22 +
18.23 +
18.24 +
18.25 +
18.26 +
18.27 +
18.28 +
18.29 +
18.30 +
18.31 +
18.32 ML_file "~~/src/Tools/isac/calcelems.sml"
18.33
18.34 section {* Knowledge elements for problems and methods *}
18.35 @@ -23,19 +48,19 @@
18.36 *)
18.37 signature KESTORE_ELEMS =
18.38 sig
18.39 - val get_rlss: theory -> (rls' * (theory' * rls)) list
18.40 - val add_rlss: (rls' * (theory' * rls)) list -> theory -> theory
18.41 - val get_calcs: theory -> (prog_calcID * (calID * eval_fn)) list
18.42 - val add_calcs: (prog_calcID * (calID * eval_fn)) list -> theory -> theory
18.43 - val get_cas: theory -> cas_elem list
18.44 - val add_cas: cas_elem list -> theory -> theory
18.45 - val get_ptyps: theory -> ptyps
18.46 - val add_pbts: (pbt * pblID) list -> theory -> theory
18.47 - val get_mets: theory -> mets
18.48 - val add_mets: (met * metID) list -> theory -> theory
18.49 - val get_thes: theory -> (thydata ptyp) list
18.50 - val add_thes: (thydata * theID) list -> theory -> theory (* thydata dropped at existing elems *)
18.51 - val insert_fillpats: (theID * fillpat list) list -> theory -> theory
18.52 + val get_rlss: theory -> (Celem.rls' * (Celem.theory' * Celem.rls)) list
18.53 + val add_rlss: (Celem.rls' * (Celem.theory' * Celem.rls)) list -> theory -> theory
18.54 + val get_calcs: theory -> (Celem.prog_calcID * (Celem.calID * Celem.eval_fn)) list
18.55 + val add_calcs: (Celem.prog_calcID * (Celem.calID * Celem.eval_fn)) list -> theory -> theory
18.56 + val get_cas: theory -> Celem.cas_elem list
18.57 + val add_cas: Celem.cas_elem list -> theory -> theory
18.58 + val get_ptyps: theory -> Celem.ptyps
18.59 + val add_pbts: (Celem.pbt * Celem.pblID) list -> theory -> theory
18.60 + val get_mets: theory -> Celem.mets
18.61 + val add_mets: (Celem.met * Celem.metID) list -> theory -> theory
18.62 + val get_thes: theory -> (Celem.thydata Celem.ptyp) list
18.63 + val add_thes: (Celem.thydata * Celem.theID) list -> theory -> theory (* thydata dropped at existing elems *)
18.64 + val insert_fillpats: (Celem.theID * Celem.fillpat list) list -> theory -> theory
18.65 val get_ref_thy: unit -> theory
18.66 val set_ref_thy: theory -> unit
18.67 end;
18.68 @@ -45,78 +70,78 @@
18.69 fun union_overwrite eq l1 l2 = fold (insert eq) l2 (*..swapped..*) l1;
18.70
18.71 structure Data = Theory_Data (
18.72 - type T = (rls' * (theory' * rls)) list;
18.73 + type T = (Celem.rls' * (Celem.theory' * Celem.rls)) list;
18.74 val empty = [];
18.75 val extend = I;
18.76 - val merge = merge_rlss;
18.77 + val merge = Celem.merge_rlss;
18.78 );
18.79 fun get_rlss thy = Data.get thy
18.80 - fun add_rlss rlss = Data.map (union_overwrite rls_eq rlss)
18.81 + fun add_rlss rlss = Data.map (union_overwrite Celem.rls_eq rlss)
18.82
18.83 structure Data = Theory_Data (
18.84 - type T = (prog_calcID * (calID * eval_fn)) list;
18.85 + type T = (Celem.prog_calcID * (Celem.calID * Celem.eval_fn)) list;
18.86 val empty = [];
18.87 val extend = I;
18.88 - val merge = merge calc_eq;
18.89 + val merge = merge Celem.calc_eq;
18.90 );
18.91 fun get_calcs thy = Data.get thy
18.92 - fun add_calcs calcs = Data.map (union_overwrite calc_eq calcs)
18.93 + fun add_calcs calcs = Data.map (union_overwrite Celem.calc_eq calcs)
18.94
18.95 structure Data = Theory_Data (
18.96 - type T = (term * (spec * (term list -> (term * term list) list))) list;
18.97 + type T = (term * (Celem.spec * (term list -> (term * term list) list))) list;
18.98 val empty = [];
18.99 val extend = I;
18.100 - val merge = merge cas_eq;
18.101 + val merge = merge Celem.cas_eq;
18.102 );
18.103 fun get_cas thy = Data.get thy
18.104 - fun add_cas cas = Data.map (union_overwrite cas_eq cas)
18.105 + fun add_cas cas = Data.map (union_overwrite Celem.cas_eq cas)
18.106
18.107 structure Data = Theory_Data (
18.108 - type T = ptyps;
18.109 - val empty = [e_Ptyp];
18.110 + type T = Celem.ptyps;
18.111 + val empty = [Celem.e_Ptyp];
18.112 val extend = I;
18.113 - val merge = merge_ptyps;
18.114 + val merge = Celem.merge_ptyps;
18.115 );
18.116 fun get_ptyps thy = Data.get thy;
18.117 fun add_pbts pbts thy = let
18.118 fun add_pbt (pbt as {guh,...}, pblID) =
18.119 (* the pblID has the leaf-element as first; better readability achieved *)
18.120 - (if (!check_guhs_unique) then check_pblguh_unique guh (Data.get thy) else ();
18.121 - rev pblID |> insrt pblID pbt);
18.122 + (if (!Celem.check_guhs_unique) then Celem.check_pblguh_unique guh (Data.get thy) else ();
18.123 + rev pblID |> Celem.insrt pblID pbt);
18.124 in Data.map (fold add_pbt pbts) thy end;
18.125
18.126 structure Data = Theory_Data (
18.127 - type T = mets;
18.128 - val empty = [e_Mets];
18.129 + type T = Celem.mets;
18.130 + val empty = [Celem.e_Mets];
18.131 val extend = I;
18.132 - val merge = merge_ptyps;
18.133 + val merge = Celem.merge_ptyps;
18.134 );
18.135 val get_mets = Data.get;
18.136 fun add_mets mets thy = let
18.137 fun add_met (met as {guh,...}, metID) =
18.138 - (if (!check_guhs_unique) then check_metguh_unique guh (Data.get thy) else ();
18.139 - insrt metID met metID);
18.140 + (if (!Celem.check_guhs_unique) then Celem.check_metguh_unique guh (Data.get thy) else ();
18.141 + Celem.insrt metID met metID);
18.142 in Data.map (fold add_met mets) thy end;
18.143
18.144 structure Data = Theory_Data (
18.145 - type T = (thydata ptyp) list;
18.146 + type T = (Celem.thydata Celem.ptyp) list;
18.147 val empty = [];
18.148 val extend = I;
18.149 - val merge = merge_ptyps; (* relevant for store_thm, store_rls *)
18.150 + val merge = Celem.merge_ptyps; (* relevant for store_thm, store_rls *)
18.151 );
18.152 fun get_thes thy = Data.get thy
18.153 fun add_thes thes thy = let
18.154 - fun add_the (thydata, theID) = add_thydata ([], theID) thydata
18.155 + fun add_the (thydata, theID) = Celem.add_thydata ([], theID) thydata
18.156 in Data.map (fold add_the thes) thy end;
18.157 fun insert_fillpats fis thy =
18.158 let
18.159 fun update_elem (theID, fillpats) =
18.160 let
18.161 - val hthm = get_py (Data.get thy) theID theID
18.162 - val hthm' = update_hthm hthm fillpats
18.163 + val hthm = Celem.get_py (Data.get thy) theID theID
18.164 + val hthm' = Celem.update_hthm hthm fillpats
18.165 handle ERROR _ =>
18.166 error ("insert_fillpats: " ^ strs2str theID ^ "must address a theorem")
18.167 - in update_ptyps theID theID hthm' end
18.168 + in Celem.update_ptyps theID theID hthm' end
18.169 in Data.map (fold update_elem fis) thy end
18.170
18.171 val cur_thy = Synchronized.var "finally_knowledge_complete" @{theory};
18.172 @@ -133,13 +158,13 @@
18.173 ML {*
18.174 val get_ref_thy = KEStore_Elems.get_ref_thy;
18.175
18.176 -fun assoc_rls (rls' : rls') =
18.177 - case AList.lookup (op =) (KEStore_Elems.get_rlss (Thy_Info_get_theory "Isac")) rls' of
18.178 +fun assoc_rls (rls' : Celem.rls') =
18.179 + case AList.lookup (op =) (KEStore_Elems.get_rlss (Celem.Thy_Info_get_theory "Isac")) rls' of
18.180 SOME (_, rls) => rls
18.181 | NONE => raise ERROR ("rls \""^ rls' ^ "\" missing in KEStore.\n" ^
18.182 "TODO exception hierarchy needs to be established.")
18.183
18.184 -fun assoc_rls' thy (rls' : rls') =
18.185 +fun assoc_rls' thy (rls' : Celem.rls') =
18.186 case AList.lookup (op =) (KEStore_Elems.get_rlss thy) rls' of
18.187 SOME (_, rls) => rls
18.188 | NONE => raise ERROR ("rls \""^ rls' ^ "\" missing in KEStore.\n" ^
18.189 @@ -166,63 +191,64 @@
18.190 fun get_thes () = get_ref_thy () |> KEStore_Elems.get_thes;
18.191 *}
18.192 setup {* KEStore_Elems.add_rlss
18.193 - [("e_rls", (Context.theory_name @{theory}, e_rls)),
18.194 - ("e_rrls", (Context.theory_name @{theory}, e_rrls))] *}
18.195 + [("e_rls", (Context.theory_name @{theory}, Celem.e_rls)),
18.196 + ("e_rrls", (Context.theory_name @{theory}, Celem.e_rrls))] *}
18.197
18.198 section {* determine sequence of main parts in thehier *}
18.199 setup {*
18.200 KEStore_Elems.add_thes
18.201 - [(Html {guh = part2guh ["IsacKnowledge"], html = "",
18.202 + [(Celem.Html {guh = Celem.part2guh ["IsacKnowledge"], html = "",
18.203 mathauthors = ["Isac team"], coursedesign = []}, ["IsacKnowledge"]),
18.204 - (Html {guh = part2guh ["Isabelle"], html = "",
18.205 + (Celem.Html {guh = Celem.part2guh ["Isabelle"], html = "",
18.206 mathauthors = ["Isabelle team, TU Munich"], coursedesign = []}, ["Isabelle"]),
18.207 - (Html {guh = part2guh ["IsacScripts"], html = "",
18.208 + (Celem.Html {guh = Celem.part2guh ["IsacScripts"], html = "",
18.209 mathauthors = ["Isac team"], coursedesign = []}, ["IsacScripts"])]
18.210 *}
18.211
18.212 section {* Functions for checking KEStore_Elems *}
18.213 ML {*
18.214 fun short_string_of_rls Erls = "Erls"
18.215 - | short_string_of_rls (Rls {calc, rules, ...}) =
18.216 +(*
18.217 + | short_string_of_rls (Celem.Rls {calc, rules, ...}) =
18.218 "Rls {#calc = " ^ string_of_int (length calc) ^
18.219 ", #rules = " ^ string_of_int (length rules) ^ ", ..."
18.220 - | short_string_of_rls (Seq {calc, rules, ...}) =
18.221 + | short_string_of_rls (Celem.Seq {calc, rules, ...}) =
18.222 "Seq {#calc = " ^ string_of_int (length calc) ^
18.223 ", #rules = " ^ string_of_int (length rules) ^ ", ..."
18.224 - | short_string_of_rls (Rrls _) = "Rrls {...}";
18.225 -
18.226 + | short_string_of_rls (Celem.Rrls _) = "Rrls {...}";
18.227 +*)
18.228 fun check_kestore_rls (rls', (thyID, rls)) =
18.229 "(" ^ rls' ^ ", (" ^ thyID ^ ", " ^ short_string_of_rls rls ^ "))";
18.230
18.231 -fun check_kestore_calc ((id, (c, _)) : calc) = "(" ^ id ^ ", (" ^ c ^ ", fn))";
18.232 +fun check_kestore_calc ((id, (c, _)) : Celem.calc) = "(" ^ id ^ ", (" ^ c ^ ", fn))";
18.233
18.234 -fun check_kestore_cas ((t, (s, _)):cas_elem) =
18.235 - "(" ^ (term_to_string''' @{theory} t) ^ ", " ^ (spec2str s) ^ ")";
18.236 +fun check_kestore_cas ((t, (s, _)) : Celem.cas_elem) =
18.237 + "(" ^ (Celem.term_to_string''' @{theory} t) ^ ", " ^ (Celem.spec2str s) ^ ")";
18.238
18.239 fun count_kestore_ptyps [] = 0
18.240 - | count_kestore_ptyps ((Ptyp (_, _, ps)) :: ps') =
18.241 + | count_kestore_ptyps ((Celem.Ptyp (_, _, ps)) :: ps') =
18.242 1 + count_kestore_ptyps ps + count_kestore_ptyps ps';
18.243 -fun check_kestore_ptyp' strfun (Ptyp (key, pbts, pts)) = "Ptyp (" ^ (quote key) ^ ", " ^
18.244 - (strfun pbts) ^ ", " ^ (map (check_kestore_ptyp' strfun) pts |> list2str) ^ ")" |> linefeed;
18.245 -val check_kestore_ptyp = check_kestore_ptyp' pbts2str;
18.246 -fun ptyp_ord ((Ptyp (s1, _, _)), (Ptyp (s2, _, _))) = string_ord (s1, s2);
18.247 -fun pbt_ord ({guh = guh'1, ...} : pbt, {guh = guh'2, ...} : pbt) = string_ord (guh'1, guh'2);
18.248 +fun check_kestore_ptyp' strfun (Celem.Ptyp (key, pbts, pts)) = "Ptyp (" ^ (quote key) ^ ", " ^
18.249 + (strfun pbts) ^ ", " ^ (map (check_kestore_ptyp' strfun) pts |> list2str) ^ ")" |> Celem.linefeed;
18.250 +val check_kestore_ptyp = check_kestore_ptyp' Celem.pbts2str;
18.251 +fun ptyp_ord ((Celem.Ptyp (s1, _, _)), (Celem.Ptyp (s2, _, _))) = string_ord (s1, s2);
18.252 +fun pbt_ord ({guh = guh'1, ...} : Celem.pbt, {guh = guh'2, ...} : Celem.pbt) = string_ord (guh'1, guh'2);
18.253 fun sort_kestore_ptyp' _ [] = []
18.254 - | sort_kestore_ptyp' ordfun ((Ptyp (key, pbts, ps)) :: ps') =
18.255 - ((Ptyp (key, sort ordfun pbts, sort_kestore_ptyp' ordfun ps |> sort ptyp_ord))
18.256 + | sort_kestore_ptyp' ordfun ((Celem.Ptyp (key, pbts, ps)) :: ps') =
18.257 + ((Celem.Ptyp (key, sort ordfun pbts, sort_kestore_ptyp' ordfun ps |> sort ptyp_ord))
18.258 :: sort_kestore_ptyp' ordfun ps');
18.259 val sort_kestore_ptyp = sort_kestore_ptyp' pbt_ord;
18.260
18.261 -fun metguh2str ({guh,...}:met) = guh : string;
18.262 -fun check_kestore_met (mp:met ptyp) =
18.263 +fun metguh2str ({guh,...} : Celem.met) = guh : string;
18.264 +fun check_kestore_met (mp: Celem.met Celem.ptyp) =
18.265 check_kestore_ptyp' (fn xs => map metguh2str xs |> strs2str) mp;
18.266 -fun met_ord ({guh = guh'1, ...} : met, {guh = guh'2, ...} : met) = string_ord (guh'1, guh'2);
18.267 +fun met_ord ({guh = guh'1, ...} : Celem.met, {guh = guh'2, ...} : Celem.met) = string_ord (guh'1, guh'2);
18.268 val sort_kestore_met = sort_kestore_ptyp' met_ord;
18.269
18.270 -fun check_kestore_thes thes = ((map writeln) o (map (check_kestore_ptyp' thes2str))) thes
18.271 +fun check_kestore_thes thes = ((map writeln) o (map (check_kestore_ptyp' Celem.thes2str))) thes
18.272 fun write_thes thydata_list =
18.273 thydata_list
18.274 - |> map (fn (id, the) => (theID2str id, the2str the))
18.275 + |> map (fn (id, the) => (Celem.theID2str id, Celem.the2str the))
18.276 |> map pair2str
18.277 |> map writeln
18.278 *}
19.1 --- a/src/Tools/isac/Knowledge/Test_Build_Thydata.thy Tue Mar 13 15:04:27 2018 +0100
19.2 +++ b/src/Tools/isac/Knowledge/Test_Build_Thydata.thy Thu Mar 15 10:17:44 2018 +0100
19.3 @@ -4,24 +4,24 @@
19.4 imports "~~/src/Tools/isac/ProgLang/ProgLang"
19.5 begin
19.6 ML {*
19.7 -fun termlessI (_:subst) uv = Term_Ord.termless uv;
19.8 +fun termlessI (_: Celem.subst) uv = Term_Ord.termless uv;
19.9 *}
19.10 axiomatization where
19.11 thm111: "thm111 = thm111 + (111::int)" and
19.12 thm222: "thm222 = thm222 + (222::int)"
19.13
19.14 ML {*
19.15 -val rls111 = Rls {id = "rls111",
19.16 - preconds = [], rew_ord = ("termlessI", termlessI), erls = e_rls,
19.17 - srls = Erls, calc = [], errpatts = [],
19.18 - rules = [Thm ("thm111", @{thm thm111}), Thm ("refl", @{thm refl})],
19.19 - scr = EmptyScr};
19.20 +val rls111 = Celem.Rls {id = "rls111",
19.21 + preconds = [], rew_ord = ("termlessI", termlessI), erls = Celem.e_rls,
19.22 + srls = Celem.Erls, calc = [], errpatts = [],
19.23 + rules = [Celem.Thm ("thm111", @{thm thm111}), Celem.Thm ("refl", @{thm refl})],
19.24 + scr = Celem.EmptyScr};
19.25
19.26 -val rls222 = Rls {id = "rls222",
19.27 - preconds = [], rew_ord = ("termlessI", termlessI), erls = e_rls,
19.28 - srls = Erls, calc = [], errpatts = [],
19.29 - rules = [Thm ("sym_thm111", @{thm thm111} RS @{thm sym}), Thm ("o_def", @{thm o_def})],
19.30 - scr = EmptyScr};
19.31 +val rls222 = Celem.Rls {id = "rls222",
19.32 + preconds = [], rew_ord = ("termlessI", termlessI), erls = Celem.e_rls,
19.33 + srls = Celem.Erls, calc = [], errpatts = [],
19.34 + rules = [Celem.Thm ("sym_thm111", @{thm thm111} RS @{thm sym}), Celem.Thm ("o_def", @{thm o_def})],
19.35 + scr = Celem.EmptyScr};
19.36
19.37 val prep_rls' = LTool.prep_rls @{theory};
19.38 *}
20.1 --- a/src/Tools/isac/ProgLang/ListC.thy Tue Mar 13 15:04:27 2018 +0100
20.2 +++ b/src/Tools/isac/ProgLang/ListC.thy Thu Mar 15 10:17:44 2018 +0100
20.3 @@ -133,52 +133,52 @@
20.4 ML{* (*the former ListC.ML*)
20.5 (** rule set for evaluating listexpr in scripts **)
20.6 val list_rls =
20.7 - Rls{id = "list_rls", preconds = [], rew_ord = ("dummy_ord", dummy_ord),
20.8 - erls = Erls, srls = Erls, calc = [], errpatts = [],
20.9 - rules = [Thm ("refl", TermC.num_str @{thm refl}), (*'a<>b -> FALSE' by fun eval_equal*)
20.10 - Thm ("o_apply", TermC.num_str @{thm o_apply}),
20.11 + Celem.Rls {id = "list_rls", preconds = [], rew_ord = ("dummy_ord", Celem.dummy_ord),
20.12 + erls = Celem.Erls, srls = Celem.Erls, calc = [], errpatts = [],
20.13 + rules = [Celem.Thm ("refl", TermC.num_str @{thm refl}), (*'a<>b -> FALSE' by fun eval_equal*)
20.14 + Celem.Thm ("o_apply", TermC.num_str @{thm o_apply}),
20.15
20.16 - Thm ("NTH_CONS",TermC.num_str @{thm NTH_CONS}),(*erls for cond. in Atools.ML*)
20.17 - Thm ("NTH_NIL",TermC.num_str @{thm NTH_NIL}),
20.18 - Thm ("append_Cons",TermC.num_str @{thm append_Cons}),
20.19 - Thm ("append_Nil",TermC.num_str @{thm append_Nil}),
20.20 + Celem.Thm ("NTH_CONS",TermC.num_str @{thm NTH_CONS}),(*erls for cond. in Atools.ML*)
20.21 + Celem.Thm ("NTH_NIL",TermC.num_str @{thm NTH_NIL}),
20.22 + Celem.Thm ("append_Cons",TermC.num_str @{thm append_Cons}),
20.23 + Celem.Thm ("append_Nil",TermC.num_str @{thm append_Nil}),
20.24 (* Thm ("butlast_Cons",num_str @{thm butlast_Cons}),
20.25 Thm ("butlast_Nil",num_str @{thm butlast_Nil}),*)
20.26 - Thm ("concat_Cons",TermC.num_str @{thm concat_Cons}),
20.27 - Thm ("concat_Nil",TermC.num_str @{thm concat_Nil}),
20.28 -(* Thm ("del_base",num_str @{thm del_base}),
20.29 - Thm ("del_rec",num_str @{thm del_rec}), *)
20.30 + Celem.Thm ("concat_Cons",TermC.num_str @{thm concat_Cons}),
20.31 + Celem.Thm ("concat_Nil",TermC.num_str @{thm concat_Nil}),
20.32 +(* Celem.Thm ("del_base",num_str @{thm del_base}),
20.33 + Celem.Thm ("del_rec",num_str @{thm del_rec}), *)
20.34
20.35 - Thm ("distinct_Cons",TermC.num_str @{thm distinct_Cons}),
20.36 - Thm ("distinct_Nil",TermC.num_str @{thm distinct_Nil}),
20.37 - Thm ("dropWhile_Cons",TermC.num_str @{thm dropWhile_Cons}),
20.38 - Thm ("dropWhile_Nil",TermC.num_str @{thm dropWhile_Nil}),
20.39 - Thm ("filter_Cons",TermC.num_str @{thm filter_Cons}),
20.40 - Thm ("filter_Nil",TermC.num_str @{thm filter_Nil}),
20.41 - Thm ("foldr_Cons",TermC.num_str @{thm foldr_Cons}),
20.42 - Thm ("foldr_Nil",TermC.num_str @{thm foldr_Nil}),
20.43 - Thm ("hd_thm",TermC.num_str @{thm hd_thm}),
20.44 - Thm ("LAST",TermC.num_str @{thm LAST}),
20.45 - Thm ("LENGTH_CONS",TermC.num_str @{thm LENGTH_CONS}),
20.46 - Thm ("LENGTH_NIL",TermC.num_str @{thm LENGTH_NIL}),
20.47 -(* Thm ("list_diff_def",num_str @{thm list_diff_def}),*)
20.48 - Thm ("map_Cons",TermC.num_str @{thm map_Cons}),
20.49 - Thm ("map_Nil",TermC.num_str @{thm map_Cons}),
20.50 -(* Thm ("mem_Cons",TermC.num_str @{thm mem_Cons}),
20.51 - Thm ("mem_Nil",TermC.num_str @{thm mem_Nil}), *)
20.52 -(* Thm ("null_Cons",TermC.num_str @{thm null_Cons}),
20.53 - Thm ("null_Nil",TermC.num_str @{thm null_Nil}),*)
20.54 - Thm ("remdups_Cons",TermC.num_str @{thm remdups_Cons}),
20.55 - Thm ("remdups_Nil",TermC.num_str @{thm remdups_Nil}),
20.56 - Thm ("rev_Cons",TermC.num_str @{thm rev_Cons}),
20.57 - Thm ("rev_Nil",TermC.num_str @{thm rev_Nil}),
20.58 - Thm ("take_Nil",TermC.num_str @{thm take_Nil}),
20.59 - Thm ("take_Cons",TermC.num_str @{thm take_Cons}),
20.60 - Thm ("tl_Cons",TermC.num_str @{thm tl_Cons}),
20.61 - Thm ("tl_Nil",TermC.num_str @{thm tl_Nil}),
20.62 - Thm ("zip_Cons",TermC.num_str @{thm zip_Cons}),
20.63 - Thm ("zip_Nil",TermC.num_str @{thm zip_Nil})],
20.64 - scr = EmptyScr}:rls;
20.65 + Celem.Thm ("distinct_Cons",TermC.num_str @{thm distinct_Cons}),
20.66 + Celem.Thm ("distinct_Nil",TermC.num_str @{thm distinct_Nil}),
20.67 + Celem.Thm ("dropWhile_Cons",TermC.num_str @{thm dropWhile_Cons}),
20.68 + Celem.Thm ("dropWhile_Nil",TermC.num_str @{thm dropWhile_Nil}),
20.69 + Celem.Thm ("filter_Cons",TermC.num_str @{thm filter_Cons}),
20.70 + Celem.Thm ("filter_Nil",TermC.num_str @{thm filter_Nil}),
20.71 + Celem.Thm ("foldr_Cons",TermC.num_str @{thm foldr_Cons}),
20.72 + Celem.Thm ("foldr_Nil",TermC.num_str @{thm foldr_Nil}),
20.73 + Celem.Thm ("hd_thm",TermC.num_str @{thm hd_thm}),
20.74 + Celem.Thm ("LAST",TermC.num_str @{thm LAST}),
20.75 + Celem.Thm ("LENGTH_CONS",TermC.num_str @{thm LENGTH_CONS}),
20.76 + Celem.Thm ("LENGTH_NIL",TermC.num_str @{thm LENGTH_NIL}),
20.77 +(* Celem.Thm ("list_diff_def",num_str @{thm list_diff_def}),*)
20.78 + Celem.Thm ("map_Cons",TermC.num_str @{thm map_Cons}),
20.79 + Celem.Thm ("map_Nil",TermC.num_str @{thm map_Cons}),
20.80 +(* Celem.Thm ("mem_Cons",TermC.num_str @{thm mem_Cons}),
20.81 + Celem.Thm ("mem_Nil",TermC.num_str @{thm mem_Nil}), *)
20.82 +(* Celem.Thm ("null_Cons",TermC.num_str @{thm null_Cons}),
20.83 + Celem.Thm ("null_Nil",TermC.num_str @{thm null_Nil}),*)
20.84 + Celem.Thm ("remdups_Cons",TermC.num_str @{thm remdups_Cons}),
20.85 + Celem.Thm ("remdups_Nil",TermC.num_str @{thm remdups_Nil}),
20.86 + Celem.Thm ("rev_Cons",TermC.num_str @{thm rev_Cons}),
20.87 + Celem.Thm ("rev_Nil",TermC.num_str @{thm rev_Nil}),
20.88 + Celem.Thm ("take_Nil",TermC.num_str @{thm take_Nil}),
20.89 + Celem.Thm ("take_Cons",TermC.num_str @{thm take_Cons}),
20.90 + Celem.Thm ("tl_Cons",TermC.num_str @{thm tl_Cons}),
20.91 + Celem.Thm ("tl_Nil",TermC.num_str @{thm tl_Nil}),
20.92 + Celem.Thm ("zip_Cons",TermC.num_str @{thm zip_Cons}),
20.93 + Celem.Thm ("zip_Nil",TermC.num_str @{thm zip_Nil})],
20.94 + scr = Celem.EmptyScr}: Celem.rls;
20.95 *}
20.96 setup {* KEStore_Elems.add_rlss [("list_rls", (Context.theory_name @{theory}, list_rls))] *}
20.97
21.1 --- a/src/Tools/isac/ProgLang/Tools.thy Tue Mar 13 15:04:27 2018 +0100
21.2 +++ b/src/Tools/isac/ProgLang/Tools.thy Thu Mar 15 10:17:44 2018 +0100
21.3 @@ -66,7 +66,7 @@
21.4 Const ("HOL.disj",_) $ _ $ _ => get (ls @ [o1]) o2
21.5 | _ => ls @ [o1, o2]
21.6 in (((TermC.list2isalist HOLogic.boolT) o (get [])) ors)
21.7 - handle _ => error ("or2list: no ORs= "^(term2str ors)) end
21.8 + handle _ => error ("or2list: no ORs= "^(Celem.term2str ors)) end
21.9 );
21.10 (*>val t = @{term True};
21.11 > val t' = or2list t;
21.12 @@ -96,11 +96,11 @@
21.13 then
21.14 let
21.15 val prop = HOLogic.Trueprop $ (TermC.mk_equality (t, @{term True}))
21.16 - in SOME (term_to_string''' thy prop, prop) end
21.17 + in SOME (Celem.term_to_string''' thy prop, prop) end
21.18 else
21.19 let
21.20 val prop = HOLogic.Trueprop $ (TermC.mk_equality (t, @{term False}))
21.21 - in SOME (term_to_string''' thy prop, prop) end
21.22 + in SOME (Celem.term_to_string''' thy prop, prop) end
21.23 | eval_matches _ _ _ _ = NONE;
21.24 (*
21.25 > val t = (Thm.term_of o the o (parse thy))
21.26 @@ -175,10 +175,10 @@
21.27 if matchsub thy tst pat
21.28 then
21.29 let val prop = HOLogic.Trueprop $ (TermC.mk_equality (t, @{term True}))
21.30 - in SOME (term_to_string''' thy prop, prop) end
21.31 + in SOME (Celem.term_to_string''' thy prop, prop) end
21.32 else
21.33 let val prop = HOLogic.Trueprop $ (TermC.mk_equality (t, @{term False}))
21.34 - in SOME (term_to_string''' thy prop, prop) end
21.35 + in SOME (Celem.term_to_string''' thy prop, prop) end
21.36 | eval_matchsub _ _ _ _ = NONE;
21.37
21.38 (*get the variables in an isabelle-term*)
21.39 @@ -186,16 +186,16 @@
21.40 fun eval_var (thmid:string) "Tools.Vars" (t as (Const(op0,t0) $ arg)) thy =
21.41 let
21.42 val t' = ((TermC.list2isalist HOLogic.realT) o TermC.vars) t;
21.43 - val thmId = thmid ^ term_to_string''' thy arg;
21.44 + val thmId = thmid ^ Celem.term_to_string''' thy arg;
21.45 in SOME (thmId, HOLogic.Trueprop $ (TermC.mk_equality (t, t'))) end
21.46 | eval_var _ _ _ _ = NONE;
21.47
21.48 fun lhs (Const ("HOL.eq",_) $ l $ _) = l
21.49 - | lhs t = error("lhs called with (" ^ term2str t ^ ")");
21.50 + | lhs t = error("lhs called with (" ^ Celem.term2str t ^ ")");
21.51 (*("lhs" ,("Tools.lhs" ,eval_lhs "")):calc*)
21.52 fun eval_lhs _ "Tools.lhs"
21.53 (t as (Const ("Tools.lhs",_) $ (Const ("HOL.eq",_) $ l $ _))) _ =
21.54 - SOME ((term2str t) ^ " = " ^ (term2str l),
21.55 + SOME ((Celem.term2str t) ^ " = " ^ (Celem.term2str l),
21.56 HOLogic.Trueprop $ (TermC.mk_equality (t, l)))
21.57 | eval_lhs _ _ _ _ = NONE;
21.58 (*
21.59 @@ -207,18 +207,18 @@
21.60 *)
21.61
21.62 fun rhs (Const ("HOL.eq",_) $ _ $ r) = r
21.63 - | rhs t = error("rhs called with (" ^ term2str t ^ ")");
21.64 + | rhs t = error("rhs called with (" ^ Celem.term2str t ^ ")");
21.65 (*("rhs" ,("Tools.rhs" ,eval_rhs "")):calc*)
21.66 fun eval_rhs _ "Tools.rhs"
21.67 (t as (Const ("Tools.rhs",_) $ (Const ("HOL.eq",_) $ _ $ r))) _ =
21.68 - SOME ((term2str t) ^ " = " ^ (term2str r),
21.69 + SOME (Celem.term2str t ^ " = " ^ Celem.term2str r,
21.70 HOLogic.Trueprop $ (TermC.mk_equality (t, r)))
21.71 | eval_rhs _ _ _ _ = NONE;
21.72
21.73
21.74 (*for evaluating scripts*)
21.75
21.76 -val list_rls = append_rls "list_rls" list_rls [Calc ("Tools.rhs", eval_rhs "")];
21.77 +val list_rls = Celem.append_rls "list_rls" list_rls [Celem.Calc ("Tools.rhs", eval_rhs "")];
21.78 *}
21.79 setup {* KEStore_Elems.add_rlss [("list_rls", (Context.theory_name @{theory}, list_rls))] *}
21.80 setup {* KEStore_Elems.add_calcs
22.1 --- a/src/Tools/isac/ProgLang/calculate.sml Tue Mar 13 15:04:27 2018 +0100
22.2 +++ b/src/Tools/isac/ProgLang/calculate.sml Thu Mar 15 10:17:44 2018 +0100
22.3 @@ -10,8 +10,8 @@
22.4 val squfact: int -> int
22.5 val gcd: int -> int -> int
22.6 val sqrt: int -> int
22.7 - val adhoc_thm: theory -> string * eval_fn -> term -> (string * thm) option
22.8 - val adhoc_thm1_: theory -> cal -> term -> (string * thm) option
22.9 + val adhoc_thm: theory -> string * Celem.eval_fn -> term -> (string * thm) option
22.10 + val adhoc_thm1_: theory -> Celem.cal -> term -> (string * thm) option
22.11 val norm: term -> term
22.12 val popt2str: ('a * term) option -> string
22.13 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
22.14 @@ -68,7 +68,7 @@
22.15
22.16 (** calculate numerals **)
22.17
22.18 -fun popt2str (SOME (_, term)) = "SOME " ^ term2str term (*TODO \<longrightarrow> str_of_termopt*)
22.19 +fun popt2str (SOME (_, term)) = "SOME " ^ Celem.term2str term (*TODO \<longrightarrow> str_of_termopt*)
22.20 | popt2str NONE = "NONE";
22.21
22.22 (* scan a term for applying eval_fn ef
22.23 @@ -84,17 +84,17 @@
22.24 ^^^^^^... the selecting operator op_ (variable for eval_binop)
22.25 *)
22.26 fun trace_calc0 str =
22.27 - if ! trace_calc then writeln ("### " ^ str) else ()
22.28 + if ! Celem.trace_calc then writeln ("### " ^ str) else ()
22.29 fun trace_calc1 str1 str2 =
22.30 - if ! trace_calc then writeln (str1 ^ str2) else ()
22.31 + if ! Celem.trace_calc then writeln (str1 ^ str2) else ()
22.32 fun trace_calc2 str term popt =
22.33 - if ! trace_calc then writeln (str ^ term2str term ^ " , " ^ popt2str popt) else ()
22.34 + if ! Celem.trace_calc then writeln (str ^ Celem.term2str term ^ " , " ^ popt2str popt) else ()
22.35 fun trace_calc3 str term =
22.36 - if ! trace_calc then writeln ("### " ^ str ^ term2str term) else ()
22.37 + if ! Celem.trace_calc then writeln ("### " ^ str ^ Celem.term2str term) else ()
22.38 fun trace_calc4 str t1 t2 =
22.39 - if ! trace_calc then writeln ("### " ^ str ^ term2str t1 ^ " $ " ^ term2str t2) else ()
22.40 + if ! Celem.trace_calc then writeln ("### " ^ str ^ Celem.term2str t1 ^ " $ " ^ Celem.term2str t2) else ()
22.41
22.42 -fun get_pair thy op_ (ef: eval_fn) (t as (Const (op0, _) $ arg)) = (* unary fns *)
22.43 +fun get_pair thy op_ (ef: Celem.eval_fn) (t as (Const (op0, _) $ arg)) = (* unary fns *)
22.44 if op_ = op0 then
22.45 let val popt = ef op_ t thy
22.46 in case popt of SOME _ => popt | NONE => get_pair thy op_ ef arg end
23.1 --- a/src/Tools/isac/ProgLang/rewrite.sml Tue Mar 13 15:04:27 2018 +0100
23.2 +++ b/src/Tools/isac/ProgLang/rewrite.sml Thu Mar 15 10:17:44 2018 +0100
23.3 @@ -4,19 +4,23 @@
23.4
23.5 signature REWRITE =
23.6 sig
23.7 - val assoc_thm': theory -> thm' -> thm
23.8 - val assoc_thm'': theory -> thmID -> thm
23.9 - val calculate_: theory -> string * eval_fn -> term -> (term * (string * thm)) option
23.10 - val eval__true: theory -> int -> term list -> (term * term) list -> rls -> term list * bool
23.11 - val eval_listexpr_: theory -> rls -> term -> term
23.12 - val eval_true: theory -> term list -> rls -> bool
23.13 - val eval_true_: theory' -> rls -> term -> bool
23.14 - val rew_sub: theory -> int -> (term * term) list -> ((term * term) list -> term * term -> bool) -> rls -> bool -> lrd list -> term -> term -> term * term list * lrd list * bool
23.15 - val rewrite_: theory -> ((term * term) list -> term * term -> bool) -> rls -> bool -> thm -> term -> (term * term list) option
23.16 - val rewrite_inst_: theory -> ((term * term) list -> term * term -> bool) -> rls -> bool -> (term * term) list -> thm -> term -> (term * term list) option
23.17 - val rewrite_set_: theory -> bool -> rls -> term -> (term * term list) option
23.18 - val rewrite_set_inst_: theory -> bool -> (term * term) list -> rls -> term -> (term * term list) option
23.19 - val rewrite_terms_: theory -> ((term * term) list -> term * term -> bool) -> rls -> term list -> term -> (term * term list) option
23.20 + val assoc_thm': theory -> Celem.thm' -> thm
23.21 + val assoc_thm'': theory -> Celem.thmID -> thm
23.22 + val calculate_: theory -> string * Celem.eval_fn -> term -> (term * (string * thm)) option
23.23 + val eval__true: theory -> int -> term list -> (term * term) list -> Celem.rls -> term list * bool
23.24 + val eval_listexpr_: theory -> Celem.rls -> term -> term
23.25 + val eval_true: theory -> term list -> Celem.rls -> bool
23.26 + val eval_true_: Celem.theory' -> Celem.rls -> term -> bool
23.27 + val rew_sub: theory -> int -> (term * term) list -> ((term * term) list -> term * term -> bool)
23.28 + -> Celem.rls -> bool -> Celem.lrd list -> term -> term -> term * term list * Celem.lrd list * bool
23.29 + val rewrite_: theory -> ((term * term) list -> term * term -> bool) -> Celem.rls -> bool -> thm ->
23.30 + term -> (term * term list) option
23.31 + val rewrite_inst_: theory -> ((term * term) list -> term * term -> bool) -> Celem.rls -> bool
23.32 + -> (term * term) list -> thm -> term -> (term * term list) option
23.33 + val rewrite_set_: theory -> bool -> Celem.rls -> term -> (term * term list) option
23.34 + val rewrite_set_inst_: theory -> bool -> (term * term) list -> Celem.rls -> term -> (term * term list) option
23.35 + val rewrite_terms_: theory -> ((term * term) list -> term * term -> bool) -> Celem.rls -> term list
23.36 + -> term -> (term * term list) option
23.37 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
23.38 (* NONE *)
23.39 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
23.40 @@ -38,13 +42,13 @@
23.41 exception STOP_REW_SUB; (*WN050820 quick and dirty*)
23.42
23.43 fun trace i str =
23.44 - if ! trace_rewrite andalso i < ! depth then tracing (idt "#" i ^ str) else ()
23.45 + if ! Celem.trace_rewrite andalso i < ! Celem.depth then tracing (idt "#" i ^ str) else ()
23.46 fun trace1 i str =
23.47 - if ! trace_rewrite andalso i < ! depth then tracing (idt "#" (i + 1) ^ str) else ()
23.48 + if ! Celem.trace_rewrite andalso i < ! Celem.depth then tracing (idt "#" (i + 1) ^ str) else ()
23.49
23.50 fun rewrite__ thy i bdv tless rls put_asm thm ct =
23.51 let
23.52 - val (t', asms, _ (*lrd*), rew) = rew_sub thy i bdv tless rls put_asm ([(*root of the term*)]: lrd list)
23.53 + val (t', asms, _ (*lrd*), rew) = rew_sub thy i bdv tless rls put_asm ([(*root of the term*)]: Celem.lrd list)
23.54 (((TermC.inst_bdv bdv) o Calc.norm o #prop o Thm.rep_thm) thm) ct
23.55 in if rew then SOME (t', distinct asms) else NONE end
23.56 (* one rewrite (possibly conditional, ordered) EXOR exn EXOR go into subterms *)
23.57 @@ -56,29 +60,29 @@
23.58 val r' = Envir.subst_term (Pattern.match thy (lhs, t) (Vartab.empty, Vartab.empty)) r
23.59 val p' = map HOLogic.dest_Trueprop ((fst o Logic.strip_prems) (Logic.count_prems r', [], r'))
23.60 val t' = (snd o HOLogic.dest_eq o HOLogic.dest_Trueprop o Logic.strip_imp_concl) r'
23.61 - val _ = if ! trace_rewrite andalso i < ! depth andalso p' <> []
23.62 - then tracing (idt "#" (i + 1) ^ " eval asms: " ^ t2str thy r') else ()
23.63 + val _ = if ! Celem.trace_rewrite andalso i < ! Celem.depth andalso p' <> []
23.64 + then tracing (idt "#" (i + 1) ^ " eval asms: " ^ Celem.t2str thy r') else ()
23.65 val (t'', p'') = (*conditional rewriting*)
23.66 let
23.67 val (simpl_p', nofalse) = eval__true thy (i + 1) p' bdv rls
23.68 in
23.69 if nofalse
23.70 then
23.71 - (if ! trace_rewrite andalso i < ! depth andalso p' <> []
23.72 - then tracing (idt "#" (i + 1) ^ " asms accepted: " ^ ts2str thy p' ^
23.73 - " stored: " ^ ts2str thy simpl_p')
23.74 + (if ! Celem.trace_rewrite andalso i < ! Celem.depth andalso p' <> []
23.75 + then tracing (idt "#" (i + 1) ^ " asms accepted: " ^ Celem.ts2str thy p' ^
23.76 + " stored: " ^ Celem.ts2str thy simpl_p')
23.77 else();
23.78 (t',simpl_p')) (* uncond.rew. from above*)
23.79 else
23.80 - (if ! trace_rewrite andalso i < ! depth
23.81 - then tracing (idt "#" (i + 1) ^ " asms false: " ^ ts2str thy p')
23.82 + (if ! Celem.trace_rewrite andalso i < ! Celem.depth
23.83 + then tracing (idt "#" (i + 1) ^ " asms false: " ^ Celem.ts2str thy p')
23.84 else();
23.85 raise STOP_REW_SUB (* don't go into subterms of cond *))
23.86 end
23.87 in
23.88 if TermC.perm lhs rhs andalso not (tless bdv (t', t)) (*ordered rewriting*)
23.89 - then (if ! trace_rewrite andalso i < ! depth
23.90 - then tracing (idt"#"i ^ " not: \"" ^ t2str thy t ^ "\" > \"" ^ t2str thy t' ^ "\"")
23.91 + then (if ! Celem.trace_rewrite andalso i < ! Celem.depth
23.92 + then tracing (idt"#"i ^ " not: \"" ^ Celem.t2str thy t ^ "\" > \"" ^ Celem.t2str thy t' ^ "\"")
23.93 else ();
23.94 raise NO_REWRITE)
23.95 else (t'', p'', [], true)
23.96 @@ -90,14 +94,14 @@
23.97 | Var(n,T) => (Var(n,T),[],lrd,false)
23.98 | Bound i => (Bound i,[],lrd,false)
23.99 | Abs(s,T,body) =>
23.100 - let val (t', asms, _ (*lrd*), rew) = rew_sub thy i bdv tless rls put_asm (lrd @ [D]) r body
23.101 + let val (t', asms, _ (*lrd*), rew) = rew_sub thy i bdv tless rls put_asm (lrd @ [Celem.D]) r body
23.102 in (Abs(s, T, t'), asms, [], rew) end
23.103 | t1 $ t2 =>
23.104 - let val (t2', asm2, lrd, rew2) = rew_sub thy i bdv tless rls put_asm (lrd@[R]) r t2
23.105 + let val (t2', asm2, lrd, rew2) = rew_sub thy i bdv tless rls put_asm (lrd @ [Celem.R]) r t2
23.106 in
23.107 if rew2 then (t1 $ t2', asm2, lrd, true)
23.108 else
23.109 - let val (t1', asm1, lrd, rew1) = rew_sub thy i bdv tless rls put_asm (lrd@[L]) r t1
23.110 + let val (t1', asm1, lrd, rew1) = rew_sub thy i bdv tless rls put_asm (lrd @ [Celem.L]) r t1
23.111 in if rew1 then (t1' $ t2, asm1, lrd, true) else (t1 $ t2,[], lrd, false) end
23.112 end)
23.113 and eval__true thy i asms bdv rls = (* simplify asumptions until one evaluates to false *)
23.114 @@ -116,11 +120,11 @@
23.115 (*asm false .. thm not applied ^^^; continue until False vvv*)
23.116 else chk (indets @ [t] @ a') asms);
23.117 in chk [] asms end
23.118 -and rewrite__set_ thy _ __ Erls t = (* rewrite with a rule set *)
23.119 - error ("rewrite__set_ called with 'Erls' for '" ^ t2str thy t ^ "'")
23.120 - | rewrite__set_ thy i _ _ (rrls as Rrls _) t = (* rewrite with a 'reverse rule set' *)
23.121 +and rewrite__set_ thy _ __ Celem.Erls t = (* rewrite with a rule set *)
23.122 + error ("rewrite__set_ called with 'Erls' for '" ^ Celem.t2str thy t ^ "'")
23.123 + | rewrite__set_ thy i _ _ (rrls as Celem.Rrls _) t = (* rewrite with a 'reverse rule set' *)
23.124 let
23.125 - val _= trace i (" rls: " ^ id_rls rrls ^ " on: " ^ t2str thy t)
23.126 + val _= trace i (" rls: " ^ Celem.id_rls rrls ^ " on: " ^ Celem.t2str thy t)
23.127 val (t', asm, rew) = app_rev thy (i + 1) rrls t
23.128 in if rew then SOME (t', distinct asm) else NONE end
23.129 | rewrite__set_ thy i put_asm bdv rls ct = (* Rls, Seq containing Thms or Calc, Cal1 *)
23.130 @@ -129,57 +133,59 @@
23.131 datatype switch = Appl | Noap;
23.132 fun rew_once _ asm ct Noap [] = (ct, asm) (* ?TODO unify with Tools.rew_once? *)
23.133 | rew_once ruls asm ct Appl [] =
23.134 - (case rls of Rls _ => rew_once ruls asm ct Noap ruls
23.135 - | Seq _ => (ct, asm)
23.136 - | rls => raise ERROR ("rew_once not appl. to \"" ^ rls2str rls ^ "\""))
23.137 + (case rls of Celem.Rls _ => rew_once ruls asm ct Noap ruls
23.138 + | Celem.Seq _ => (ct, asm)
23.139 + | rls => raise ERROR ("rew_once not appl. to \"" ^ Celem.rls2str rls ^ "\""))
23.140 | rew_once ruls asm ct apno (rul :: thms) =
23.141 case rul of
23.142 - Thm (thmid, thm) =>
23.143 + Celem.Thm (thmid, thm) =>
23.144 (trace1 i (" try thm: " ^ thmid);
23.145 - case rewrite__ thy (i + 1) bdv ((snd o #rew_ord o rep_rls) rls)
23.146 - ((#erls o rep_rls) rls) put_asm thm ct of
23.147 + case rewrite__ thy (i + 1) bdv ((snd o #rew_ord o Celem.rep_rls) rls)
23.148 + ((#erls o Celem.rep_rls) rls) put_asm thm ct of
23.149 NONE => rew_once ruls asm ct apno thms
23.150 | SOME (ct', asm') =>
23.151 - (trace1 i (" rewrites to: " ^ t2str thy ct');
23.152 + (trace1 i (" rewrites to: " ^ Celem.t2str thy ct');
23.153 rew_once ruls (union (op =) asm asm') ct' Appl (rul :: thms)))
23.154 (* once again try the same rule, e.g. associativity against "()"*)
23.155 - | Calc (cc as (op_, _)) =>
23.156 + | Celem.Calc (cc as (op_, _)) =>
23.157 let val _= trace1 i (" try calc: " ^ op_ ^ "'")
23.158 val ct = TermC.uminus_to_string ct
23.159 in case Calc.adhoc_thm thy cc ct of
23.160 NONE => rew_once ruls asm ct apno thms
23.161 | SOME (_, thm') =>
23.162 let
23.163 - val pairopt = rewrite__ thy (i + 1) bdv ((snd o #rew_ord o rep_rls) rls)
23.164 - ((#erls o rep_rls) rls) put_asm thm' ct;
23.165 + val pairopt = rewrite__ thy (i + 1) bdv ((snd o #rew_ord o Celem.rep_rls) rls)
23.166 + ((#erls o Celem.rep_rls) rls) put_asm thm' ct;
23.167 val _ = if pairopt <> NONE then () else error ("rewrite_set_, rewrite_ \"" ^
23.168 - string_of_thmI thm' ^ "\" " ^ t2str thy ct ^ " = NONE")
23.169 - val _ = trace1 i (" calc. to: " ^ t2str thy ((fst o the) pairopt))
23.170 + Celem.string_of_thmI thm' ^ "\" " ^ Celem.t2str thy ct ^ " = NONE")
23.171 + val _ = trace1 i (" calc. to: " ^ Celem.t2str thy ((fst o the) pairopt))
23.172 in rew_once ruls asm ((fst o the) pairopt) Appl (rul :: thms) end
23.173 end
23.174 - | Cal1 (cc as (op_, _)) =>
23.175 + | Celem.Cal1 (cc as (op_, _)) =>
23.176 let val _= trace1 i (" try cal1: " ^ op_ ^ "'");
23.177 val ct = TermC.uminus_to_string ct
23.178 in case Calc.adhoc_thm1_ thy cc ct of
23.179 NONE => (ct, asm)
23.180 | SOME (_, thm') =>
23.181 let
23.182 - val pairopt = rewrite__ thy (i + 1) bdv ((snd o #rew_ord o rep_rls) rls)
23.183 - ((#erls o rep_rls) rls) put_asm thm' ct;
23.184 + val pairopt = rewrite__ thy (i + 1) bdv ((snd o #rew_ord o Celem.rep_rls) rls)
23.185 + ((#erls o Celem.rep_rls) rls) put_asm thm' ct;
23.186 val _ = if pairopt <> NONE then () else error ("rewrite_set_, rewrite_ \"" ^
23.187 - string_of_thmI thm' ^ "\" " ^ t2str thy ct ^ " = NONE")
23.188 - val _ = trace1 i (" cal1. to: " ^ t2str thy ((fst o the) pairopt))
23.189 + Celem.string_of_thmI thm' ^ "\" " ^ Celem.t2str thy ct ^ " = NONE")
23.190 + val _ = trace1 i (" cal1. to: " ^ Celem.t2str thy ((fst o the) pairopt))
23.191 in the pairopt end
23.192 end
23.193 - | Rls_ rls' =>
23.194 + | Celem.Rls_ rls' =>
23.195 (case rewrite__set_ thy (i + 1) put_asm bdv rls' ct of
23.196 SOME (t', asm') => rew_once ruls (union (op =) asm asm') t' Appl thms
23.197 | NONE => rew_once ruls asm ct apno thms)
23.198 - | r => raise ERROR ("rew_once not appl. to \"" ^ rule2str r ^ "\"");
23.199 - val ruls = (#rules o rep_rls) rls;
23.200 - val _ = trace i (" rls: " ^ id_rls rls ^ " on: " ^ t2str thy ct)
23.201 + | r => raise ERROR ("rew_once not appl. to \"" ^ Celem.rule2str r ^ "\"");
23.202 + val ruls = (#rules o Celem.rep_rls) rls;
23.203 + val _ = trace i (" rls: " ^ Celem.id_rls rls ^ " on: " ^ Celem.t2str thy ct)
23.204 val (ct', asm') = rew_once ruls [] ct Noap ruls;
23.205 in if ct = ct' then NONE else SOME (ct', distinct asm') end
23.206 +(*------------------------
23.207 +-------------------------------------*)
23.208 and app_rev thy i rrls t = (* apply an Rrls; if not applicable proceed with subterms *)
23.209 let (* check a (precond, pattern) of a rev-set; stops with 1st true *)
23.210 fun chk_prepat _ _ [] _ = true
23.211 @@ -197,9 +203,9 @@
23.212 if f pp then true else scan_ f pps;
23.213 in scan_ chk prepat end;
23.214 (* apply the normal_form of a rev-set *)
23.215 - fun app_rev' thy (Rrls {erls, prepat, scr = Rfuns {normal_form, ...}, ...}) t =
23.216 + fun app_rev' thy (Celem.Rrls {erls, prepat, scr = Celem.Rfuns {normal_form, ...}, ...}) t =
23.217 if chk_prepat thy erls prepat t then normal_form t else NONE
23.218 - | app_rev' _ r _ = raise ERROR ("app_rev' not appl. to \"" ^ rls2str r ^ "\"");
23.219 + | app_rev' _ r _ = raise ERROR ("app_rev' not appl. to \"" ^ Celem.rls2str r ^ "\"");
23.220 val opt = app_rev' thy rrls t
23.221 in
23.222 case opt of
23.223 @@ -252,8 +258,8 @@
23.224 then rew_ (t'', asm' @ asm'') rules t''
23.225 else rew_ (t', asm') rs t'
23.226 end
23.227 - val (t'', asm'') = rew_ (e_term, []) equs t
23.228 - in if t'' = e_term then NONE else SOME (t'', asm'')
23.229 + val (t'', asm'') = rew_ (Celem.e_term, []) equs t
23.230 + in if t'' = Celem.e_term then NONE else SOME (t'', asm'')
23.231 end;
23.232
23.233 (* search ct for adjacent numerals and calculate them by operator isa_fn *)
23.234 @@ -262,7 +268,7 @@
23.235 in case Calc.adhoc_thm thy isa_fn ct of
23.236 NONE => NONE
23.237 | SOME (thmID, thm) =>
23.238 - (let val rew = case rewrite_ thy dummy_ord e_rls false thm ct of
23.239 + (let val rew = case rewrite_ thy Celem.dummy_ord Celem.e_rls false thm ct of
23.240 SOME (rew, _) => rew
23.241 | NONE => raise ERROR ""
23.242 in SOME (rew, (thmID, thm)) end)
23.243 @@ -312,15 +318,15 @@
23.244 then mk_thm thy ct'
23.245 else thmid |> convert_metaview_to_thmid thy |> TermC.num_str
23.246 ) handle _ (*TODO: find exn behind ERROR: Undefined fact: "add_commute"*) =>
23.247 - error ("assoc_thm': \"" ^ thmid ^ "\" not in \"" ^ theory2domID thy ^ "\" (and parents)")
23.248 + error ("assoc_thm': \"" ^ thmid ^ "\" not in \"" ^ Celem.theory2domID thy ^ "\" (and parents)")
23.249
23.250 fun eval_listexpr_ thy srls t =
23.251 let val rew = rewrite_set_ thy false srls t;
23.252 in case rew of SOME (res,_) => res | NONE => t end;
23.253
23.254 fun eval_true_ _ _ (Const ("HOL.True",_)) = true
23.255 - | eval_true_ (thy':theory') rls t =
23.256 - case rewrite_set_ (assoc_thy thy') false rls t of
23.257 + | eval_true_ thy' rls t =
23.258 + case rewrite_set_ (Celem.assoc_thy thy') false rls t of
23.259 SOME (Const ("HOL.True",_),_) => true
23.260 | _ => false;
23.261
24.1 --- a/src/Tools/isac/ProgLang/scrtools.sml Tue Mar 13 15:04:27 2018 +0100
24.2 +++ b/src/Tools/isac/ProgLang/scrtools.sml Thu Mar 15 10:17:44 2018 +0100
24.3 @@ -7,7 +7,7 @@
24.4 datatype stacexpr = Expr of term | STac of term
24.5 val rep_stacexpr: stacexpr -> term
24.6 val subst_stacexpr: (term * term) list -> term option -> term -> term -> term option * stacexpr
24.7 - val contain_bdv: rule list -> bool
24.8 + val contain_bdv: Celem.rule list -> bool
24.9 val contains_bdv: thm -> bool
24.10 type env = (term * term) list
24.11 val upd_env: env -> term * term -> env
24.12 @@ -17,14 +17,14 @@
24.13 val is_list_dsc: term -> bool
24.14 val is_reall_dsc: term -> bool
24.15 val is_unl: term -> bool
24.16 - val pblterm: domID -> pblID -> term
24.17 + val pblterm: Celem.domID -> Celem.pblID -> term
24.18 val subpbl: string -> string list -> term
24.19 val stacpbls: term -> term list
24.20 val one_scr_arg: term -> term
24.21 val two_scr_arg: term -> term * term
24.22 val op_of_calc: term -> string
24.23 - val get_calcs: theory -> term -> (prog_calcID * (calID * eval_fn)) list
24.24 - val prep_rls: theory -> rls -> rls
24.25 + val get_calcs: theory -> term -> (Celem.prog_calcID * (Celem.calID * Celem.eval_fn)) list
24.26 + val prep_rls: theory -> Celem.rls -> Celem.rls
24.27 (* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
24.28 (* NONE *)
24.29 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
24.30 @@ -75,15 +75,15 @@
24.31 fun subpbl domID pblID =
24.32 subpbl_t $ (pair_t $ Free (domID, ID_type) $
24.33 (((TermC.list2isalist ID_type) o (map (TermC.mk_free ID_type))) pblID));
24.34 -fun pblterm (domID:domID) (pblID:pblID) =
24.35 +fun pblterm domID pblID =
24.36 pbl_t $ (pair_t $ Free (domID,ID_type) $
24.37 (((TermC.list2isalist ID_type) o (map (TermC.mk_free ID_type))) pblID));
24.38
24.39 (* construct scr-env from scr(created automatically) and Rewrite_Set *)
24.40 fun one_scr_arg (Const _ $ arg $ _) = arg
24.41 - | one_scr_arg t = error ("one_scr_arg: called by " ^ term2str t);
24.42 + | one_scr_arg t = error ("one_scr_arg: called by " ^ Celem.term2str t);
24.43 fun two_scr_arg (Const _ $ a1 $ a2 $ _) = (a1, a2)
24.44 - | two_scr_arg t = error ("two_scr_arg: called by " ^ term2str t);
24.45 + | two_scr_arg t = error ("two_scr_arg: called by " ^ Celem.term2str t);
24.46
24.47
24.48 (** generate a "type calc" from a script **)
24.49 @@ -103,13 +103,13 @@
24.50 datatype stacexpr = STac of term | Expr of term
24.51 fun rep_stacexpr (STac t ) = t
24.52 | rep_stacexpr (Expr t) =
24.53 - error ("rep_stacexpr called with t= "^(term2str t));
24.54 + error ("rep_stacexpr called with t= " ^ Celem.term2str t);
24.55
24.56 type env = (term * term) list;
24.57
24.58 (* update environment; t <> empty if coming from listexpr *)
24.59 fun upd_env (env:env) (v,t) =
24.60 - let val env' = if t = e_term then env else overwrite (env,(v,t));
24.61 + let val env' = if t = Celem.e_term then env else overwrite (env,(v,t));
24.62 in env' end;
24.63
24.64 (* substitute the script's environment in a leaf of the script's parse-tree
24.65 @@ -189,10 +189,10 @@
24.66 | scan (Const ("Script.Or", _) $ e1 $ e2) = (scan e1) @ (scan e2)
24.67 | scan (Const ("Script.Seq", _) $ e1 $ e2 $ _) = (scan e1) @ (scan e2)
24.68 | scan (Const ("Script.Seq", _) $ e1 $ e2) = (scan e1) @ (scan e2)
24.69 - | scan t = case subst_stacexpr [] NONE e_term t of
24.70 + | scan t = case subst_stacexpr [] NONE Celem.e_term t of
24.71 (_, STac _) => [t] | (_, Expr _) => []
24.72 in (distinct o scan) body end
24.73 - | stacpbls t = raise ERROR ("fun stacpbls not applicable to '" ^ term2str t ^ "'")
24.74 + | stacpbls t = raise ERROR ("fun stacpbls not applicable to '" ^ Celem.term2str t ^ "'")
24.75
24.76 (* get operators out of a program *)
24.77 fun is_calc (Const ("Script.Calculate",_) $ _) = true
24.78 @@ -200,7 +200,7 @@
24.79 | is_calc _ = false;
24.80 fun op_of_calc (Const ("Script.Calculate",_) $ Free (op_,_)) = op_
24.81 | op_of_calc (Const ("Script.Calculate",_) $ Free (op_,_) $ _) = op_
24.82 - | op_of_calc t = error ("op_of_calc called with" ^ term2str t);
24.83 + | op_of_calc t = error ("op_of_calc called with" ^ Celem.term2str t);
24.84 fun get_calcs thy sc =
24.85 sc
24.86 |> stacpbls
24.87 @@ -249,82 +249,82 @@
24.88 \ (Try (Repeat (Rewrite add_commute False))) @@ \
24.89 \ (Try (Repeat (Rewrite mult_commute False)))) t";
24.90
24.91 -fun rule2stac _ (Thm (thmID, _)) = Try $ (Repeat $ (Rew $ Free (thmID, IDtype) $ @{term False}))
24.92 - | rule2stac thy (Calc (c, _)) = Try $ (Repeat $ (Cal $ Free (assoc_calc thy c, IDtype)))
24.93 - | rule2stac thy (Cal1 (c, _)) = Try $ (Repeat $ (Ca1 $ Free (assoc_calc thy c, IDtype)))
24.94 - | rule2stac _ (Rls_ rls) = Try $ (Rew_Set $ Free (id_rls rls, IDtype) $ @{term False})
24.95 - | rule2stac _ r = raise ERROR ("rule2stac: not applicable to \"" ^ rule2str r ^ "\"");
24.96 -fun rule2stac_inst _ (Thm (thmID, _)) =
24.97 +fun rule2stac _ (Celem.Thm (thmID, _)) = Try $ (Repeat $ (Rew $ Free (thmID, IDtype) $ @{term False}))
24.98 + | rule2stac thy (Celem.Calc (c, _)) = Try $ (Repeat $ (Cal $ Free (assoc_calc thy c, IDtype)))
24.99 + | rule2stac thy (Celem.Cal1 (c, _)) = Try $ (Repeat $ (Ca1 $ Free (assoc_calc thy c, IDtype)))
24.100 + | rule2stac _ (Celem.Rls_ rls) = Try $ (Rew_Set $ Free (Celem.id_rls rls, IDtype) $ @{term False})
24.101 + | rule2stac _ r = raise ERROR ("rule2stac: not applicable to \"" ^ Celem.rule2str r ^ "\"");
24.102 +fun rule2stac_inst _ (Celem.Thm (thmID, _)) =
24.103 Try $ (Repeat $ (Rew_Inst $ Subs $ Free (thmID, IDtype) $
24.104 @{term False}))
24.105 - | rule2stac_inst thy (Calc (c, _)) =
24.106 + | rule2stac_inst thy (Celem.Calc (c, _)) =
24.107 Try $ (Repeat $ (Cal $ Free (assoc_calc thy c, IDtype)))
24.108 - | rule2stac_inst thy (Cal1 (c, _)) =
24.109 + | rule2stac_inst thy (Celem.Cal1 (c, _)) =
24.110 Try $ (Repeat $ (Cal $ Free (assoc_calc thy c, IDtype)))
24.111 - | rule2stac_inst _ (Rls_ rls) =
24.112 - Try $ (Rew_Set_Inst $ Subs $ Free (id_rls rls, IDtype) $
24.113 + | rule2stac_inst _ (Celem.Rls_ rls) =
24.114 + Try $ (Rew_Set_Inst $ Subs $ Free (Celem.id_rls rls, IDtype) $
24.115 @{term False})
24.116 - | rule2stac_inst _ r = raise ERROR ("rule2stac_inst: not applicable to \"" ^ rule2str r ^ "\"");
24.117 + | rule2stac_inst _ r = raise ERROR ("rule2stac_inst: not applicable to \"" ^ Celem.rule2str r ^ "\"");
24.118
24.119 (*for appropriate nesting take stacs in _reverse_ order*)
24.120 fun op @@@ sts [s] = SEq $ s $ sts
24.121 | op @@@ sts (s::ss) = op @@@ (SEq $ s $ sts) ss
24.122 | op @@@ t ts =
24.123 - raise ERROR ("fun @@@ not applicable to \"" ^ term2str t ^ "\" \"" ^ terms2str ts ^ "\"");
24.124 + raise ERROR ("fun @@@ not applicable to \"" ^ Celem.term2str t ^ "\" \"" ^ Celem.terms2str ts ^ "\"");
24.125 fun @@ [stac] = stac
24.126 | @@ [s1, s2] = SEq $ s1 $ s2
24.127 | @@ stacs = case rev stacs of
24.128 s3 :: s2 :: ss => op @@@ (SEq $ s2 $ s3) ss
24.129 - | ts => raise ERROR ("fun @@ not applicable to \"" ^ terms2str ts ^ "\"")
24.130 + | ts => raise ERROR ("fun @@ not applicable to \"" ^ Celem.terms2str ts ^ "\"")
24.131
24.132 val contains_bdv = (not o null o (filter TermC.is_bdv) o TermC.ids2str o #prop o Thm.rep_thm);
24.133
24.134 (* does a rule contain a 'bdv'; descend recursively into Rls_ *)
24.135 fun contain_bdv [] = false
24.136 - | contain_bdv (Thm (_, thm) :: rs) =
24.137 + | contain_bdv (Celem.Thm (_, thm) :: rs) =
24.138 if (not o contains_bdv) thm
24.139 then contain_bdv rs
24.140 else true
24.141 - | contain_bdv (Calc _ :: rs) = contain_bdv rs
24.142 - | contain_bdv (Cal1 _ :: rs) = contain_bdv rs
24.143 - | contain_bdv (Rls_ rls :: rs) =
24.144 - contain_bdv (get_rules rls) orelse contain_bdv rs
24.145 + | contain_bdv (Celem.Calc _ :: rs) = contain_bdv rs
24.146 + | contain_bdv (Celem.Cal1 _ :: rs) = contain_bdv rs
24.147 + | contain_bdv (Celem.Rls_ rls :: rs) =
24.148 + contain_bdv (Celem.get_rules rls) orelse contain_bdv rs
24.149 | contain_bdv (r :: _) =
24.150 - error ("contain_bdv called with [" ^ id_rule r ^ ",...]");
24.151 + error ("contain_bdv called with [" ^ Celem.id_rule r ^ ",...]");
24.152
24.153 fun rules2scr_Rls thy rules = (*WN100816 t_ -> t_t like "Script Stepwise..*)
24.154 if contain_bdv rules
24.155 - then ScrStep_inst $ Term $ Bdv $ (Repeat $ (((@@ o (map (rule2stac_inst thy))) rules) $ e_term))
24.156 - else ScrStep $ Term $ (Repeat $ (((@@ o (map (rule2stac thy))) rules) $ e_term));
24.157 + then ScrStep_inst $ Term $ Bdv $ (Repeat $ (((@@ o (map (rule2stac_inst thy))) rules) $ Celem.e_term))
24.158 + else ScrStep $ Term $ (Repeat $ (((@@ o (map (rule2stac thy))) rules) $ Celem.e_term));
24.159 fun rules2scr_Seq thy rules = (*WN100816 t_ -> t_t like "Script Stepwise..*)
24.160 if contain_bdv rules
24.161 then ScrStep_inst $ Term $ Bdv $
24.162 - (((@@ o (map (rule2stac_inst thy))) rules) $ e_term)
24.163 + (((@@ o (map (rule2stac_inst thy))) rules) $ Celem.e_term)
24.164 else ScrStep $ Term $
24.165 - (((@@ o (map (rule2stac thy))) rules) $ e_term);
24.166 + (((@@ o (map (rule2stac thy))) rules) $ Celem.e_term);
24.167
24.168 (* prepare the input for an rls for use:
24.169 # generate a script for stepwise execution of the rls
24.170 # filter the operators for Calc out of the script ?WN111014?
24.171 !!!use this function while storing by or integrate into KEStore_Elems.add_rlss.*)
24.172 -fun prep_rls _ Erls = error "prep_rls' not impl. for Erls"
24.173 - | prep_rls thy (Rls {id, preconds, rew_ord, erls, srls, rules, errpatts, ...}) =
24.174 +fun prep_rls _ Celem.Erls = error "prep_rls' not impl. for Erls"
24.175 + | prep_rls thy (Celem.Rls {id, preconds, rew_ord, erls, srls, rules, errpatts, ...}) =
24.176 let val sc = (rules2scr_Rls thy rules)
24.177 - in Rls {id = id, preconds = preconds, rew_ord = rew_ord, erls = erls,
24.178 + in Celem.Rls {id = id, preconds = preconds, rew_ord = rew_ord, erls = erls,
24.179 srls = srls,
24.180 calc = get_calcs thy sc,
24.181 rules = rules,
24.182 errpatts=errpatts,
24.183 - scr = Prog sc} end
24.184 - | prep_rls thy (Seq {id, preconds, rew_ord, erls, srls, rules, errpatts, ...}) =
24.185 + scr = Celem.Prog sc} end
24.186 + | prep_rls thy (Celem.Seq {id, preconds, rew_ord, erls, srls, rules, errpatts, ...}) =
24.187 let val sc = (rules2scr_Seq thy rules)
24.188 - in Seq {id = id, preconds = preconds, rew_ord = rew_ord, erls = erls,
24.189 + in Celem.Seq {id = id, preconds = preconds, rew_ord = rew_ord, erls = erls,
24.190 srls = srls,
24.191 calc = get_calcs thy sc,
24.192 rules = rules,
24.193 errpatts = errpatts,
24.194 - scr = Prog sc} end
24.195 - | prep_rls _ (Rrls {id, ...}) =
24.196 + scr = Celem.Prog sc} end
24.197 + | prep_rls _ (Celem.Rrls {id, ...}) =
24.198 error ("prep_rls' not required for Rrls \"" ^ id ^ "\"");
24.199
24.200 end
24.201 \ No newline at end of file
25.1 --- a/src/Tools/isac/ProgLang/termC.sml Tue Mar 13 15:04:27 2018 +0100
25.2 +++ b/src/Tools/isac/ProgLang/termC.sml Thu Mar 15 10:17:44 2018 +0100
25.3 @@ -74,7 +74,7 @@
25.4 val atomty: term -> unit
25.5 val atomw: term -> unit
25.6 val atomwy: term -> unit
25.7 - val atomty_thy: thyID -> term -> unit
25.8 + val atomty_thy: Celem.thyID -> term -> unit
25.9 val free2var: term -> term
25.10 (*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
25.11 val atomt: term -> unit
25.12 @@ -150,28 +150,28 @@
25.13
25.14 fun term_detail2str t =
25.15 let
25.16 - fun ato (Const (a, T)) n = "\n*** " ^ indent n ^ "Const (" ^ a ^ ", " ^ string_of_typ T ^ ")"
25.17 - | ato (Free (a, T)) n = "\n*** " ^ indent n ^ "Free (" ^ a ^ ", " ^ string_of_typ T ^ ")"
25.18 + fun ato (Const (a, T)) n = "\n*** " ^ indent n ^ "Const (" ^ a ^ ", " ^ Celem.string_of_typ T ^ ")"
25.19 + | ato (Free (a, T)) n = "\n*** " ^ indent n ^ "Free (" ^ a ^ ", " ^ Celem.string_of_typ T ^ ")"
25.20 | ato (Var ((a, i), T)) n =
25.21 - "\n*** " ^ indent n ^ "Var ((" ^ a ^ ", " ^ string_of_int i ^ "), " ^ string_of_typ T ^ ")"
25.22 + "\n*** " ^ indent n ^ "Var ((" ^ a ^ ", " ^ string_of_int i ^ "), " ^ Celem.string_of_typ T ^ ")"
25.23 | ato (Bound i) n = "\n*** " ^ indent n ^ "Bound " ^ string_of_int i
25.24 | ato (Abs(a, T, body)) n =
25.25 - "\n*** " ^ indent n ^ "Abs (" ^ a ^ ", " ^ string_of_typ T ^ ",.." ^ ato body (n + 1)
25.26 + "\n*** " ^ indent n ^ "Abs (" ^ a ^ ", " ^ Celem.string_of_typ T ^ ",.." ^ ato body (n + 1)
25.27 | ato (f $ t) n = ato f n ^ ato t (n + 1)
25.28 in "\n*** " ^ ato t 0 ^ "\n***" end;
25.29 fun term_detail2str_thy thy t =
25.30 let
25.31 fun ato (Const (a, T)) n =
25.32 - "\n*** " ^ indent n ^ "Const (" ^ a ^ ", " ^ string_of_typ_thy thy T ^ ")"
25.33 + "\n*** " ^ indent n ^ "Const (" ^ a ^ ", " ^ Celem.string_of_typ_thy thy T ^ ")"
25.34 | ato (Free (a, T)) n =
25.35 - "\n*** " ^ indent n ^ "Free (" ^ a ^ ", " ^ string_of_typ_thy thy T ^ ")"
25.36 + "\n*** " ^ indent n ^ "Free (" ^ a ^ ", " ^ Celem.string_of_typ_thy thy T ^ ")"
25.37 | ato (Var ((a, i), T)) n =
25.38 "\n*** " ^ indent n ^ "Var ((" ^ a ^ ", " ^ string_of_int i ^ "), " ^
25.39 - string_of_typ_thy thy T ^ ")"
25.40 + Celem.string_of_typ_thy thy T ^ ")"
25.41 | ato (Bound i) n =
25.42 "\n*** " ^ indent n ^ "Bound " ^ string_of_int i
25.43 | ato (Abs(a, T, body)) n =
25.44 - "\n*** " ^ indent n ^ "Abs (" ^ a ^ ", " ^ string_of_typ_thy thy T ^ ",.." ^
25.45 + "\n*** " ^ indent n ^ "Abs (" ^ a ^ ", " ^ Celem.string_of_typ_thy thy T ^ ",.." ^
25.46 ato body (n + 1)
25.47 | ato (f $ t) n = ato f n ^ ato t (n + 1)
25.48 in "\n*** " ^ ato t 0 ^ "\n***" end;
25.49 @@ -250,7 +250,7 @@
25.50 | is_bdv_subst _ = false;
25.51
25.52 fun free2str (Free (s, _)) = s
25.53 - | free2str t = error ("free2str not for " ^ term2str t);
25.54 + | free2str t = error ("free2str not for " ^ Celem.term2str t);
25.55 fun str_of_free_opt (Free (s, _)) = SOME s
25.56 | str_of_free_opt _ = NONE
25.57
25.58 @@ -277,7 +277,7 @@
25.59
25.60 fun isapair2pair (Const ("Product_Type.Pair",_) $ a $ b) = (a, b)
25.61 | isapair2pair t =
25.62 - error ("isapair2pair called with "^term2str t);
25.63 + error ("isapair2pair called with " ^ Celem.term2str t);
25.64 fun isalist2list ls =
25.65 let
25.66 fun get es (Const("List.list.Cons", _) $ t $ ls) = get (t :: es) ls
25.67 @@ -480,11 +480,11 @@
25.68 WN130613 probably compare to
25.69 http://www.mail-archive.com/isabelle-dev@mailbroy.informatik.tu-muenchen.de/msg04249.html*)
25.70 fun parse_patt thy str =
25.71 - (thy, str) |>> thy2ctxt
25.72 + (thy, str) |>> Celem.thy2ctxt
25.73 |-> Proof_Context.read_term_pattern
25.74 |> numbers_to_string (*TODO drop*)
25.75 |> typ_a2real; (*TODO drop*)
25.76 -fun str2term str = parse_patt (Thy_Info_get_theory "Isac") str
25.77 +fun str2term str = parse_patt (Celem.Thy_Info_get_theory "Isac") str
25.78
25.79 (* TODO decide with Test_Isac *)
25.80 fun is_atom t = length (vars t) = 1
26.1 --- a/src/Tools/isac/calcelems.sml Tue Mar 13 15:04:27 2018 +0100
26.2 +++ b/src/Tools/isac/calcelems.sml Thu Mar 15 10:17:44 2018 +0100
26.3 @@ -1,16 +1,272 @@
26.4 (* elements of calculations.
26.5 they are partially held in association lists as ref's for
26.6 - switching language levels (meta-string, object-values).
26.7 - in order to keep these ref's during re-evaluation of code,
26.8 + switching language levels (meta-string, object-values).
26.9 + in order to keep these ref's during re-evaluation of code,
26.10 they are defined here at the beginning of the code.
26.11 Author: Walther Neuper 2003
26.12 (c) copyright due to lincense terms
26.13 *)
26.14
26.15 -(*
26.16 -structure CalcElems =
26.17 +signature CALC_ELEMENT =
26.18 + sig
26.19 + type eval_fn (*= string -> term -> theory -> (string * term) option*)
26.20 + type rew_ord (*= rew_ord' * rew_ord_*)
26.21 + eqtype errpatID
26.22 + type calc (*= prog_calcID * cal*)
26.23 + datatype rule = Cal1 of string * eval_fn | Calc of string * eval_fn | Erule | Rls_ of rls
26.24 + | Thm of string * thm
26.25 + and scr
26.26 + = EmptyScr
26.27 + | Prog of term
26.28 + | Rfuns of
26.29 + {attach_form: rule list list -> term -> term -> (rule * (term * term list)) list,
26.30 + init_state: term -> term * term * rule list list * (rule * (term * term list)) list,
26.31 + locate_rule: rule list list -> term -> rule -> (rule * (term * term list)) list,
26.32 + next_rule: rule list list -> term -> rule option,
26.33 + normal_form: term -> (term * term list) option}
26.34 + and rls =
26.35 + Erls
26.36 + | Rls of {calc: calc list, erls: rls, errpatts: errpatID list, id: string, preconds: term list,
26.37 + rew_ord: rew_ord, rules: rule list, scr: scr, srls: rls}
26.38 + | Rrls of {calc: calc list, erls: rls, errpatts: errpatID list,
26.39 + id: string, prepat: (term list * term) list, rew_ord: rew_ord, scr: scr}
26.40 + | Seq of {calc: calc list, erls: rls, errpatts: errpatID list, id: string, preconds: term list,
26.41 + rew_ord: rew_ord, rules: rule list, scr: scr, srls: rls}
26.42 +
26.43 + eqtype rls'
26.44 + eqtype theory'
26.45 + eqtype prog_calcID
26.46 + eqtype calID
26.47 + type cas_elem (*= term * (spec * generate_fn)*)
26.48 + type pbt (*= {cas: term option, guh: guh, init: pblID, mathauthors: string list,
26.49 + met: metID list, ppc: pat list, prls: rls, thy: theory, where_: term list}*)
26.50 + type ptyps (*= pbt ptyp list*)
26.51 + type metID (*= string list*)
26.52 + type pblID (*= string list*)
26.53 + type mets (*= met ptyp list*)
26.54 + type met (*= {calc: calc list,
26.55 + crls: rls, erls: rls, errpats: errpat list, guh: guh, init: pblID, mathauthors: string list,
26.56 + nrls: rls, ppc: pat list, pre: term list, prls: rls, rew_ord': rew_ord', scr: scr, srls: rls}*)
26.57 + datatype 'a ptyp = Ptyp of string * 'a list * 'a ptyp list
26.58 +
26.59 + type cal = calID * eval_fn
26.60 + type authors (*= string list*)
26.61 + type guh
26.62 + type subst (*= (term * term) list*)
26.63 + eqtype thyID
26.64 + type fillpat (*= fillpatID * term * errpatID*)
26.65 + datatype thydata
26.66 + = Hcal of {calc: calc, coursedesign: authors, guh: guh, mathauthors: authors}
26.67 + | Hord of {coursedesign: authors, guh: guh, mathauthors: authors, ord: subst -> term * term -> bool}
26.68 + | Hrls of {coursedesign: authors, guh: guh, mathauthors: authors, thy_rls: thyID * rls}
26.69 + | Hthm of {coursedesign: authors, fillpats: fillpat list, guh: guh, mathauthors: authors, thm: thm}
26.70 + | Html of {coursedesign: authors, guh: guh, html: string, mathauthors: authors}
26.71 + type theID (*= string list*)
26.72 + type rlss_elem (*= rls' * (theory' * rls)*)
26.73 + val merge_rlss: rlss_elem list * rlss_elem list -> rlss_elem list
26.74 + val rls_eq: (''a * ('b * 'c)) * (''a * ('d * 'e)) -> bool
26.75 + type calc_elem (*= prog_calcID * (calID * eval_fn)*)
26.76 + val calc_eq: calc_elem * calc_elem -> bool
26.77 + type spec (*= domID * pblID * metID*)
26.78 + val cas_eq: cas_elem * cas_elem -> bool
26.79 + val e_Ptyp: pbt ptyp
26.80 + val merge_ptyps: 'a ptyp list * 'a ptyp list -> 'a ptyp list
26.81 + val check_guhs_unique: bool Unsynchronized.ref
26.82 + val check_pblguh_unique: guh -> pbt ptyp list -> unit
26.83 + val insrt: pblID -> 'a -> string list -> 'a ptyp list -> 'a ptyp list
26.84 + val e_Mets: met ptyp
26.85 + val check_metguh_unique: guh -> met ptyp list -> unit
26.86 + val add_thydata: string list * string list -> thydata -> thydata ptyp list -> thydata ptyp list
26.87 + val get_py: 'a ptyp list -> pblID -> string list -> 'a
26.88 + val update_hthm: thydata -> fillpat list -> thydata
26.89 + val update_ptyps: string list -> string list -> 'a -> 'a ptyp list -> 'a ptyp list
26.90 + val e_rls: rls
26.91 + val e_rrls: rls
26.92 + val part2guh: theID -> guh
26.93 + val spec2str: string * string list * string list -> string
26.94 + val term_to_string''': theory -> term -> string
26.95 + val linefeed: string -> string
26.96 + val pbts2str: pbt list -> string
26.97 + val thes2str: thydata list -> string
26.98 + val theID2str: string list -> string
26.99 + val the2str: thydata -> string
26.100 + val Thy_Info_get_theory: string -> theory
26.101 + val string_of_typ: typ -> string
26.102 + val string_of_typ_thy: thyID -> typ -> string
26.103 + val term2str: term -> string
26.104 + val thy2ctxt: theory -> Proof.context
26.105 + val trace_calc: bool Unsynchronized.ref
26.106 + eqtype thmID
26.107 + type thm' (*= thmID * cterm'*)
26.108 + datatype lrd = D | L | R
26.109 + val trace_rewrite: bool Unsynchronized.ref
26.110 + val depth: int Unsynchronized.ref
26.111 + val t2str: theory -> term -> string
26.112 + val ts2str: theory -> term list -> string
26.113 + val terms2str: term list -> string
26.114 + val id_rls: rls -> string
26.115 + val rls2str: rls -> string
26.116 + val rep_rls: rls -> {calc: calc list, erls: rls, id: string, preconds: term list, rew_ord: rew_ord, rules: rule list, scr: scr, srls: rls}
26.117 + val string_of_thmI: thm -> string
26.118 + val rule2str: rule -> string
26.119 + val e_term: term
26.120 + val dummy_ord: subst -> term * term -> bool
26.121 + val theory2domID: theory -> theory'
26.122 + val assoc_thy: theory' -> theory
26.123 + val append_rls: string -> rls -> rule list -> rls
26.124 + eqtype domID
26.125 + val get_rules: rls -> rule list
26.126 + val id_rule: rule -> string
26.127 + eqtype cterm'
26.128 + val term_to_string': Proof.context -> term -> string
26.129 + val thy2ctxt': string -> Proof.context
26.130 + type rrlsstate = term * term * rule list list * (rule * (term * term list)) list
26.131 + type loc_ = lrd list
26.132 + val loc_2str: loc_ -> string
26.133 + val e_spec: spec
26.134 + val env2str: subst -> string
26.135 + val subst2str: subst -> string
26.136 + val termopt2str: term option -> string
26.137 + eqtype rew_ord'
26.138 + type thm'' (*= thmID * thm*)
26.139 + type rew_ord_ (*= subst -> term * term -> bool*)
26.140 + val metID2str: string list -> string
26.141 + val e_domID: domID
26.142 + val e_pblID: pblID
26.143 + val e_metID: metID
26.144 + val empty_spec: spec
26.145 + datatype ketype = Exp_ | Met_ | Pbl_ | Thy_
26.146 + type kestoreID (*= string list*)
26.147 + type errpat (*= errpatID * term list * thm list*)
26.148 + val app_py: 'a ptyp list -> ('a ptyp -> 'b) -> pblID -> string list -> 'b
26.149 + val ketype2str: ketype -> string
26.150 + val coll_pblguhs: pbt ptyp list -> guh list
26.151 + val coll_metguhs: met ptyp list -> guh list
26.152 + type pat (*= string * (term * term)*)
26.153 + val e_type: typ
26.154 + val theory2str: theory -> theory'
26.155 + val pats2str: pat list -> string
26.156 + val string_of_thy: theory -> theory'
26.157 + val theory2theory': theory -> theory'
26.158 + val maxthy: theory -> theory -> theory
26.159 + val e_evalfn: 'a -> term -> theory -> (string * term) option
26.160 + val assoc_rew_ord: string -> subst -> term * term -> bool
26.161 + eqtype filename
26.162 + val rule2str': rule -> string
26.163 + val lim_deriv: int Unsynchronized.ref
26.164 + val id_of_thm: rule -> string
26.165 + val isabthys: unit -> theory list
26.166 + val thyID_of_derivation_name: string -> string
26.167 + val partID': theory' -> string
26.168 + val Isac: 'a -> theory
26.169 + val theory'2thyID: theory' -> theory'
26.170 + val thm2guh: string * thyID -> thmID -> guh
26.171 + val thmID_of_derivation_name: string -> string
26.172 + val rls2guh: string * thyID -> rls' -> guh
26.173 + val eq_rule: rule * rule -> bool
26.174 + val e_rew_ordX: rew_ord
26.175 + val theID2guh: theID -> guh
26.176 + val thyID2theory': thyID -> thyID
26.177 + val e_rule: rule
26.178 + val scr2str: scr -> string
26.179 + val type2str: typ -> string
26.180 + eqtype fillpatID
26.181 + type pbt_ = string * (term * term)
26.182 + val e_rew_ord: subst -> term * term -> bool
26.183 + eqtype xml
26.184 + val cal2guh: string * thyID -> string -> guh
26.185 + val ketype2str': ketype -> string
26.186 + val str2ketype': string -> ketype
26.187 + val thmID_of_derivation_name': thm -> string
26.188 + val subst2str': subst -> string
26.189 + eqtype path
26.190 + val theID2thyID: theID -> thyID
26.191 + val thy2guh: theID -> guh
26.192 + val theory2thyID: theory -> thyID
26.193 + val thypart2guh: theID -> guh
26.194 + val ord2guh: string * thyID -> rew_ord' -> guh
26.195 + val update_hrls: thydata -> errpatID list -> thydata
26.196 + eqtype iterID
26.197 + eqtype calcID
26.198 + val thm''_of_thm: thm -> thm''
26.199 + val rew_ord': (rew_ord' * (subst -> term * term -> bool)) list Unsynchronized.ref
26.200 +
26.201 +(*---------------------- ^^^ make public on a minimalist way down to Build?Isac -----------------
26.202 + val Html_default: theID -> thydata
26.203 + val a_term: term
26.204 + val a_type: typ
26.205 + val assoc': (string * 'a) list * string -> 'a option
26.206 + type generate_fn = term list -> (term * term list) list
26.207 + val e_guh: guh
26.208 + val e_kestoreID: string list
26.209 + val e_met: met
26.210 + val e_pbt: pbt
26.211 + val e_pbt_: pbt_
26.212 + val e_rew_ord': rew_ord'
26.213 + val e_rew_ord_: subst -> term * term -> bool
26.214 + val e_rfuns: scr
26.215 + val e_rrlsstate: rrlsstate
26.216 + val e_scr: scr
26.217 + val e_subst: (term * term) list
26.218 + val e_theID: string list
26.219 + val e_thydata: thydata
26.220 + val empty_cterm': string
26.221 + val eq_thmI: (thmID * thm) * (thmID * 'a) -> bool
26.222 + val eq_thmI': (string * 'a) * (string * 'b) -> bool
26.223 + val eqrule: rule * rule -> bool
26.224 + val fill_parents: string list * string list -> thydata -> thydata ptyp
26.225 + val insert_fillpats: thydata ptyp list -> (pblID * fillpat list) list -> thydata ptyp list -> thydata ptyp list
26.226 + val insert_merge_rls: rlss_elem -> rlss_elem list -> rlss_elem list
26.227 + val insthy: 'a -> 'b * 'c -> 'b * ('a * 'c)
26.228 + val kestoreID2str: string list -> string
26.229 + val knowthys: unit -> theory list
26.230 + val ldr2str: lrd -> string
26.231 + val lim_rewrite: int Unsynchronized.ref
26.232 + val memrls: rule -> rls -> bool
26.233 + val merge_ids: rls -> rls -> string
26.234 + val merge_ptyps': 'a ptyp list -> 'a ptyp list -> 'a ptyp list
26.235 + val merge_rls: string -> rls -> rls -> rls
26.236 + val overwritelthy: theory -> (rls' * (string * rls)) list * (rls' * rls) list -> (rls' * (string * rls)) list
26.237 + val partID: theory -> string
26.238 + val pat2str: pat -> string
26.239 + val pblID2str: string list -> string
26.240 + val pbt2str: pbt -> string
26.241 + val progthys: unit -> theory list
26.242 + val remove_rls: string -> rls -> rule list -> rls
26.243 + val rep_rrls:
26.244 + rls -> {attach_form: rule list list -> term -> term -> (rule * (term * term list)) list,
26.245 + calc: calc list,
26.246 + erls: rls,
26.247 + errpatts: errpatID list,
26.248 + id: string,
26.249 + init_state: term -> term * term * rule list list * (rule * (term * term list)) list,
26.250 + locate_rule: rule list list -> term -> rule -> (rule * (term * term list)) list,
26.251 + next_rule: rule list list -> term -> rule option, normal_form: term -> (term * term list) option, prepat: (term list * term) list, rew_ord: rew_ord}
26.252 + val rep_thm_G': rule -> string * thm
26.253 + val str2ketype: string -> ketype
26.254 + val string_of_thm: thm -> string
26.255 + val string_of_thm': theory -> thm -> string
26.256 + val string_to_bool: string -> bool
26.257 + type subs' = (cterm' * cterm') list
26.258 + val term_to_string'': thyID -> term -> string
26.259 + val terms2str': term list -> string
26.260 + val terms2strs: term list -> string list
26.261 + type thehier = thydata ptyp list
26.262 + val theory2str': theory -> string
26.263 + val thm2str: thm -> string
26.264 + eqtype thmDeriv
26.265 + val thm_of_thm: rule -> thm
26.266 + val thy2ctxt: theory -> Proof.context
26.267 + val type_to_string': Proof.context -> typ -> string
26.268 + val type_to_string'': thyID -> typ -> string
26.269 + val type_to_string''': theory -> typ -> string
26.270 + ----------------------------------------- ^^^ make public -----------------------------------*)
26.271 + end
26.272 +(**)
26.273 +structure Celem(**): CALC_ELEMENT(**) =
26.274 struct
26.275 -*)
26.276 +(**)
26.277 +
26.278 val linefeed = (curry op^) "\n";
26.279 type authors = string list;
26.280
26.281 @@ -528,9 +784,10 @@
26.282 -> bool)) (*if t1 <= t2 then true else false *)
26.283 list); (*association list *)
26.284
26.285 +(* NOT ACCEPTED BY struct
26.286 rew_ord' := overwritel (!rew_ord', [("e_rew_ord", e_rew_ord),
26.287 ("dummy_ord", dummy_ord)]);
26.288 -
26.289 +*)
26.290
26.291 (* A tree for storing data defined in different theories
26.292 for access from the Interpreter and from dialogue authoring
26.293 @@ -1149,6 +1406,6 @@
26.294 else if member Context.eq_thy (isabthys ()) thy then "Isabelle"
26.295 else error ("closure of thys in Isac is broken by " ^ string_of_thy thy)
26.296 fun partID' (thy' : theory') = partID (Thy_Info_get_theory thy')
26.297 -(*
26.298 +
26.299 end (*struct*)
26.300 -*)
26.301 +
27.1 --- a/src/Tools/isac/xmlsrc/datatypes.sml Tue Mar 13 15:04:27 2018 +0100
27.2 +++ b/src/Tools/isac/xmlsrc/datatypes.sml Thu Mar 15 10:17:44 2018 +0100
27.3 @@ -5,52 +5,52 @@
27.4
27.5 signature DATATYPES = (*TODO: redo with xml_of/to *)
27.6 sig
27.7 - val authors2xml : int -> string -> string list -> xml
27.8 - val calc2xml : int -> thyID * calc -> xml
27.9 - val calcrefs2xml : int -> thyID * calc list -> xml
27.10 - val contthy2xml : int -> Rtools.contthy -> xml
27.11 - val extref2xml : int -> string -> string -> xml
27.12 + val authors2xml : int -> string -> string list -> Celem.xml
27.13 + val calc2xml : int -> Celem.thyID * Celem.calc -> Celem.xml
27.14 + val calcrefs2xml : int -> Celem.thyID * Celem.calc list -> Celem.xml
27.15 + val contthy2xml : int -> Rtools.contthy -> Celem.xml
27.16 + val extref2xml : int -> string -> string -> Celem.xml
27.17 val filterpbl :
27.18 ''a -> (''a * (Term.term * Term.term)) list -> Term.term list
27.19 - val formula2xml : int -> Term.term -> xml
27.20 - val formulae2xml : int -> Term.term list -> xml
27.21 + val formula2xml : int -> Term.term -> Celem.xml
27.22 + val formulae2xml : int -> Term.term list -> Celem.xml
27.23 val i : int
27.24 val id2xml : int -> string list -> string
27.25 val ints2xml : int -> int list -> string
27.26 - val itm_2xml : int -> Model.itm_ -> xml
27.27 + val itm_2xml : int -> Model.itm_ -> Celem.xml
27.28 val itms2xml : int -> (int * Model.vats * bool * string * Model.itm_) list ->
27.29 string
27.30 - val keref2xml : int -> ketype -> kestoreID -> xml
27.31 + val keref2xml : int -> Celem.ketype -> Celem.kestoreID -> Celem.xml
27.32 val model2xml :
27.33 - int -> Model.itm list -> (bool * Term.term) list -> xml
27.34 - val modspec2xml : int -> Ctree.ocalhd -> xml
27.35 + int -> Model.itm list -> (bool * Term.term) list -> Celem.xml
27.36 + val modspec2xml : int -> Ctree.ocalhd -> Celem.xml
27.37 val pattern2xml :
27.38 int ->
27.39 (string * (Term.term * Term.term)) list -> Term.term list -> string
27.40 val pos'2xml : int -> string * (int list * Ctree.pos_) -> string
27.41 - val pos'calchead2xml : int -> Ctree.pos' * Ctree.ocalhd -> xml
27.42 + val pos'calchead2xml : int -> Ctree.pos' * Ctree.ocalhd -> Celem.xml
27.43 val pos_2xml : int -> Ctree.pos_ -> string
27.44 - val posform2xml : int -> Ctree.pos' * Term.term -> xml
27.45 + val posform2xml : int -> Ctree.pos' * Term.term -> Celem.xml
27.46 val posformhead2xml : int -> Ctree.pos' * Ctree.ptform -> string
27.47 - val posformheads2xml : int -> (Ctree.pos' * Ctree.ptform) list -> xml
27.48 - val posforms2xml : int -> (Ctree.pos' * Term.term) list -> xml
27.49 - val posterms2xml : int -> (Ctree.pos' * term) list -> xml
27.50 - val precond2xml : int -> bool * Term.term -> xml
27.51 - val preconds2xml : int -> (bool * Term.term) list -> xml
27.52 - val rls2xml : int -> thyID * rls -> xml
27.53 - val rule2xml : int -> guh -> rule -> xml
27.54 - val rules2xml : int -> guh -> rule list -> xml
27.55 - val scr2xml : int -> scr -> xml
27.56 - val spec2xml : int -> spec -> xml
27.57 - val sub2xml : int -> Term.term * Term.term -> xml
27.58 - val subs2xml : int -> Selem.subs -> xml
27.59 - val subst2xml : int -> subst -> xml
27.60 - val tac2xml : int -> Tac.tac -> xml
27.61 - val tacs2xml : int -> Tac.tac list -> xml
27.62 - val theref2xml : int -> thyID -> string -> xstring -> string
27.63 - val thm'2xml : int -> thm' -> xml
27.64 - val thm''2xml : int -> thm -> xml
27.65 - val thmstr2xml : int -> string -> xml
27.66 + val posformheads2xml : int -> (Ctree.pos' * Ctree.ptform) list -> Celem.xml
27.67 + val posforms2xml : int -> (Ctree.pos' * Term.term) list -> Celem.xml
27.68 + val posterms2xml : int -> (Ctree.pos' * term) list -> Celem.xml
27.69 + val precond2xml : int -> bool * Term.term -> Celem.xml
27.70 + val preconds2xml : int -> (bool * Term.term) list -> Celem.xml
27.71 + val rls2xml : int -> Celem.thyID * rls -> Celem.xml
27.72 + val rule2xml : int -> Celem.guh -> rule -> Celem.xml
27.73 + val rules2xml : int -> Celem.guh -> rule list -> Celem.xml
27.74 + val scr2xml : int -> Celem.scr -> Celem.xml
27.75 + val spec2xml : int -> Celem.spec -> Celem.xml
27.76 + val sub2xml : int -> Term.term * Term.term -> Celem.xml
27.77 + val subs2xml : int -> Selem.subs -> Celem.xml
27.78 + val subst2xml : int -> Celem.subst -> Celem.xml
27.79 + val tac2xml : int -> Tac.tac -> Celem.xml
27.80 + val tacs2xml : int -> Tac.tac list -> Celem.xml
27.81 + val theref2xml : int -> Celem.thyID -> string -> xstring -> string
27.82 + val thm'2xml : int -> Celem.thm' -> Celem.xml
27.83 + val thm''2xml : int -> thm -> Celem.xml
27.84 + val thmstr2xml : int -> string -> Celem.xml
27.85 end
27.86
27.87 (*------------------------------------------------------------------
27.88 @@ -77,31 +77,31 @@
27.89 <STRING>univariate</STRING>
27.90 <STRING>equation</STRING>
27.91 </STRINGLIST>*)
27.92 -fun calc2xml j (thyID:thyID, (scrop, (rewop, _)):calc) =
27.93 +fun calc2xml j (thyID, (scrop, (rewop, _))) =
27.94 indt j ^ "<CALC>\n" ^
27.95 indt (j+i) ^ "<STRING>\n" ^ scrop ^ "</STRING>\n" ^
27.96 - indt (j+i) ^ "<GUH>\n" ^ cal2guh ("IsacKnowledge",
27.97 + indt (j+i) ^ "<GUH>\n" ^ Celem.cal2guh ("IsacKnowledge",
27.98 thyID) scrop ^ "</GUH>\n" ^
27.99 indt (j+i) ^ "<TERMOP>\n" ^ rewop ^ "</TERMOP>\n" ^
27.100 - indt j ^ "</CALC>\n" : xml;
27.101 + indt j ^ "</CALC>\n";
27.102 (*replace by 'fun calc2xml' as developed for thy in 0607*)
27.103 -fun calc2xmlOLD _ ((scr_op, (isa_op, _)):calc) =
27.104 +fun calc2xmlOLD _ (scr_op, (isa_op, _)) =
27.105 indt i ^ "<CALCULATE> (" ^ scr_op ^ ", (" ^ isa_op ^ ")) </CALCULATE>\n";
27.106 -fun calcs2xmlOLD _ [] = ("":xml) (*TODO replace with 'strs2xml'*)
27.107 +fun calcs2xmlOLD _ [] = "" (*TODO replace with 'strs2xml'*)
27.108 | calcs2xmlOLD j (r::rs) = calc2xmlOLD j r ^ calcs2xmlOLD j rs;
27.109
27.110 (*.for creating a href for a rule within an rls's rule list;
27.111 the guh points to the thy of definition of the rule, NOT of use in rls.*)
27.112 -fun rule2xml _ (_ : thyID) Erule =
27.113 +fun rule2xml _ _ Celem.Erule =
27.114 error "rule2xml called with 'Erule'"
27.115 - | rule2xml j _ (Thm (thmDeriv, _)) =
27.116 + | rule2xml j _ (Celem.Thm (thmDeriv, _)) =
27.117 indt j ^ "<RULE>\n" ^
27.118 indt (j+i) ^ "<TAG> Theorem </TAG>\n" ^
27.119 - indt (j+i) ^ "<STRING> " ^ thmID_of_derivation_name thmDeriv ^ " </STRING>\n" ^
27.120 + indt (j+i) ^ "<STRING> " ^ Celem.thmID_of_derivation_name thmDeriv ^ " </STRING>\n" ^
27.121 indt (j+i) ^ "<GUH> " ^
27.122 - thm2guh (Rtools.thy_containing_thm thmDeriv) (thmID_of_derivation_name thmDeriv) ^ " </GUH>\n" ^
27.123 - indt j ^ "</RULE>\n" : xml
27.124 - | rule2xml _ _ (Calc (_(*termop*), _)) = ""
27.125 + Celem.thm2guh (Rtools.thy_containing_thm thmDeriv) (Celem.thmID_of_derivation_name thmDeriv) ^ " </GUH>\n" ^
27.126 + indt j ^ "</RULE>\n"
27.127 + | rule2xml _ _ (Celem.Calc (_(*termop*), _)) = ""
27.128 (*FIXXXXXXXME.WN060714 in rls make Calc : calc -> rule [add scriptop!]
27.129 see smltest/../datatypes.sml !
27.130 indt j ^ "<RULE>\n" ^
27.131 @@ -110,17 +110,17 @@
27.132 termop ^ " </GUH>\n" ^
27.133 indt j ^ "</RULE>\n"
27.134 *)
27.135 - | rule2xml _ _ (Cal1 (_(*termop*), _)) = ""
27.136 - | rule2xml j thyID (Rls_ rls) =
27.137 - let val rls' = (#id o rep_rls) rls
27.138 + | rule2xml _ _ (Celem.Cal1 (_(*termop*), _)) = ""
27.139 + | rule2xml j thyID (Celem.Rls_ rls) =
27.140 + let val rls' = (#id o Celem.rep_rls) rls
27.141 in
27.142 indt j ^ "<RULE>\n" ^
27.143 indt (j+i) ^ "<TAG> Ruleset </TAG>\n" ^
27.144 indt (j+i) ^ "<STRING> " ^ rls' ^ " </STRING>\n" ^
27.145 - indt (j+i) ^ "<GUH> " ^ rls2guh (Rtools.thy_containing_rls thyID rls') rls' ^ " </GUH>\n" ^
27.146 + indt (j+i) ^ "<GUH> " ^ Celem.rls2guh (Rtools.thy_containing_rls thyID rls') rls' ^ " </GUH>\n" ^
27.147 indt j ^ "</RULE>\n"
27.148 end;
27.149 -fun rules2xml _ _ [] = ("":xml)
27.150 +fun rules2xml _ _ [] = ""
27.151 | rules2xml j thyID (r::rs) = rule2xml j thyID r ^ rules2xml j thyID rs;
27.152
27.153 fun filterpbl str =
27.154 @@ -160,24 +160,24 @@
27.155 indt j ^ "<EXTREF>\n" ^
27.156 indt (j+i) ^ "<TEXT> " ^ linktext ^ " </TEXT>\n" ^
27.157 indt (j+i) ^ "<URL> " ^ url ^ " </URL>\n" ^
27.158 - indt j ^ "</EXTREF>\n" : xml;
27.159 -fun theref2xml j (thyID:thyID) typ (xstring:xstring) =
27.160 - let val guh = theID2guh ["IsacKnowledge", thyID, typ, xstring]
27.161 + indt j ^ "</EXTREF>\n";
27.162 +fun theref2xml j thyID typ xstring =
27.163 + let val guh = Celem.theID2guh ["IsacKnowledge", thyID, typ, xstring]
27.164 val typ' = (implode o (drop_last_n 1) o Symbol.explode) typ
27.165 in indt j ^ "<KESTOREREF>\n" ^
27.166 indt (j+i) ^ "<TAG> " ^ typ' ^ " </TAG>\n" ^
27.167 indt (j+i) ^ "<ID> " ^ xstring ^ " </ID>\n" ^
27.168 indt (j+i) ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
27.169 - indt j ^ "</KESTOREREF>\n" : xml
27.170 + indt j ^ "</KESTOREREF>\n"
27.171 end;
27.172 -fun keref2xml j typ (kestoreID:kestoreID) =
27.173 +fun keref2xml j typ kestoreID =
27.174 let val id = strs2str' kestoreID
27.175 val guh = Specify.kestoreID2guh typ kestoreID
27.176 in indt j ^ "<KESTOREREF>\n" ^
27.177 - indt (j+i) ^ "<TAG> " ^ ketype2str' typ ^ "</TAG>\n" ^
27.178 + indt (j+i) ^ "<TAG> " ^ Celem.ketype2str' typ ^ "</TAG>\n" ^
27.179 indt (j+i) ^ "<ID> " ^ id ^ " </ID>\n" ^
27.180 indt (j+i) ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
27.181 - indt j ^ "</KESTOREREF>\n" : xml
27.182 + indt j ^ "</KESTOREREF>\n"
27.183 end;
27.184 fun authors2xml j str auts =
27.185 let fun autx _ [] = ""
27.186 @@ -185,30 +185,30 @@
27.187 (autx j ss)
27.188 in indt j ^ "<"^str^">\n" ^
27.189 autx (j + i) auts ^
27.190 - indt j ^ "</"^str^">\n" : xml
27.191 + indt j ^ "</"^str^">\n"
27.192 end;
27.193 (* writeln(authors2xml 2 "MATHAUTHORS" []);
27.194 writeln(authors2xml 2 "MATHAUTHORS"
27.195 ["isac-team 2001", "Richard Lang 2003"]);
27.196 *)
27.197 fun scr2xml j EmptyScr =
27.198 - indt j ^"<SCRIPT> </SCRIPT>\n" : xml
27.199 - | scr2xml j (Prog term) =
27.200 - if term = e_term
27.201 + indt j ^"<SCRIPT> </SCRIPT>\n"
27.202 + | scr2xml j (Celem.Prog term) =
27.203 + if term = Celem.e_term
27.204 then indt j ^"<SCRIPT> </SCRIPT>\n"
27.205 else indt j ^"<SCRIPT>\n"^
27.206 term2xml j (TermC.inst_abs term) ^ "\n" ^
27.207 indt j ^"</SCRIPT>\n"
27.208 - | scr2xml j (Rfuns _) =
27.209 + | scr2xml j (Celem.Rfuns _) =
27.210 indt j ^"<REVERSREWRITE> reverse rewrite functions </REVERSREWRITE>\n";
27.211
27.212 -fun calcref2xml j (thyID:thyID, (scrop, (_(*rewop*), _)):calc) =
27.213 +fun calcref2xml j (thyID, (scrop, (_(*rewop*), _))) =
27.214 indt j ^ "<CALCREF>\n" ^
27.215 indt (j+i) ^ "<STRING> " ^ scrop ^ "</STRING>\n" ^
27.216 - indt (j+i) ^ "<GUH> " ^ cal2guh ("IsacKnowledge",
27.217 + indt (j+i) ^ "<GUH> " ^ Celem.cal2guh ("IsacKnowledge",
27.218 thyID) scrop ^ " </GUH>\n" ^
27.219 - indt j ^ "</CALCREF>\n" : xml;
27.220 -fun calcrefs2xml _ (_,[]) = "":xml
27.221 + indt j ^ "</CALCREF>\n";
27.222 +fun calcrefs2xml _ (_,[]) = ""
27.223 | calcrefs2xml j (thyID, cal::cs) =
27.224 calcref2xml j (thyID, cal) ^ calcrefs2xml j (thyID, cs);
27.225
27.226 @@ -220,9 +220,9 @@
27.227 indt (j+i) ^"<PATTERN>\n"^
27.228 term2xml (j+2*i) term ^
27.229 indt (j+i) ^"</PATTERN>\n"^
27.230 - indt j ^"</PREPAT>\n" : xml;
27.231 + indt j ^"</PREPAT>\n";
27.232 fun prepat2xml _ [] = ""
27.233 - | prepat2xml j (p::ps) = prepa12xml j p ^ prepat2xml j ps : xml;
27.234 + | prepat2xml j (p::ps) = prepa12xml j p ^ prepat2xml j ps;
27.235
27.236 fun rls2xm j (thyID, seqrls, {id, preconds, rew_ord=(ord,_), erls,
27.237 srls, calc, rules, errpatts, scr}) =
27.238 @@ -244,23 +244,23 @@
27.239 indt (j+i) ^"</ORDER>\n" ^
27.240 indt (j+i) ^"<ERLS>\n" ^
27.241 indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
27.242 - indt (j+2*i) ^ "<STRING> " ^ id_rls erls ^ " </STRING>\n" ^
27.243 - indt (j+2*i) ^ "<GUH> " ^ rls2guh ("IsacKnowledge", thyID)
27.244 - (id_rls erls) ^ " </GUH>\n" ^
27.245 + indt (j+2*i) ^ "<STRING> " ^ Celem.id_rls erls ^ " </STRING>\n" ^
27.246 + indt (j+2*i) ^ "<GUH> " ^ Celem.rls2guh ("IsacKnowledge", thyID)
27.247 + (Celem.id_rls erls) ^ " </GUH>\n" ^
27.248 indt (j+i) ^"</ERLS>\n" ^
27.249 indt (j+i) ^"<SRLS>\n" ^
27.250 indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
27.251 - indt (j+2*i) ^ "<STRING> " ^ id_rls erls ^ " </STRING>\n" ^
27.252 - indt (j+2*i) ^ "<GUH> " ^ rls2guh ("IsacKnowledge", thyID)
27.253 - (id_rls srls) ^ " </GUH>\n" ^
27.254 + indt (j+2*i) ^ "<STRING> " ^ Celem.id_rls erls ^ " </STRING>\n" ^
27.255 + indt (j+2*i) ^ "<GUH> " ^ Celem.rls2guh ("IsacKnowledge", thyID)
27.256 + (Celem.id_rls srls) ^ " </GUH>\n" ^
27.257 indt (j+i) ^"</SRLS>\n" ^
27.258 calcrefs2xml (j+i) (thyID, calc) ^
27.259 scr2xml (j+i) scr ^
27.260 - indt j ^"</RULESET>\n" : xml;
27.261 -fun rls2xml j (thyID, Erls) = rls2xml j (thyID, e_rls)
27.262 - | rls2xml j (thyID, Rls data) = rls2xm j (thyID, "Rls", data)
27.263 - | rls2xml j (thyID, Seq data) = rls2xm j (thyID, "Seq", data)
27.264 - | rls2xml j (thyID, Rrls {id, prepat, rew_ord=(ord,_), erls, calc, errpatts, scr}) =
27.265 + indt j ^"</RULESET>\n";
27.266 +fun rls2xml j (thyID, Celem.Erls) = rls2xml j (thyID, Celem.e_rls)
27.267 + | rls2xml j (thyID, Celem.Rls data) = rls2xm j (thyID, "Rls", data)
27.268 + | rls2xml j (thyID, Celem.Seq data) = rls2xm j (thyID, "Seq", data)
27.269 + | rls2xml j (thyID, Celem.Rrls {id, prepat, rew_ord=(ord,_), erls, calc, errpatts, scr}) =
27.270 indt j ^"<RULESET>\n"^
27.271 indt (j+i) ^"<ID> "^ id ^" </ID>\n"^
27.272 indt (j+i) ^"<TYPE> Rrls </TYPE>\n"^
27.273 @@ -275,14 +275,14 @@
27.274 indt (j+i) ^"</ORDER>\n" ^
27.275 indt (j+i) ^"<ERLS> " ^
27.276 indt (j+2*i) ^ "<TAG> Ruleset </TAG>\n" ^
27.277 - indt (j+2*i) ^ "<STRING> " ^ id_rls erls ^ " </STRING>\n" ^
27.278 - indt (j+2*i) ^ "<GUH> " ^ rls2guh ("IsacKnowledge", thyID) (id_rls erls) ^ " </GUH>\n" ^
27.279 + indt (j+2*i) ^ "<STRING> " ^ Celem.id_rls erls ^ " </STRING>\n" ^
27.280 + indt (j+2*i) ^ "<GUH> " ^ Celem.rls2guh ("IsacKnowledge", thyID) (Celem.id_rls erls) ^ " </GUH>\n" ^
27.281 indt (j+i) ^"</ERLS>\n" ^
27.282 calcrefs2xml (j+i) (thyID, calc) ^
27.283 indt (j+i) ^"<SCRIPT>\n"^
27.284 scr2xml (j+2*i) scr ^
27.285 indt (j+i) ^" </SCRIPT>\n"^
27.286 - indt j ^"</RULESET>\n" : xml;
27.287 + indt j ^"</RULESET>\n";
27.288
27.289 (*** convert sml-datatypes to xml for libisabelle ***)
27.290
27.291 @@ -292,7 +292,7 @@
27.292 fun xml_to_bool (XML.Elem (("BOOL", []), [XML.Text b])) = string_to_bool b
27.293 | xml_to_bool tree = raise ERROR ("xml_to_bool: wrong XML.tree \n" ^ xmlstr 0 tree)
27.294
27.295 -fun xml_to_ketype (XML.Elem (("KETYPE", []), [XML.Text str])) = str2ketype' str
27.296 +fun xml_to_ketype (XML.Elem (("KETYPE", []), [XML.Text str])) = Celem.str2ketype' str
27.297 | xml_to_ketype tree = raise ERROR ("xml_to_ketype: wrong XML.tree \n" ^ xmlstr 0 tree)
27.298
27.299 fun xml_of_str str = XML.Elem (("STRING", []), [XML.Text str])
27.300 @@ -439,7 +439,7 @@
27.301 imodel as XML.Elem (("MATHML", []), _), (* TODO WN150813 ?!?*)
27.302 XML.Elem (( "POS", []), [XML.Text belongsto]),
27.303 spec as XML.Elem (( "SPECIFICATION", []), _)])) =
27.304 - (xml_to_pos pos, xml_to_term_NEW form |> term2str, xml_to_imodel imodel,
27.305 + (xml_to_pos pos, xml_to_term_NEW form |> Celem.term2str, xml_to_imodel imodel,
27.306 Ctree.str2pos_ belongsto, xml_to_spec spec) : Inform.icalhd
27.307 | xml_to_icalhd x = raise ERROR ("xml_to_icalhd: WRONG arg = " ^ xmlstr 0 x)
27.308
27.309 @@ -453,13 +453,13 @@
27.310 XML.Elem (("VALUE", []), [value])])) = (xml_to_term id, xml_to_term value)
27.311 | xml_to_sub x = raise ERROR ("xml_to_sub wrong arg: " ^ xmlstr 0 x)
27.312 fun xml_of_subs (subs : Selem.subs) =
27.313 - XML.Elem (("SUBSTITUTION", []), map xml_of_sub (Selem.subs2subst (assoc_thy "Isac") subs))
27.314 + XML.Elem (("SUBSTITUTION", []), map xml_of_sub (Selem.subs2subst (Celem.assoc_thy "Isac") subs))
27.315 fun xml_to_subs
27.316 (XML.Elem (("SUBSTITUTION", []),
27.317 subs)) = Selem.subst2subs (map xml_to_sub subs)
27.318 | xml_to_subs x = raise ERROR ("xml_to_subs wrong arg: " ^ xmlstr 0 x)
27.319 fun xml_of_sube sube =
27.320 - XML.Elem (("SUBSTITUTION", []), map xml_of_sub (Selem.sube2subst (assoc_thy "Isac") sube))
27.321 + XML.Elem (("SUBSTITUTION", []), map xml_of_sub (Selem.sube2subst (Celem.assoc_thy "Isac") sube))
27.322 fun xml_to_sube
27.323 (XML.Elem (("SUBSTITUTION", []),
27.324 xml_var_val_pairs)) = Selem.subst2sube (map xml_to_sub xml_var_val_pairs)
27.325 @@ -467,16 +467,16 @@
27.326
27.327 fun thm''2xml j (thm : thm) =
27.328 indt j ^ "<THEOREM>\n" ^
27.329 - indt (j+i) ^ "<ID> " ^ thmID_of_derivation_name' thm ^ " </ID>\n"^
27.330 + indt (j+i) ^ "<ID> " ^ Celem.thmID_of_derivation_name' thm ^ " </ID>\n"^
27.331 term2xml j (Thm.prop_of thm) ^ "\n" ^
27.332 - indt j ^ "</THEOREM>\n" : xml;
27.333 -fun xml_of_thm' ((ID, form) : thm') =
27.334 + indt j ^ "</THEOREM>\n";
27.335 +fun xml_of_thm' (ID, form) =
27.336 XML.Elem (("THEOREM", []), [
27.337 XML.Elem (("ID", []), [XML.Text ID]),
27.338 XML.Elem (("FORMULA", []), [
27.339 XML.Text form])]) (* repair for MathML: use term instead String *)
27.340 (* at the front-end theorems can be shown by their term, so term is transported isac-java <--- ME *)
27.341 -fun xml_of_thm'' ((ID, thm) : thm'') =
27.342 +fun xml_of_thm'' (ID, thm) =
27.343 (*---xml_of_thm''------------------------------------------thm'_to_thm''--------------
27.344 XML.Elem (("THEOREM", []), [
27.345 XML.Elem (("ID", []), [XML.Text ID]),
27.346 @@ -485,13 +485,13 @@
27.347 XML.Elem (("THEOREM", []), [
27.348 XML.Elem (("ID", []), [XML.Text ID]),
27.349 XML.Elem (("FORMULA", []), [
27.350 - XML.Text ((term2str o Thm.prop_of) thm)])]) (* repair for MathML: use term instead String *)
27.351 + XML.Text ((Celem.term2str o Thm.prop_of) thm)])]) (* repair for MathML: use term instead String *)
27.352
27.353 fun xml_to_thm'
27.354 (XML.Elem (("THEOREM", []), [
27.355 XML.Elem (("ID", []), [XML.Text ID]),
27.356 XML.Elem (("FORMULA", []), [XML.Text "NO_ad_hoc_thm_FROM_FRONTEND = True"])])) =
27.357 - ((ID, "NO_ad_hoc_thm_FROM_GUI = True") : thm')
27.358 + (ID, "NO_ad_hoc_thm_FROM_GUI = True")
27.359 | xml_to_thm' x = raise ERROR ("xml_of_thm' wrong arg:\n" ^ xmlstr 0 x)
27.360 (* at the front-end theorems are identified only by their name, so NO isac-java \<longrightarrow> ME *)
27.361 fun xml_to_thm''
27.362 @@ -505,16 +505,16 @@
27.363 (XML.Elem (("THEOREM", []), [
27.364 XML.Elem (("ID", []), [XML.Text ID]),
27.365 XML.Elem (("FORMULA", []), [
27.366 - XML.Text term])])) = (ID, Rewrite.assoc_thm'' (Isac ()) ID) : thm''
27.367 + XML.Text term])])) = (ID, Rewrite.assoc_thm'' (Celem.Isac ()) ID)
27.368 | xml_to_thm'' x = raise ERROR ("xml_of_thm' wrong arg:" ^ xmlstr 0 x)
27.369
27.370 fun xml_of_src EmptyScr =
27.371 XML.Elem (("NOCODE", []), [XML.Text "empty"])
27.372 - | xml_of_src (Prog term) =
27.373 + | xml_of_src (Celem.Prog term) =
27.374 XML.Elem (("CODE", []), [
27.375 - if term = e_term then xml_of_src EmptyScr
27.376 + if term = Celem.e_term then xml_of_src Celem.EmptyScr
27.377 else xml_of_term (TermC.inst_abs term)])
27.378 - | xml_of_src (Rfuns _) =
27.379 + | xml_of_src (Celem.Rfuns _) =
27.380 XML.Elem (("NOCODE", []), [XML.Text "reverse rewrite functions"])
27.381
27.382 (*.convert a tactic into xml-format .*)
27.383 @@ -642,7 +642,7 @@
27.384 | xml_to_tac x = raise ERROR ("xml_to_tac: not impl. for " ^ xmlstr 0 x);
27.385
27.386 val e_pblterm = (Thm.term_of o the o (TermC.parse @{theory Script}))
27.387 - ("Problem (" ^ e_domID ^ "," ^ strs2str' e_pblID ^ ")");
27.388 + ("Problem (" ^ Celem.e_domID ^ "," ^ strs2str' Celem.e_pblID ^ ")");
27.389
27.390 (*WN051224 minimal adaption to exporting Formulae _only_ by getFormulaeFromTo*)
27.391 fun xml_of_posterm (p, t) =
27.392 @@ -665,18 +665,18 @@
27.393 (* val (j, thyID, typ, xstring) =
27.394 (i+i, snd (thy_containing_rls thy' prls'), "Rulesets", prls');
27.395 *)
27.396 -fun theref2xml j (thyID:thyID) typ (xstring:xstring) =
27.397 - let val guh = theID2guh ["IsacKnowledge", thyID, typ, xstring]
27.398 +fun theref2xml j thyID typ xstring =
27.399 + let val guh = Celem.theID2guh ["IsacKnowledge", thyID, typ, xstring]
27.400 val typ' = (implode o (drop_last_n 1) o Symbol.explode) typ
27.401 in indt j ^ "<KESTOREREF>\n" ^
27.402 indt (j+i) ^ "<TAG> " ^ typ' ^ " </TAG>\n" ^
27.403 indt (j+i) ^ "<ID> " ^ xstring ^ " </ID>\n" ^
27.404 indt (j+i) ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
27.405 - indt j ^ "</KESTOREREF>\n" : xml
27.406 + indt j ^ "</KESTOREREF>\n"
27.407 end;
27.408 -fun xml_of_theref (thyid : thyID) typ (xstring : xstring) =
27.409 +fun xml_of_theref thyid typ xstring =
27.410 let
27.411 - val guh = theID2guh ["IsacKnowledge", thyid, typ, xstring]
27.412 + val guh = Celem.theID2guh ["IsacKnowledge", thyid, typ, xstring]
27.413 val typ' = (implode o (drop_last_n 1) o Symbol.explode) typ
27.414 in
27.415 XML.Elem (("KESTOREREF", []),[
27.416 @@ -710,7 +710,7 @@
27.417 XML.Elem (("CONTEXTDATA", []), [
27.418 XML.Elem (("GUH", []), [XML.Text thm]),
27.419 XML.Elem (("SUBSLIST", []), [ (* should be an environment = substitution *)
27.420 - xml_of_cterm (subst2str' bdvs)]),
27.421 + xml_of_cterm (Celem.subst2str' bdvs)]),
27.422 XML.Elem (("INSTANTIATED", []), [xml_of_term thminst]),
27.423 XML.Elem (("APPLTO", []), [xml_of_term applto]),
27.424 XML.Elem (("APPLAT", []), [xml_of_term applat]),
27.425 @@ -736,8 +736,8 @@
27.426 XML.Elem (("CONTEXTDATA", []), [
27.427 XML.Elem (("GUH", []), [XML.Text rls]),
27.428 XML.Elem (("SUBSLIST", []), [ (* should be an environment = substitution *)
27.429 - xml_of_cterm (subst2str' bdvs)]),
27.430 - XML.Elem (("INSTANTIATED", []), [xml_of_cterm (subst2str' bdvs)]),
27.431 + xml_of_cterm (Celem.subst2str' bdvs)]),
27.432 + XML.Elem (("INSTANTIATED", []), [xml_of_cterm (Celem.subst2str' bdvs)]),
27.433 XML.Elem (("APPLTO", []), [xml_of_term applto]),
27.434 XML.Elem (("RESULT", []), [xml_of_term result]),
27.435 XML.Elem (("ASSUMPTIONS", []), map xml_of_term asms)])
27.436 @@ -751,7 +751,7 @@
27.437 XML.Elem (("CONTEXTDATA", []), [
27.438 XML.Elem (("GUH", []), [XML.Text thm_rls]),
27.439 XML.Elem (("SUBSLIST", []), [ (* should be an environment = substitution *)
27.440 - xml_of_cterm (subst2str' bdvs)]),
27.441 + xml_of_cterm (Celem.subst2str' bdvs)]),
27.442 XML.Elem (("INSTANTIATED", []), [xml_of_term thminst]),
27.443 XML.Elem (("APPLTO", []), [xml_of_term applto])])
27.444
28.1 --- a/src/Tools/isac/xmlsrc/interface-xml.sml Tue Mar 13 15:04:27 2018 +0100
28.2 +++ b/src/Tools/isac/xmlsrc/interface-xml.sml Thu Mar 15 10:17:44 2018 +0100
28.3 @@ -15,49 +15,49 @@
28.4 *)
28.5
28.6 (**FIXXME.8.03 addUser: clear code, because only CalcTrees distinguished**)
28.7 -fun adduserOK2xml (calcid : calcID) (userid : iterID) =
28.8 +fun adduserOK2xml (calcid : Celem.calcID) (userid : Celem.iterID) =
28.9 XML.Elem (("ADDUSER", []),
28.10 [XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.11 XML.Elem (("USERID", []), [XML.Text (string_of_int userid)])])
28.12
28.13 -fun calctreeOK2xml (calcid : calcID) =
28.14 +fun calctreeOK2xml (calcid : Celem.calcID) =
28.15 XML.Elem (("CALCTREE", []),
28.16 [XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)])])
28.17 -fun deconstructcalctreeOK2xml (calcid : calcID) =
28.18 +fun deconstructcalctreeOK2xml (calcid : Celem.calcID) =
28.19 XML.Elem (("DELCALC", []),
28.20 [XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)])])
28.21
28.22 -fun iteratorOK2xml (calcid : calcID) (p : Ctree.pos')=
28.23 +fun iteratorOK2xml (calcid : Celem.calcID) (p : Ctree.pos')=
28.24 XML.Elem (("CALCITERATOR", []),
28.25 [XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.26 xml_of_pos "POSITION" p])
28.27 -fun iteratorERROR2xml (calcid : calcID) =
28.28 +fun iteratorERROR2xml (calcid : Celem.calcID) =
28.29 XML.Elem (("CALCITERATOR", []),
28.30 [XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.31 XML.Elem (("ERROR", []), [XML.Text " iteratorERROR2xml: pos does not exist "])])
28.32
28.33 -fun sysERROR2xml (calcid : calcID) str =
28.34 +fun sysERROR2xml (calcid : Celem.calcID) str =
28.35 XML.Elem (("SYSERROR", []),
28.36 [XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.37 XML.Elem (("ERROR", []), [XML.Text (if str = "" then " ERROR in kernel " else str)])])
28.38
28.39 -fun refformulaOK2xml (calcid : calcID) p (Ctree.Form t) =
28.40 +fun refformulaOK2xml (calcid : Celem.calcID) p (Ctree.Form t) =
28.41 XML.Elem (("REFFORMULA", []),
28.42 [XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.43 XML.Elem (("CALCFORMULA", []), [
28.44 xml_of_pos "POSITION" p,
28.45 xml_of_term_NEW t])])
28.46 - | refformulaOK2xml (calcid : calcID) p (Ctree.ModSpec modspec) =
28.47 + | refformulaOK2xml (calcid : Celem.calcID) p (Ctree.ModSpec modspec) =
28.48 XML.Elem (("REFFORMULA", []), [
28.49 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.50 (*L.Elem (("CALCHEAD*) xml_of_posmodspec (p, modspec)])
28.51
28.52 -fun gettacticOK2xml (calcid : calcID) tac =
28.53 +fun gettacticOK2xml (calcid : Celem.calcID) tac =
28.54 XML.Elem (("GETTACTIC", []),[
28.55 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.56 xml_of_tac tac])
28.57
28.58 -fun gettacticERROR2xml (calcid : calcID) str =
28.59 +fun gettacticERROR2xml (calcid : Celem.calcID) str =
28.60 XML.Elem (("GETTACTIC", []),[
28.61 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.62 XML.Elem (("ERROR", []), [XML.Text str])])
28.63 @@ -67,7 +67,7 @@
28.64 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.65 XML.Elem (("TACLIST", []), (map xml_of_tac tacs))])
28.66
28.67 -fun getasmsOK2xml (calcid : calcID) terms =
28.68 +fun getasmsOK2xml (calcid : Celem.calcID) terms =
28.69 XML.Elem (("ASSUMPTIONS", []), [
28.70 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.71 XML.Elem (("ASMLIST", []), (map xml_of_term_NEW terms))])
28.72 @@ -76,8 +76,8 @@
28.73 fun formula2xml j term = (*TODO.WN050211: use for _all_ <FORMULA>*)
28.74 indt j ^ "<FORMULA>\n"^
28.75 term2xml j term ^"\n"^
28.76 - indt j ^ "</FORMULA>\n" : xml;
28.77 -fun formulae2xml j [] = ("":xml)
28.78 + indt j ^ "</FORMULA>\n" : Celem.xml;
28.79 +fun formulae2xml j [] = ("": Celem.xml)
28.80 | formulae2xml j (r::rs) = formula2xml j r ^ formulae2xml j rs;
28.81 (* writeln(formulae2xml 6 [str2term "1+1=2", str2term "1+1+1=3"]);
28.82 *)
28.83 @@ -95,42 +95,42 @@
28.84 getaccuasmsOK2xml 333 [str2term "1+1=2", str2term "1+1+1=3"];
28.85 *)
28.86
28.87 -fun getintervalOK (calcid : calcID) fs =
28.88 +fun getintervalOK (calcid : Celem.calcID) fs =
28.89 XML.Elem (("GETELEMENTSFROMTO", []),
28.90 [XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.91 XML.Elem (("FORMHEADS", []), map xml_of_posterm fs)])
28.92
28.93 -fun appendformulaOK2xml (calcid : calcID) (old : Ctree.pos') (del : Ctree.pos') (new : Ctree.pos') =
28.94 +fun appendformulaOK2xml (calcid : Celem.calcID) (old : Ctree.pos') (del : Ctree.pos') (new : Ctree.pos') =
28.95 xml_of_calcchanged calcid "APPENDFORMULA" old del new
28.96 -fun appendformulaERROR2xml (calcid : calcID) e =
28.97 +fun appendformulaERROR2xml (calcid : Celem.calcID) e =
28.98 XML.Elem (("APPENDFORMULA", []), [
28.99 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.100 XML.Elem (("CALCMESSAGE", []), [XML.Text e])])
28.101
28.102 -fun replaceformulaOK2xml (calcid : calcID) (old : Ctree.pos') (del : Ctree.pos') (new : Ctree.pos') =
28.103 +fun replaceformulaOK2xml (calcid : Celem.calcID) (old : Ctree.pos') (del : Ctree.pos') (new : Ctree.pos') =
28.104 xml_of_calcchanged calcid "REPLACEFORMULA" old del new
28.105 -fun replaceformulaERROR2xml (calcid : calcID) e =
28.106 +fun replaceformulaERROR2xml (calcid : Celem.calcID) e =
28.107 XML.Elem (("REPLACEFORMULA", []), [
28.108 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.109 XML.Elem (("CALCMESSAGE", []), [XML.Text e])])
28.110
28.111 -fun message2xml (calcid : calcID) e =
28.112 +fun message2xml (calcid : Celem.calcID) e =
28.113 XML.Elem (("MESSAGE", []), [
28.114 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.115 XML.Elem (("STRING", []), [XML.Text e])])
28.116
28.117 -fun setnexttactic2xml (calcid : calcID) e =
28.118 +fun setnexttactic2xml (calcid : Celem.calcID) e =
28.119 XML.Elem (("SETNEXTTACTIC", []), [
28.120 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.121 XML.Elem (("MESSAGE", []), [XML.Text e])])
28.122
28.123 -fun fetchproposedtacticOK2xml (calcid : calcID) tac (errpatIDs : errpatID list) =
28.124 +fun fetchproposedtacticOK2xml (calcid : Celem.calcID) tac (errpatIDs : Celem.errpatID list) =
28.125 XML.Elem (("NEXTTAC", []), [
28.126 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.127 XML.Elem (("TACTICERRORPATTERNS", []), [xml_of_strs errpatIDs]),
28.128 xml_of_tac tac])
28.129
28.130 -fun fetchproposedtacticERROR2xml (calcid : calcID) e =
28.131 +fun fetchproposedtacticERROR2xml (calcid : Celem.calcID) e =
28.132 XML.Elem (("NEXTTAC", []), [
28.133 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.134 XML.Elem (("ERROR", []), [XML.Text e])])
28.135 @@ -139,26 +139,26 @@
28.136 DELETED: last pos' of the succesional sequence of formulae prob. deleted
28.137 GENERATED: the pos' of the new active formula
28.138 .*)
28.139 -fun autocalculateOK2xml (calcid : calcID) (old : Ctree.pos') (del : Ctree.pos') (new : Ctree.pos') =
28.140 +fun autocalculateOK2xml (calcid : Celem.calcID) (old : Ctree.pos') (del : Ctree.pos') (new : Ctree.pos') =
28.141 xml_of_calcchanged calcid "AUTOCALC" old del new
28.142 -fun autocalculateERROR2xml (calcid : calcID) e =
28.143 +fun autocalculateERROR2xml (calcid : Celem.calcID) e =
28.144 XML.Elem (("AUTOCALC", []), [
28.145 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.146 XML.Elem (("CALCMESSAGE", []), [XML.Text e])])
28.147
28.148 -fun interStepsOK (calcid : calcID) (old : Ctree.pos') (del : Ctree.pos') (new : Ctree.pos') =
28.149 +fun interStepsOK (calcid : Celem.calcID) (old : Ctree.pos') (del : Ctree.pos') (new : Ctree.pos') =
28.150 xml_of_calcchanged calcid "INTERSTEPS" old del new
28.151 -fun interStepsERROR (calcid : calcID) e =
28.152 +fun interStepsERROR (calcid : Celem.calcID) e =
28.153 XML.Elem (("INTERSTEPS", []), [
28.154 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.155 XML.Elem (("CALCMESSAGE", []), [XML.Text e])])
28.156
28.157 -fun calcMessage2xml (cI:calcID) e =
28.158 +fun calcMessage2xml (cI: Celem.calcID) e =
28.159 writeln ("@@@@@begin@@@@@\n "^string_of_int cI^" \n" ^
28.160 " <CALCMESSAGE> "^ e ^" </CALCMESSAGE>\n" ^
28.161 "@@@@@end@@@@@");
28.162
28.163 -fun modifycalcheadOK2xml (calcid : calcID) (chd as (complete, p_ ,_ ,_ ,_ ,_) : Ctree.ocalhd) =
28.164 +fun modifycalcheadOK2xml (calcid : Celem.calcID) (chd as (complete, p_ ,_ ,_ ,_ ,_) : Ctree.ocalhd) =
28.165 XML.Elem (("MODIFYCALCHEAD", []), [
28.166 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.167 XML.Elem (("STATUS", []), [
28.168 @@ -179,7 +179,7 @@
28.169 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.170 xml_of_matchmet contmet])
28.171
28.172 -fun findFillpatterns2xml (calcid : calcID) pattIDs =
28.173 +fun findFillpatterns2xml (calcid : Celem.calcID) pattIDs =
28.174 XML.Elem (("FINDFILLPATTERNS", []), [
28.175 XML.Elem (("CALCID", []), [XML.Text (string_of_int calcid)]),
28.176 xml_of_strs pattIDs])
29.1 --- a/src/Tools/isac/xmlsrc/mathml.sml Tue Mar 13 15:04:27 2018 +0100
29.2 +++ b/src/Tools/isac/xmlsrc/mathml.sml Thu Mar 15 10:17:44 2018 +0100
29.3 @@ -14,14 +14,14 @@
29.4 ad(2) decode "<" ---> "<", decode ">" ---> ">"
29.5 decode "&" ---> "&"
29.6 called for term2xml; + see "fun encode" below*)
29.7 -fun decode (str:cterm') =
29.8 +fun decode (str: Celem.cterm') =
29.9 let fun dec [] = []
29.10 | dec ("^"::"^"::"^"::cs) = "^"::(dec cs)
29.11 | dec ("&"::cs) = "&"::"a"::"m"::"p"::";"::(dec cs)
29.12 | dec ("<"::cs) = "&"::"l"::"t"::";"::(dec cs)
29.13 | dec (">"::cs) = "&"::"g"::"t"::";"::(dec cs)
29.14 | dec (c::cs) = c::(dec cs)
29.15 - in (implode o dec o Symbol.explode) str:cterm' end;
29.16 + in (implode o dec o Symbol.explode) str: Celem.cterm' end;
29.17
29.18 fun dop_leading _ [] = []
29.19 | dop_leading c (c' :: cs) =
29.20 @@ -33,7 +33,7 @@
29.21 let val cs' = dop_leading "^" cs
29.22 in rm_doublets c (singled @ [c']) cs' end
29.23 else rm_doublets c (singled @ [c']) cs
29.24 -fun encode (str : cterm') =
29.25 +fun encode (str : Celem.cterm') =
29.26 let fun enc [] = []
29.27 | enc ("^" :: cs) = "^" :: "^" :: "^" :: (enc cs)
29.28 | enc (c :: cs) = c :: (enc cs)
29.29 @@ -48,7 +48,7 @@
29.30 fun xmlstr i (XML.Text str) = indent i ^ str ^ "\n"
29.31 | xmlstr i (XML.Elem (("TERM", []), [xt])) =
29.32 indent i ^ "(" ^ "TERM" ^ ")" ^ "\n" ^
29.33 - indent (i + 1)^ (xt |> Codec.decode Codec.term |> Codec.the_success |> term2str) ^ "\n" ^
29.34 + indent (i + 1)^ (xt |> Codec.decode Codec.term |> Codec.the_success |> Celem.term2str) ^ "\n" ^
29.35 indent i ^ "(/" ^ "TERM" ^ ")" ^ "\n"
29.36 | xmlstr i (XML.Elem ((str, []), trees)) =
29.37 indent i ^ "(" ^ str ^ ")" ^ "\n" ^
29.38 @@ -73,7 +73,7 @@
29.39 (*WN071016 checked that _all_ Frontend/interface.sml uses this*)
29.40 fun term2xml j t =
29.41 indt (j+i) ^ "<MATHML>\n" ^
29.42 - indt (j+2*i) ^ "<ISA> " ^ (decode o term2str) t ^ " </ISA>\n" ^
29.43 + indt (j+2*i) ^ "<ISA> " ^ (decode o Celem.term2str) t ^ " </ISA>\n" ^
29.44 indt (j+i) ^ "</MATHML>";
29.45 (*val t = str2term "equality e_";
29.46 writeln (term2xml 8 t);
29.47 @@ -82,7 +82,7 @@
29.48 <MATHML> *)
29.49 fun xml_of_term t =
29.50 XML.Elem (("MATHML", []),
29.51 - [XML.Elem (("ISA", []), [XML.Text ((decode o term2str) t)])])
29.52 + [XML.Elem (("ISA", []), [XML.Text ((decode o Celem.term2str) t)])])
29.53 fun xml_of_terms ts = map xml_of_term ts
29.54 fun xml_to_term
29.55 ((XML.Elem (("MATHML", []), [
29.56 @@ -98,7 +98,7 @@
29.57 (* intermediate replacements while introducing transfer of terms by libisabelle *)
29.58 fun xml_of_term_NEW t =
29.59 XML.Elem (("FORMULA", []), [
29.60 - XML.Elem (("ISA", []), [XML.Text ((decode o term2str) t)]),
29.61 + XML.Elem (("ISA", []), [XML.Text ((decode o Celem.term2str) t)]),
29.62 XML.Elem (("TERM", []), [Codec.encode Codec.term t])])
29.63 (* unused: formulas come as strings from frontend and are parsed by Isabelle *)
29.64 fun xml_to_term_UNUSED
30.1 --- a/src/Tools/isac/xmlsrc/pbl-met-hierarchy.sml Tue Mar 13 15:04:27 2018 +0100
30.2 +++ b/src/Tools/isac/xmlsrc/pbl-met-hierarchy.sml Thu Mar 15 10:17:44 2018 +0100
30.3 @@ -3,13 +3,13 @@
30.4 (c) isac-team
30.5 *)
30.6
30.7 -fun file2str (path : path) (fnm : filename) =
30.8 +fun file2str (path : Celem.path) (fnm : Celem.filename) =
30.9 let
30.10 val file = TextIO.openIn (path ^ fnm)
30.11 val str = TextIO.inputAll file
30.12 in TextIO.closeIn file; str end
30.13
30.14 -fun str2file (fnm : filename) (str : string) =
30.15 +fun str2file (fnm : Celem.filename) (str : string) =
30.16 let val file = TextIO.openOut fnm
30.17 in
30.18 TextIO.output (file, str);
30.19 @@ -33,7 +33,7 @@
30.20 (*old version with pos2filename*)
30.21 fun hierarchy pm(*"pbl" | "met"*) h =
30.22 let val j = indentation
30.23 - fun nd i p (Ptyp (id,_,ns)) =
30.24 + fun nd i p (Celem.Ptyp (id,_,ns)) =
30.25 let val p' = Ctree.lev_on p
30.26 in (indt i) ^ "<NODE>\n" ^
30.27 (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^
30.28 @@ -50,7 +50,7 @@
30.29 (*.create a hierarchy with references to the guh's.*)
30.30 fun hierarchy_pbl h =
30.31 let val j = indentation
30.32 - fun nd i p (Ptyp (id,[n as {guh,...} : pbt],ns)) =
30.33 + fun nd i p (Celem.Ptyp (id,[n as {guh,...} : Celem.pbt],ns)) =
30.34 let val p' = Ctree.lev_on p
30.35 in (indt i) ^ "<NODE>\n" ^
30.36 (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^
30.37 @@ -63,10 +63,10 @@
30.38 end
30.39 and nds _ _ [] = ""
30.40 | nds i p (n::ns) = (nd i p n) ^ (nds i (Ctree.lev_on p) ns);
30.41 - in nds j [0] h : xml end;
30.42 + in nds j [0] h : Celem.xml end;
30.43 fun hierarchy_met h =
30.44 let val j = indentation
30.45 - fun nd i p (Ptyp (id,[n as {guh,...} : met],ns)) =
30.46 + fun nd i p (Celem.Ptyp (id,[n as {guh,...} : Celem.met],ns)) =
30.47 let val p' = Ctree.lev_on p
30.48 in (indt i) ^ "<NODE>\n" ^
30.49 (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^
30.50 @@ -79,11 +79,11 @@
30.51 end
30.52 and nds _ _ [] = ""
30.53 | nds i p (n::ns) = (nd i p n) ^ (nds i (Ctree.lev_on p) ns);
30.54 - in nds j [0] h : xml end;
30.55 + in nds j [0] h : Celem.xml end;
30.56 (* (writeln o hierarchy_pbl) (!ptyps);
30.57 *)
30.58
30.59 -fun pbl_hierarchy2file (path:path) =
30.60 +fun pbl_hierarchy2file (path : Celem.path) =
30.61 str2file (path ^ "pbl_hierarchy.xml")
30.62 ("<NODE>\n" ^
30.63 " <ID> problem hierarchy </ID>\n" ^
30.64 @@ -92,7 +92,7 @@
30.65 (hierarchy_pbl (get_ptyps ())) ^
30.66 "</NODE>");
30.67
30.68 -fun met_hierarchy2file (path:path) =
30.69 +fun met_hierarchy2file (path : Celem.path) =
30.70 str2file (path ^ "met_hierarchy.xml")
30.71 ("<NODE>\n" ^
30.72 " <ID> method hierarchy </ID>\n" ^
30.73 @@ -108,17 +108,17 @@
30.74 requires elements (rls, calc, ...) to be reorganized.*)
30.75 (*######## ATTENTION: THIS IS not THE ACTUAL VERSION ################*)
30.76 fun pbl2term thy (pblRD: Specify.pblRD) = (*WN120405.TODO.txt*)
30.77 - TermC.str2term ("Problem (" ^ (get_thy o theory2domID) thy ^ "', " ^ (strs2str' o rev) pblRD ^ ")");
30.78 + TermC.str2term ("Problem (" ^ (get_thy o Celem.theory2domID) thy ^ "', " ^ (strs2str' o rev) pblRD ^ ")");
30.79 (* term2str (pbl2term (Thy_Info_get_theory "Isac") ["equations","univariate","normalise"]);
30.80 val it = "Problem (Isac, [normalise, univariate, equations])" : string
30.81 *)
30.82 val i = indentation;
30.83
30.84 (* new version with <KESTOREREF>s -- not used *)
30.85 -fun pbl2xml (id:(*pblRD*)pblID) ({guh,mathauthors,init,cas,met,ppc,prls,
30.86 - thy,where_}:pbt) =
30.87 - let val thy' = theory2theory' thy
30.88 - val prls' = (#id o rep_rls) prls
30.89 +fun pbl2xml (id:(*pblRD*)Celem.pblID) ({guh,mathauthors,init,cas,met,ppc,prls,
30.90 + thy,where_}:Celem.pbt) =
30.91 + let val thy' = Celem.theory2theory' thy
30.92 + val prls' = (#id o Celem.rep_rls) prls
30.93 in "<NODECONTENT>\n" ^
30.94 indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
30.95 (((id2xml i)(* o rev*)) id) ^
30.96 @@ -139,18 +139,18 @@
30.97 indt i ^ "</THEORY>\n" ^
30.98 (case met of [] => (indt i) ^ "<METHODS> </METHODS>\n"
30.99 | _ => (indt i) ^ "<METHODS>\n" ^
30.100 - foldl op^ ("", map (keref2xml (i+i) Met_) met) ^
30.101 + foldl op ^ ("", map (keref2xml (i+i) Celem.Met_) met) ^
30.102 (indt i) ^ "</METHODS>\n") ^
30.103 indt i ^ "<EVALPRECOND>\n" ^
30.104 theref2xml (i+i) (snd (Rtools.thy_containing_rls thy' prls')) "Rulesets" prls'^
30.105 indt i ^ "</EVALPRECOND>\n" ^
30.106 authors2xml i "MATHAUTHORS" mathauthors ^
30.107 authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^
30.108 - "</NODECONTENT>" : xml
30.109 + "</NODECONTENT>" : Celem.xml
30.110 end;
30.111 (* old version with 'dead' strings for rls, calc, ....* *)
30.112 -fun pbl2xml (id:(*pblRD*)pblID) ({guh,mathauthors,init,cas,met,ppc,prls,
30.113 - thy,where_}:pbt) =
30.114 +fun pbl2xml (id:(*pblRD*)Celem.pblID) ({guh,mathauthors,init,cas,met,ppc,prls,
30.115 + thy,where_}:Celem.pbt) =
30.116 "<NODECONTENT>\n" ^
30.117 indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
30.118 (((id2xml i)(* o rev*)) id) ^
30.119 @@ -167,21 +167,21 @@
30.120 (*--------------- end display --------------------------------*)
30.121 ^
30.122 indt i ^ "<THEORY>\n" ^
30.123 - theref2xml (i+i) (theory2theory' thy) "Theorems" "" ^
30.124 + theref2xml (i+i) (Celem.theory2theory' thy) "Theorems" "" ^
30.125 indt i ^ "</THEORY>\n" ^
30.126 (case met of [] => (indt i) ^ "<METHODS> </METHODS>\n"
30.127 | _ => (indt i) ^ "<METHODS>\n" ^
30.128 - foldl op^ ("", map (keref2xml (i+i) Met_) met) ^
30.129 + foldl op^ ("", map (keref2xml (i+i) Celem.Met_) met) ^
30.130 (indt i) ^ "</METHODS>\n") ^
30.131 - indt i ^ "<EVALPRECOND> " ^ (#id o rep_rls)
30.132 + indt i ^ "<EVALPRECOND> " ^ (#id o Celem.rep_rls)
30.133 prls ^ " </EVALPRECOND>\n" ^
30.134 authors2xml i "MATHAUTHORS" mathauthors ^
30.135 authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^
30.136 - "</NODECONTENT>" : xml;
30.137 + "</NODECONTENT>" : Celem.xml;
30.138
30.139
30.140 (**. write pbls from hierarchy to files.**)
30.141 -fun pbl2file (path:path) (pos: Ctree.pos) (id:metID) (pbl as {guh,...}) =
30.142 +fun pbl2file (path: Celem.path) (pos: Ctree.pos) (id:Celem.metID) (pbl as {guh,...}) =
30.143 (writeln ("### pbl2file: id = " ^ strs2str id ^ ", pos = " ^ Ctree.pos2str pos);
30.144 ((str2file (path ^ Rtools.guh2filename guh)) o (pbl2xml id)) pbl
30.145 );
30.146 @@ -191,14 +191,14 @@
30.147 new version with <KESTOREREF>s -- not used because linking
30.148 requires elements (rls, calc, ...) to be reorganized.*)
30.149 (*######## ATTENTION: THIS IS not THE ACTUAL VERSION ################*)
30.150 -fun met2xml (id:metID) ({guh,mathauthors,init,ppc,pre,scr,calc,
30.151 - crls,erls,errpats,nrls,prls,srls,rew_ord'}:met) =
30.152 +fun met2xml (id: Celem.metID) ({guh,mathauthors,init,ppc,pre,scr,calc,
30.153 + crls,erls,errpats,nrls,prls,srls,rew_ord'}: Celem.met) =
30.154 let val thy' = "Isac" (*FIXME.WN0607 get thy from met ?!?*)
30.155 - val crls' = (#id o rep_rls) crls
30.156 - val erls' = (#id o rep_rls) erls
30.157 - val nrls' = (#id o rep_rls) nrls
30.158 - val prls' = (#id o rep_rls) prls
30.159 - val srls' = (#id o rep_rls) srls
30.160 + val crls' = (#id o Celem.rep_rls) crls
30.161 + val erls' = (#id o Celem.rep_rls) erls
30.162 + val nrls' = (#id o Celem.rep_rls) nrls
30.163 + val prls' = (#id o Celem.rep_rls) prls
30.164 + val srls' = (#id o Celem.rep_rls) srls
30.165 in "<NODECONTENT>\n" ^
30.166 indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
30.167 id2xml i id ^
30.168 @@ -225,12 +225,12 @@
30.169 calcs2xmlOLD i calc ^
30.170 authors2xml i "MATHAUTHORS" mathauthors ^
30.171 authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^
30.172 - "</NODECONTENT>" : xml
30.173 + "</NODECONTENT>" : Celem.xml
30.174 end;
30.175 (*.format a method in xml for presentation on the method browser;
30.176 old version with 'dead' strings for rls, calc, ....*)
30.177 -fun met2xml (id:metID) ({guh,mathauthors,init,ppc,pre,scr,calc,
30.178 - crls,erls,errpats,nrls,prls,srls,rew_ord'}:met) =
30.179 +fun met2xml (id: Celem.metID) ({guh,mathauthors,init,ppc,pre,scr,calc,
30.180 + crls,erls,errpats,nrls,prls,srls,rew_ord'}: Celem.met) =
30.181 "<NODECONTENT>\n" ^
30.182 indt i ^ "<GUH> " ^ guh ^ " </GUH>\n" ^
30.183 id2xml i id ^
30.184 @@ -238,33 +238,33 @@
30.185 scr2xml i scr ^
30.186 pattern2xml i ppc pre ^
30.187 indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^
30.188 - indt i ^ "<EVALPRECOND> " ^ (#id o rep_rls) prls ^ " </EVALPRECOND>\n" ^
30.189 - indt i ^ "<EVALCOND> " ^ (#id o rep_rls) erls ^ " </EVALCOND>\n" ^
30.190 - indt i ^ "<EVALLISTEXPR> "^ (#id o rep_rls) srls ^ " </EVALLISTEXPR>\n" ^
30.191 - indt i ^ "<CHECKELEMENTWISE> " ^ (#id o rep_rls)
30.192 + indt i ^ "<EVALPRECOND> " ^ (#id o Celem.rep_rls) prls ^ " </EVALPRECOND>\n" ^
30.193 + indt i ^ "<EVALCOND> " ^ (#id o Celem.rep_rls) erls ^ " </EVALCOND>\n" ^
30.194 + indt i ^ "<EVALLISTEXPR> "^ (#id o Celem.rep_rls) srls ^ " </EVALLISTEXPR>\n" ^
30.195 + indt i ^ "<CHECKELEMENTWISE> " ^ (#id o Celem.rep_rls)
30.196 crls ^ " </CHECKELEMENTWISE>\n" ^
30.197 - indt i ^ "<NORMALFORM> " ^ (#id o rep_rls) nrls ^ " </NORMALFORM>\n" ^
30.198 + indt i ^ "<NORMALFORM> " ^ (#id o Celem.rep_rls) nrls ^ " </NORMALFORM>\n" ^
30.199 indt i ^ "<REWORDER> " ^ rew_ord' ^ " </REWORDER>\n" ^
30.200 calcs2xmlOLD i calc ^
30.201 authors2xml i "MATHAUTHORS" mathauthors ^
30.202 authors2xml i "COURSEDESIGNS" ["isac team 2006"] ^
30.203 - "</NODECONTENT>" : xml;
30.204 + "</NODECONTENT>" : Celem.xml;
30.205 (* writeln (met2xml ["Test", "solve_linear"]
30.206 (get_met ["Test", "solve_linear"]));
30.207 *)
30.208
30.209 (*.write the files using an int-key (pos') as filename.*)
30.210 -fun met2file (path:path) (pos: Ctree.pos) (id:metID) met =
30.211 +fun met2file (path: Celem.path) (pos: Ctree.pos) (id: Celem.metID) met =
30.212 (writeln ("### met2file: id = " ^ strs2str id);
30.213 ((str2file (path ^ "met" ^ pos2filename pos)) o (met2xml id)) met);
30.214
30.215 (*.write the files using the guh as filename.*)
30.216 -fun met2file (path:path) (pos: Ctree.pos) (id:metID) (met as {guh,...}) =
30.217 +fun met2file (path: Celem.path) (pos: Ctree.pos) (id: Celem.metID) (met as {guh,...}) =
30.218 (writeln ("### met2file: id = " ^ strs2str id);
30.219 ((str2file (path ^ Rtools.guh2filename guh)) o (met2xml id)) met);
30.220
30.221 (*.scan the mtree Ptyp and print the nodes using wfn.*)
30.222 -fun node (pa:path) ids po wfn (Ptyp (id,[n],ns)) =
30.223 +fun node (pa: Celem.path) ids po wfn (Celem.Ptyp (id,[n],ns)) =
30.224 let val po' = Ctree.lev_on po
30.225 in
30.226 wfn pa po' (ids@[id]) n;
30.227 @@ -274,8 +274,8 @@
30.228 | nodes pa ids po wfn (n::ns) =
30.229 (node pa ids po wfn n; nodes pa ids (Ctree.lev_on po) wfn ns);
30.230
30.231 -fun pbls2file (p:path) = nodes p [] [0] pbl2file (get_ptyps ());
30.232 -fun mets2file (p:path) = nodes p [] [0] met2file (get_mets ());
30.233 +fun pbls2file (p: Celem.path) = nodes p [] [0] pbl2file (get_ptyps ());
30.234 +fun mets2file (p: Celem.path) = nodes p [] [0] met2file (get_mets ());
30.235 (*
30.236 val path = "/home/neuper/proto2/isac/xmldata/";
30.237 val path = "/home/neuper/tmp/";
30.238 @@ -291,11 +291,11 @@
30.239 *)
30.240
30.241 fun update_metdata
30.242 - ({guh, mathauthors, init, rew_ord', erls, srls, prls, crls, nrls, calc, ppc, pre, scr, ...}: met)
30.243 + ({guh, mathauthors, init, rew_ord', erls, srls, prls, crls, nrls, calc, ppc, pre, scr, ...}: Celem.met)
30.244 errpats' =
30.245 {guh = guh, mathauthors = mathauthors, init = init, rew_ord' = rew_ord', erls = erls,
30.246 srls = srls, prls = prls, crls = crls, nrls = nrls, calc = calc,
30.247 - ppc = ppc, pre = pre, scr = scr, errpats = errpats'}: met
30.248 + ppc = ppc, pre = pre, scr = scr, errpats = errpats'}: Celem.met
30.249
30.250 (* interface for dialog-authoring: call in Buld_Thydata.thy only ! *)
30.251 fun update_metpair thy metID errpats = let
31.1 --- a/src/Tools/isac/xmlsrc/thy-hierarchy.sml Tue Mar 13 15:04:27 2018 +0100
31.2 +++ b/src/Tools/isac/xmlsrc/thy-hierarchy.sml Thu Mar 15 10:17:44 2018 +0100
31.3 @@ -10,59 +10,59 @@
31.4
31.5 (* wrap theory-data into the uniform type thydata *)
31.6
31.7 -fun makeHthm (part : string, thyID : thyID) (thm : thm) =
31.8 - let val theID = [part, thyID, "Theorems"] @ [thmID_of_derivation_name' thm] : theID
31.9 - in (theID, Hthm {guh = theID2guh theID, coursedesign = [],
31.10 +fun makeHthm (part : string, thyID : Celem.thyID) (thm : thm) =
31.11 + let val theID = [part, thyID, "Theorems"] @ [Celem.thmID_of_derivation_name' thm] : Celem.theID
31.12 + in (theID, Celem.Hthm {guh = Celem.theID2guh theID, coursedesign = [],
31.13 mathauthors = ["isac-team"], fillpats = [], thm = thm})
31.14 end;
31.15 -fun makeHrls (part : string) (rls' : rls', thy_rls as (thyID, rls): thyID * rls) =
31.16 - let val theID = [part, thyID,"Rulesets"] @ [rls'] : theID
31.17 - in (theID, Hrls {guh = theID2guh theID, coursedesign=[],
31.18 +fun makeHrls (part : string) (rls' : Celem.rls', thy_rls as (thyID, rls): Celem.thyID * Celem.rls) =
31.19 + let val theID = [part, thyID,"Rulesets"] @ [rls'] : Celem.theID
31.20 + in (theID, Celem.Hrls {guh = Celem.theID2guh theID, coursedesign = [],
31.21 mathauthors = ["isac-team"], thy_rls = thy_rls})
31.22 end;
31.23 -fun makeHcal (part : string, thyID : thyID) (calID, cal) =
31.24 - let val theID = [part, thyID,"Operations"] @ [calID] : theID
31.25 - in (theID, Hcal {guh = theID2guh theID, coursedesign=[],
31.26 +fun makeHcal (part : string, thyID : Celem.thyID) (calID, cal) =
31.27 + let val theID = [part, thyID,"Operations"] @ [calID] : Celem.theID
31.28 + in (theID, Celem.Hcal {guh = Celem.theID2guh theID, coursedesign=[],
31.29 mathauthors = ["isac-team"], calc = cal})
31.30 end;
31.31 -fun makeHord (part : string, thyID : thyID) (ordID, ord) =
31.32 - let val theID = [part, thyID,"TODO-Orders"] @ [ordID] : theID
31.33 - in (theID, Hord {guh = theID2guh theID, coursedesign=[],
31.34 +fun makeHord (part : string, thyID : Celem.thyID) (ordID, ord) =
31.35 + let val theID = [part, thyID,"TODO-Orders"] @ [ordID] : Celem.theID
31.36 + in (theID, Celem.Hord {guh = Celem.theID2guh theID, coursedesign=[],
31.37 mathauthors = ["isac-team"], ord = ord})
31.38 end;
31.39
31.40 -fun revert_sym thy (Thm (thmID, thm)) =
31.41 - if (Rtools.is_sym o thmID_of_derivation_name) thmID
31.42 +fun revert_sym thy (Celem.Thm (thmID, thm)) =
31.43 + if (Rtools.is_sym o Celem.thmID_of_derivation_name) thmID
31.44 then
31.45 let
31.46 val thmID' = Rtools.sym_drop thmID
31.47 val thm' = Rewrite.assoc_thm' thy (thmID',"")
31.48 val thmDeriv' = Thm.get_name_hint thm'
31.49 - in Thm (thmDeriv', thm') end
31.50 - else Thm (Thm.get_name_hint thm, thm)
31.51 + in Celem.Thm (thmDeriv', thm') end
31.52 + else Celem.Thm (Thm.get_name_hint thm, thm)
31.53
31.54 (* get all theorems from the list of rule-sets (defined in Knowledge) *)
31.55 -fun thms_of_rlss thy rlss = (rlss : (rls' * (theory' * rls)) list)
31.56 +fun thms_of_rlss thy rlss = (rlss : (Celem.rls' * (Celem.theory' * Celem.rls)) list)
31.57 |> map (Rtools.thms_of_rls o #2 o #2)
31.58 |> flat
31.59 |> map (revert_sym thy)
31.60 - |> map (fn Thm (thmID, thm) => (thmID, thm))
31.61 + |> map (fn Celem.Thm (thmID, thm) => (thmID, thm))
31.62 |> gen_distinct (fn ((thmID1, _), (thmID2, _)) => thmID1 = thmID2)
31.63 - : (thmID * thm) list
31.64 + : (Celem.thmID * thm) list
31.65
31.66 (* collect all thydata defined in in a theory *)
31.67
31.68 fun collect_thms part thy =
31.69 map (makeHthm (part, Context.theory_name thy)) (rev (thms_of thy))
31.70 -fun collect_rlss part rlss thys = (rlss : (rls' * (thyID * rls)) list)
31.71 +fun collect_rlss part rlss thys = (rlss : (Celem.rls' * (Celem.thyID * Celem.rls)) list)
31.72 |> filter (fn (_, (thyID, _)) => member (op=) (map Context.theory_name thys) thyID)
31.73 |> map (makeHrls part)
31.74 fun collect_cals (part, thy') =
31.75 let val cals = [] (*FIXXXXXXXXXXME.WN060713 add thyID: (thyID, cal)*)
31.76 in map (makeHcal (part, thy')) cals end;
31.77 fun collect_ords (part, thy') =
31.78 - let val thy = assoc_thy (thyID2theory' thy')
31.79 - in [(*TODO.WN060120 rew_ord, Calc*)]:(theID * thydata) list end;
31.80 + let val thy = Celem.assoc_thy (Celem.thyID2theory' thy')
31.81 + in [(*TODO.WN060120 rew_ord, Calc*)]:(Celem.theID * Celem.thydata) list end;
31.82
31.83 (* parts are: Isabelle | IsacKnowledge | IsacScripts, see KEStore.thy *)
31.84 fun collect_part part parent thys =
31.85 @@ -73,9 +73,9 @@
31.86 (* collect theorems defined in Isabelle *)
31.87 fun collect_isab isa (thmDeriv, thm) =
31.88 let val theID =
31.89 - [isa, thyID_of_derivation_name thmDeriv, "Theorems", thmID_of_derivation_name thmDeriv]
31.90 + [isa, Celem.thyID_of_derivation_name thmDeriv, "Theorems", Celem.thmID_of_derivation_name thmDeriv]
31.91 in
31.92 - (theID:theID, Hthm {guh = theID2guh theID,
31.93 + (theID: Celem.theID, Celem.Hthm {guh = Celem.theID2guh theID,
31.94 mathauthors = ["Isabelle team, TU Munich"],
31.95 coursedesign = [],
31.96 fillpats = [],
31.97 @@ -93,7 +93,7 @@
31.98 let
31.99 val i = indentation
31.100 val j = indentation
31.101 - fun node i p theID (Ptyp (id, _, ns)) =
31.102 + fun node i p theID (Celem.Ptyp (id, _, ns)) =
31.103 let
31.104 val p' = Ctree.lev_on p
31.105 val theID' = theID @ [id]
31.106 @@ -101,7 +101,7 @@
31.107 (indt i) ^ "<NODE>\n" ^
31.108 (indt (i+j)) ^ "<ID> " ^ id ^ " </ID>\n" ^
31.109 (indt (i+j)) ^ "<NO> " (*on this level*) ^ (string_of_int o last_elem) p' ^ " </NO>\n" ^
31.110 - (indt (i+j)) ^ "<CONTENTREF> " ^ theID2guh theID' ^ " </CONTENTREF>\n" ^
31.111 + (indt (i+j)) ^ "<CONTENTREF> " ^ Celem.theID2guh theID' ^ " </CONTENTREF>\n" ^
31.112 (nodes (i+j) (Ctree.lev_dn p') theID' ns) ^
31.113 (indt i) ^ "</NODE>\n"
31.114 end
31.115 @@ -109,7 +109,7 @@
31.116 | nodes i p theID (n :: ns) = (node i p theID n) ^ (nodes i (Ctree.lev_on p) theID ns);
31.117 in nodes j [0] [] h end;
31.118
31.119 -fun thy_hierarchy2file (path:path) =
31.120 +fun thy_hierarchy2file (path: Celem.path) =
31.121 str2file (path ^ "thy_hierarchy.xml")
31.122 ("<NODE>\n" ^
31.123 " <ID> theory hierarchy </ID>\n" ^
31.124 @@ -121,15 +121,15 @@
31.125 (* create the xml-files for the thydata in the hierarchy *)
31.126 val i = indentation;
31.127 (* analoguous to 'fun met2xml' *)
31.128 -fun thydata2xml (theID:theID, Html {guh, coursedesign, mathauthors, html}) =
31.129 +fun thydata2xml (theID: Celem.theID, Celem.Html {guh, coursedesign, mathauthors, html}) =
31.130 "<HTMLDATA>\n" ^
31.131 indt i ^ "<GUH> "^ guh ^" </GUH>\n" ^
31.132 id2xml i theID ^
31.133 indt i ^ "<EXPLANATIONS> " ^ html ^ "</EXPLANATIONS>\n" ^
31.134 authors2xml i "MATHAUTHORS" mathauthors ^
31.135 authors2xml i "COURSEDESIGNS" coursedesign ^
31.136 - "</HTMLDATA>\n" : xml
31.137 - | thydata2xml (theID, Hthm {guh, coursedesign, mathauthors, fillpats(*TODO?*), thm}) =
31.138 + "</HTMLDATA>\n" : Celem.xml
31.139 + | thydata2xml (theID, Celem.Hthm {guh, coursedesign, mathauthors, fillpats(*TODO?*), thm}) =
31.140 "<THEOREMDATA>\n" ^
31.141 indt i ^ "<GUH> "^ guh ^" </GUH>\n" ^
31.142 id2xml i theID ^
31.143 @@ -143,7 +143,7 @@
31.144 authors2xml i "MATHAUTHORS" mathauthors ^
31.145 authors2xml i "COURSEDESIGNS" coursedesign ^
31.146 "</THEOREMDATA>\n"
31.147 - | thydata2xml (theID, Hrls {guh, coursedesign, mathauthors, thy_rls}) =
31.148 + | thydata2xml (theID, Celem.Hrls {guh, coursedesign, mathauthors, thy_rls}) =
31.149 "<RULESETDATA>\n" ^
31.150 indt i ^ "<GUH> "^ guh ^" </GUH>\n" ^
31.151 id2xml i theID ^
31.152 @@ -152,11 +152,11 @@
31.153 authors2xml i "MATHAUTHORS" mathauthors ^
31.154 authors2xml i "COURSEDESIGNS" coursedesign ^
31.155 "</RULESETDATA>\n"
31.156 - | thydata2xml (theID, Hcal {guh, coursedesign, mathauthors, calc}) =
31.157 + | thydata2xml (theID, Celem.Hcal {guh, coursedesign, mathauthors, calc}) =
31.158 "<RULESETDATA>\n" ^
31.159 indt i ^ "<GUH> "^ guh ^" </GUH>\n" ^
31.160 id2xml i theID ^
31.161 - calc2xml i (theID2thyID theID, calc) ^
31.162 + calc2xml i (Celem.theID2thyID theID, calc) ^
31.163 indt i ^ "<EXPLANATIONS> </EXPLANATIONS>\n" ^
31.164 authors2xml i "MATHAUTHORS" mathauthors ^
31.165 authors2xml i "COURSEDESIGNS" coursedesign ^
31.166 @@ -165,12 +165,12 @@
31.167 error ("thydata2xml: not implemented for "^ strs2str' theID);
31.168
31.169 (* analoguous to 'fun met2file' *)
31.170 -fun thydata2file (path : path) (pos : Ctree.pos) (theID : theID) thydata =
31.171 +fun thydata2file (path : Celem.path) (pos : Ctree.pos) (theID : Celem.theID) thydata =
31.172 (writeln ("### thes2file: id = " ^ strs2str theID);
31.173 str2file (path ^ Rtools.theID2filename theID) (thydata2xml (theID, thydata)));
31.174
31.175 (* analoguous to 'fun node' *)
31.176 -fun thenode (pa : path) ids po wfn (Ptyp (id, [n], ns)) =
31.177 +fun thenode (pa : Celem.path) ids po wfn (Celem.Ptyp (id, [n], ns)) =
31.178 let val po' = Ctree.lev_on po
31.179 in wfn pa po' (ids @ [id]) n; thenodes pa (ids @ [id]) (Ctree.lev_dn po') wfn ns end
31.180 and thenodes _ _ _ _ [] = ()
31.181 @@ -178,64 +178,64 @@
31.182 (thenode pa ids po wfn n; thenodes pa ids (Ctree.lev_on po) wfn ns);
31.183
31.184 (* analoguous to 'fun mets2file' *)
31.185 -fun thes2file (p : path) = thenodes p [] [0] thydata2file (get_thes ());
31.186 +fun thes2file (p : Celem.path) = thenodes p [] [0] thydata2file (get_thes ());
31.187
31.188
31.189 (***.store a single theory element in the hierarchy.***)
31.190
31.191 (*.for mathauthors only, other html is added to xml exported from here.*)
31.192 -fun make_isa thy (part, thypart) (mathauthors : authors) =
31.193 +fun make_isa thy (part, thypart) (mathauthors : Celem.authors) =
31.194 let
31.195 - val theID = [part, string_of_thy thy, thypart]
31.196 + val theID = [part, Celem.string_of_thy thy, thypart]
31.197 val guh = case theID of
31.198 - [part] => part2guh theID
31.199 - | [part, thyID, thypart] => thypart2guh theID
31.200 + [part] => Celem.part2guh theID
31.201 + | [part, thyID, thypart] => Celem.thypart2guh theID
31.202 val theID = Rtools.guh2theID guh
31.203 - val the = Html {guh = guh, coursedesign = [], mathauthors = mathauthors, html = ""}
31.204 + val the = Celem.Html {guh = guh, coursedesign = [], mathauthors = mathauthors, html = ""}
31.205 in (the, theID) end
31.206
31.207 -fun make_thy thy (mathauthors : authors) =
31.208 +fun make_thy thy (mathauthors : Celem.authors) =
31.209 let
31.210 - val guh = thy2guh ["IsacKnowledge", theory2thyID thy]
31.211 + val guh = Celem.thy2guh ["IsacKnowledge", Celem.theory2thyID thy]
31.212 val theID = Rtools.guh2theID guh
31.213 - val the = Html {guh = guh, coursedesign = [], mathauthors = mathauthors, html = ""}
31.214 + val the = Celem.Html {guh = guh, coursedesign = [], mathauthors = mathauthors, html = ""}
31.215 in (the, theID) end
31.216
31.217 -fun make_thm thy part (thmID : thmID, thm) (mathauthors : authors) =
31.218 +fun make_thm thy part (thmID : Celem.thmID, thm) (mathauthors : Celem.authors) =
31.219 let
31.220 - val guh = thm2guh (part, theory2thyID thy) thmID
31.221 + val guh = Celem.thm2guh (part, Celem.theory2thyID thy) thmID
31.222 val theID = Rtools.guh2theID guh
31.223 - val the = Hthm {guh = guh, coursedesign = [(*inserted in xml after export*)],
31.224 + val the = Celem.Hthm {guh = guh, coursedesign = [(*inserted in xml after export*)],
31.225 mathauthors = mathauthors, fillpats = [], thm = thm}
31.226 in (the, theID) end
31.227
31.228 -fun make_rls thy rls (mathauthors : authors) =
31.229 +fun make_rls thy rls (mathauthors : Celem.authors) =
31.230 let
31.231 - val guh = rls2guh ("IsacKnowledge", theory2thyID thy) ((#id o rep_rls) rls)
31.232 + val guh = Celem.rls2guh ("IsacKnowledge", Celem.theory2thyID thy) ((#id o Celem.rep_rls) rls)
31.233 val theID = Rtools.guh2theID guh
31.234 - val the = Hrls {guh = guh, coursedesign = [], mathauthors = mathauthors,
31.235 - thy_rls = (theory2thyID thy, rls)}
31.236 + val the = Celem.Hrls {guh = guh, coursedesign = [], mathauthors = mathauthors,
31.237 + thy_rls = (Celem.theory2thyID thy, rls)}
31.238 (*needs no (!check_guhs_unique) because guh is generated automatically*)
31.239 in (the, theID) end
31.240
31.241 -fun make_cal thy cal (mathauthors : authors) =
31.242 +fun make_cal thy cal (mathauthors : Celem.authors) =
31.243 let
31.244 - val guh = cal2guh ("IsacKnowledge", theory2thyID thy) ("TODO store_cal")
31.245 + val guh = Celem.cal2guh ("IsacKnowledge", Celem.theory2thyID thy) ("TODO store_cal")
31.246 val theID = Rtools.guh2theID guh
31.247 - val the = Hcal {guh = guh, coursedesign = [], mathauthors = mathauthors, calc = cal}
31.248 + val the = Celem.Hcal {guh = guh, coursedesign = [], mathauthors = mathauthors, calc = cal}
31.249 in (the, theID) end
31.250
31.251 -fun make_ord thy ord (mathauthors : authors) =
31.252 +fun make_ord thy ord (mathauthors : Celem.authors) =
31.253 let
31.254 - val guh = ord2guh ("IsacKnowledge", theory2thyID thy) ("TODO store_ord")
31.255 + val guh = Celem.ord2guh ("IsacKnowledge", Celem.theory2thyID thy) ("TODO store_ord")
31.256 val theID = Rtools.guh2theID guh
31.257 - val the = Hord {guh = guh, coursedesign = [], mathauthors = mathauthors, ord = ord}
31.258 + val the = Celem.Hord {guh = guh, coursedesign = [], mathauthors = mathauthors, ord = ord}
31.259 in (the, theID) end
31.260
31.261 fun insert_errpatIDs thy theID errpatIDs = (* TODO: redo like insert_fillpatts *)
31.262 let
31.263 val hrls = Specify.get_the theID
31.264 - val hrls' = update_hrls hrls errpatIDs
31.265 + val hrls' = Celem.update_hrls hrls errpatIDs
31.266 handle ERROR _ => error ("insert_errpatIDs: " ^ strs2str theID ^ "must address a rule-set")
31.267 in (hrls', theID) end
31.268