1.1 --- a/src/Tools/isac/Build_Isac.thy Fri Oct 25 16:07:15 2019 +0200
1.2 +++ b/src/Tools/isac/Build_Isac.thy Sat Oct 26 13:03:16 2019 +0200
1.3 @@ -34,17 +34,22 @@
1.4 ML_file rewrite.sml
1.5 *) "ProgLang/ProgLang"
1.6 (*
1.7 - theory Input_Descript imports "~~/src/Tools/isac/CalcElements/CalcElements"
1.8 - theory Specify imports "~~/src/Tools/isac/ProgLang/ProgLang" Input_Descript
1.9 + theory MathEngBasic imports
1.10 + "~~/src/Tools/isac/ProgLang/ProgLang" "~~/src/Tools/isac/Specify/Input_Descript"
1.11 + ML_file "calc-tree-elem.sml"
1.12 ML_file model.sml
1.13 ML_file mstools.sml
1.14 ML_file "specification-elems.sml"
1.15 ML_file istate.sml
1.16 ML_file tactic.sml
1.17 - ML_file "ctree-basic.sml" (*shift to base in common with Interpret*)
1.18 - ML_file "ctree-access.sml"(*shift to base in common with Interpret*)
1.19 - ML_file "ctree-navi.sml" (*shift to base in common with Interpret*)
1.20 - ML_file ctree.sml (*shift to base in common with Interpret*)
1.21 + ML_file "ctree-basic.sml"
1.22 + ML_file "ctree-access.sml"
1.23 + ML_file "ctree-navi.sml"
1.24 + ML_file ctree.sml
1.25 +*) "MathEngBasic/MathEngBasic"
1.26 +(*
1.27 + theory Input_Descript imports "~~/src/Tools/isac/CalcElements/CalcElements"
1.28 + theory Specify imports "~~/src/Tools/isac/ProgLang/ProgLang" Input_Descript
1.29 ML_file ptyps.sml
1.30 ML_file generate.sml
1.31 ML_file calchead.sml
2.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2 +++ b/src/Tools/isac/MathEngBasic/MathEngBasic.thy Sat Oct 26 13:03:16 2019 +0200
2.3 @@ -0,0 +1,25 @@
2.4 +(* Title: collect all defitions for the Lucas-Interpreter
2.5 + Author: Walther Neuper 110226
2.6 + (c) due to copyright terms
2.7 + *)
2.8 +
2.9 +theory MathEngBasic
2.10 +imports "~~/src/Tools/isac/ProgLang/ProgLang" "~~/src/Tools/isac/Specify/Input_Descript"
2.11 +begin
2.12 +(* removed all warnings here, only "handle _" remains *)
2.13 + ML_file "calc-tree-elem.sml"
2.14 + ML_file model.sml
2.15 + ML_file mstools.sml
2.16 + ML_file "specification-elems.sml"
2.17 + ML_file istate.sml
2.18 + ML_file tactic.sml
2.19 + ML_file "ctree-basic.sml"
2.20 + ML_file "ctree-access.sml"
2.21 + ML_file "ctree-navi.sml"
2.22 + ML_file ctree.sml
2.23 +
2.24 +ML \<open>
2.25 +\<close> ML \<open>
2.26 +\<close> ML \<open>
2.27 +\<close>
2.28 +end
3.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
3.2 +++ b/src/Tools/isac/MathEngBasic/calc-tree-elem.sml Sat Oct 26 13:03:16 2019 +0200
3.3 @@ -0,0 +1,15 @@
3.4 +(* Title: MathEngBasic/calc-tree-elem.sml
3.5 + Author: Walther Neuper 191026
3.6 + (c) due to copyright terms
3.7 +*)
3.8 +signature CALC_TREE_ELEMENT =
3.9 +sig
3.10 +
3.11 +end
3.12 +
3.13 +(**)
3.14 +structure Telem(**): CALC_TREE_ELEMENT(**) =
3.15 +struct
3.16 +(**)
3.17 +
3.18 +(**)end(**)
4.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
4.2 +++ b/src/Tools/isac/MathEngBasic/ctree-access.sml Sat Oct 26 13:03:16 2019 +0200
4.3 @@ -0,0 +1,273 @@
4.4 +(* Title: read and write access to the calctree
4.5 + Author: Walther Neuper 2017
4.6 + (c) due to copyright terms
4.7 +*)
4.8 +signature CALC_TREE_ACCESS =
4.9 +sig
4.10 +
4.11 + val get_last_formula: CTbasic.state -> term
4.12 + val update_branch : CTbasic.ctree -> CTbasic.pos -> CTbasic.branch -> CTbasic.ctree
4.13 + val update_ctxt : CTbasic.ctree -> CTbasic.pos -> Proof.context -> CTbasic.ctree
4.14 + val update_env : CTbasic.ctree -> CTbasic.pos -> (Istate.T * Proof.context) option -> CTbasic.ctree
4.15 + val update_domID : CTbasic.ctree -> CTbasic.pos -> Rule.domID -> CTbasic.ctree
4.16 + val update_met : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =vvv= ? *)
4.17 + val update_metppc : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =^^^= ? *)
4.18 + val update_metID : CTbasic.ctree -> CTbasic.pos -> Celem.metID -> CTbasic.ctree
4.19 + val update_pbl : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =vvv= ? *)
4.20 + val update_pblppc : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =^^^= ? *)
4.21 + val update_pblID : CTbasic.ctree -> CTbasic.pos -> Celem.pblID -> CTbasic.ctree
4.22 + val update_oris : CTbasic.ctree -> CTbasic.pos -> Model.ori list -> CTbasic.ctree
4.23 + val update_orispec : CTbasic.ctree -> CTbasic.pos -> Celem.spec -> CTbasic.ctree
4.24 + val update_spec : CTbasic.ctree -> CTbasic.pos -> Celem.spec -> CTbasic.ctree
4.25 + val update_tac : CTbasic.ctree -> CTbasic.pos -> Tactic.input -> CTbasic.ctree
4.26 +
4.27 + val upd_istate_ctxt : CTbasic.state -> Istate.T * Proof.context -> CTbasic.ctree
4.28 + val upd_istate : CTbasic.state -> Istate.T -> CTbasic.ctree
4.29 + val upd_ctxt : CTbasic.state ->Proof.context -> CTbasic.ctree
4.30 +
4.31 + val cappend_form : CTbasic.ctree -> CTbasic.pos -> Istate.T * Proof.context -> term ->
4.32 + CTbasic.ctree * CTbasic.pos' list
4.33 + val cappend_problem : CTbasic.ctree -> CTbasic.pos -> Istate.T * Proof.context ->
4.34 + Selem.fmz -> Model.ori list * Celem.spec * term -> CTbasic.ctree * CTbasic.pos' list
4.35 + val append_result : CTbasic.ctree -> CTbasic.pos -> Istate.T * Proof.context ->
4.36 + Selem.result -> CTbasic.ostate -> CTbasic.ctree * 'a list
4.37 + val append_atomic : (* for solve.sml *)
4.38 + CTbasic.pos -> Istate.T * Proof.context -> term -> Tactic.input -> Selem.result ->
4.39 + CTbasic.ostate -> CTbasic.ctree -> CTbasic.ctree
4.40 + val cappend_atomic : CTbasic.ctree -> CTbasic.pos -> Istate.T * Proof.context -> term ->
4.41 + Tactic.input -> Selem.result -> CTbasic.ostate -> CTbasic.ctree * CTbasic.pos' list
4.42 +(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
4.43 + val cappend_parent : CTbasic.ctree -> int list -> Istate.T * Proof.context -> term ->
4.44 + Tactic.input -> CTbasic.branch -> CTbasic.ctree * CTbasic.pos' list
4.45 +(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
4.46 + val update_loc' : CTbasic.ctree -> CTbasic.pos ->
4.47 + (Istate.T * Proof.context) option * (Istate.T * Proof.context) option -> CTbasic.ctree
4.48 + val append_problem : int list -> Istate.T * Proof.context -> Selem.fmz ->
4.49 + Model.ori list * Celem.spec * term -> CTbasic.ctree -> CTbasic.ctree
4.50 +( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
4.51 +end
4.52 +(**)
4.53 +structure CTaccess(**): CALC_TREE_ACCESS(**) =
4.54 +struct
4.55 +(**)
4.56 +open CTbasic
4.57 +
4.58 +fun get_last_formula (pt, (p, _)) =
4.59 + let
4.60 + val res = get_obj g_res pt p
4.61 + in
4.62 + if res = Rule.e_term
4.63 + then get_obj g_form pt p
4.64 + else res
4.65 + end
4.66 +
4.67 +(* for use by appl_obj *)
4.68 +fun repl_pbl x (PblObj {cell, origin, fmz, spec, probl = _, meth, ctxt, env, loc,
4.69 + branch, result, ostate}) =
4.70 + PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl= x, meth = meth,
4.71 + ctxt = ctxt, env = env, loc = loc, branch = branch, result = result, ostate = ostate}
4.72 + | repl_pbl _ _ = raise PTREE "repl_pbl takes no PrfObj";
4.73 +fun repl_met x (PblObj {cell, origin, fmz, spec, probl, meth = _, ctxt, env, loc,
4.74 + branch, result, ostate}) =
4.75 + PblObj {cell = cell, origin = origin, fmz= fmz, spec = spec, probl = probl,
4.76 + meth = x, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
4.77 + ostate = ostate}
4.78 + | repl_met _ _ = raise PTREE "repl_pbl takes no PrfObj";
4.79 +fun repl_spec x (PblObj {cell, origin, fmz, spec = _, probl, meth, ctxt, env, loc,
4.80 + branch, result, ostate}) =
4.81 + PblObj {cell = cell, origin = origin, fmz = fmz, spec = x, probl = probl,
4.82 + meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
4.83 + ostate = ostate}
4.84 + | repl_spec _ _ = raise PTREE "repl_domID takes no PrfObj";
4.85 +fun repl_domID x (PblObj {cell, origin, fmz, spec = (_, p, m), probl, meth, ctxt, env, loc,
4.86 + branch, result, ostate}) =
4.87 + PblObj {cell = cell, origin = origin, fmz = fmz, spec= (x, p, m), probl = probl,
4.88 + meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
4.89 + ostate = ostate}
4.90 + | repl_domID _ _ = raise PTREE "repl_domID takes no PrfObj";
4.91 +fun repl_pblID x (PblObj {cell, origin, fmz, spec= (d, _, m), probl, meth, ctxt, env, loc,
4.92 + branch, result, ostate}) =
4.93 + PblObj {cell = cell, origin = origin, fmz = fmz, spec= (d, x, m), probl = probl,
4.94 + meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
4.95 + ostate = ostate}
4.96 + | repl_pblID _ _ = raise PTREE "repl_pblID takes no PrfObj";
4.97 +fun repl_metID x (PblObj {cell, origin, fmz, spec = (d, p,_), probl, meth, ctxt, env, loc,
4.98 + branch, result, ostate}) =
4.99 + PblObj {cell = cell, origin = origin, fmz = fmz, spec = (d, p, x), probl = probl,
4.100 + meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
4.101 + ostate = ostate}
4.102 + | repl_metID _ _ = raise PTREE "repl_metID takes no PrfObj";
4.103 +fun repl_result l f' s (PrfObj {cell, form, tac, loc = _, branch, result = _ , ostate = _}) =
4.104 + PrfObj {cell = cell, form = form, tac = tac, loc = l, branch = branch, result = f', ostate = s}
4.105 + | repl_result l f' s (PblObj {cell, origin, fmz, spec, probl, meth, ctxt, env, loc = _,
4.106 + branch, result = _ , ostate= _}) =
4.107 + PblObj {cell = cell, origin = origin, fmz= fmz, spec = spec, probl = probl,
4.108 + meth = meth, ctxt = ctxt, env = env, loc = l, branch = branch, result = f', ostate = s};
4.109 +fun repl_tac x (PrfObj {cell, form, tac = _, loc, branch, result, ostate}) =
4.110 + PrfObj {cell = cell, form = form, tac = x, loc = loc, branch = branch,
4.111 + result = result, ostate = ostate}
4.112 + | repl_tac _ _ = raise PTREE "repl_tac takes no PblObj";
4.113 +fun repl_ctxt x (PblObj {cell, origin, fmz, spec, probl, meth,
4.114 + ctxt = _, env, loc, branch, result, ostate}) =
4.115 + PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl = probl,
4.116 + meth = meth, ctxt = x, env = env, loc = loc, branch = branch, result = result,
4.117 + ostate = ostate}
4.118 + | repl_ctxt _ _ = raise PTREE "repl_env takes no PrfObj";
4.119 +fun repl_env e (PblObj {cell, origin, fmz, spec, probl, meth,
4.120 + ctxt, env = _, loc, branch, result, ostate}) =
4.121 + PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl = probl,
4.122 + meth = meth, ctxt = ctxt, env = e, loc = loc, branch = branch, result = result,
4.123 + ostate = ostate}
4.124 + | repl_env _ _ = raise PTREE "repl_env takes no PrfObj";
4.125 +fun repl_oris oris (PblObj { cell, origin = (_, spe, hdf),fmz, spec, probl, meth,
4.126 + ctxt, env, loc, branch, result, ostate}) =
4.127 + PblObj{cell = cell, origin = (oris, spe, hdf), fmz = fmz, spec = spec, probl = probl,
4.128 + meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
4.129 + ostate = ostate}
4.130 + | repl_oris _ _ = raise PTREE "repl_oris takes no PrfObj";
4.131 +fun repl_orispec spe (PblObj {cell, origin = (oris, _, hdf), fmz, spec, probl, meth,
4.132 + ctxt, env, loc, branch, result, ostate}) =
4.133 + PblObj{cell = cell, origin = (oris, spe, hdf), fmz = fmz, spec = spec, probl = probl,
4.134 + meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
4.135 + ostate = ostate}
4.136 + | repl_orispec _ _ = raise PTREE "repl_orispec takes no PrfObj";
4.137 +fun repl_loc l (PblObj {cell, origin, fmz, spec, probl, meth,
4.138 + ctxt, env, loc = _ , branch, result, ostate}) =
4.139 + PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl = probl,
4.140 + meth = meth, ctxt = ctxt, env = env, loc = l, branch = branch, result = result,
4.141 + ostate = ostate}
4.142 + | repl_loc l (PrfObj {cell, form, tac, loc = _, branch, result, ostate}) =
4.143 + PrfObj {cell = cell, form = form, tac = tac, loc= l, branch = branch, result = result,
4.144 + ostate = ostate}
4.145 +
4.146 +
4.147 +fun repl_branch b (PblObj {cell, origin, fmz, spec, probl, meth, ctxt, env, loc, branch = _,
4.148 + result, ostate}) =
4.149 + PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl = probl,
4.150 + meth = meth, ctxt = ctxt, env = env, loc = loc, branch = b, result = result,
4.151 + ostate = ostate}
4.152 + | repl_branch b (PrfObj {cell, form, tac, loc, branch = _, result, ostate}) =
4.153 + PrfObj {cell = cell, form = form, tac = tac, loc = loc, branch = b,
4.154 + result = result, ostate = ostate};
4.155 +
4.156 +fun update_branch pt pos x = appl_obj (repl_branch x) pt pos;
4.157 +fun update_ctxt pt pos x = appl_obj (repl_ctxt x) pt pos; (* for use on PblObj,
4.158 + otherwise use fun generate1; compare fun get_ctxt*)
4.159 +fun update_env pt pos x = appl_obj (repl_env x) pt pos;
4.160 +fun update_domID pt pos x = appl_obj (repl_domID x) pt pos;
4.161 +fun update_met pt pos x = appl_obj (repl_met x) pt pos;
4.162 +fun update_metppc pt pos x = appl_obj (repl_met x) pt pos;
4.163 +fun update_metID pt pos x = appl_obj (repl_metID x) pt pos;
4.164 +fun update_pbl pt pos x = appl_obj (repl_pbl x) pt pos;
4.165 +fun update_pblppc pt pos x = appl_obj (repl_pbl x) pt pos;
4.166 +fun update_pblID pt pos x = appl_obj (repl_pblID x) pt pos;
4.167 +fun update_oris pt pos x = appl_obj (repl_oris x) pt pos;
4.168 +fun update_orispec pt pos x = appl_obj (repl_orispec x) pt pos;
4.169 +fun update_spec pt pos x = appl_obj (repl_spec x) pt pos;
4.170 +fun update_tac pt pos x = appl_obj (repl_tac x) pt pos;
4.171 +
4.172 +fun update_loc' pt pos x = appl_obj (repl_loc x) pt pos;
4.173 +(* the update wrt. get_ctxt, get_istate; all other functions are deprecated*)
4.174 +fun upd_istate_ctxt (pt, (p, p_)) (istate, ctxt) =
4.175 + let
4.176 + val (for_other, for_result) = get_obj g_loc pt p
4.177 + in
4.178 + if p_ = Res
4.179 + then update_loc' pt p (for_other, SOME (istate, ctxt))
4.180 + else update_loc' pt p (SOME (istate, ctxt), for_result)
4.181 +end
4.182 +fun upd_istate (pt, (p, p_)) istate =
4.183 + let
4.184 + val (for_other, for_result) = get_obj g_loc pt p
4.185 + in
4.186 + if p_ = Res
4.187 + then
4.188 + case for_result of
4.189 + NONE => update_loc' pt p (for_other, SOME (istate, ContextC.e_ctxt(*!!!*)))
4.190 + | SOME (_, ctxt) => update_loc' pt p (for_other, SOME (istate, ctxt))
4.191 + else
4.192 + case for_other of
4.193 + NONE => update_loc' pt p (SOME (istate, ContextC.e_ctxt(*!!!*)), for_result)
4.194 + | SOME (_, ctxt) => update_loc' pt p (SOME (istate, ctxt), for_result)
4.195 +end
4.196 +fun upd_ctxt (pt, (p, p_)) ctxt =
4.197 + let
4.198 + val (for_other, for_result) = get_obj g_loc pt p
4.199 + in
4.200 + if p_ = Res
4.201 + then
4.202 + case for_result of
4.203 + NONE => update_loc' pt p (for_other, SOME (Istate.e_istate(*!!!*), ctxt))
4.204 + | SOME (istate, _) => update_loc' pt p (for_other, SOME (istate, ctxt))
4.205 + else
4.206 + case for_other of
4.207 + NONE => update_loc' pt p (SOME (Istate.e_istate(*!!!*), ctxt), for_result)
4.208 + | SOME (istate, _) => update_loc' pt p (SOME (istate, ctxt), for_result)
4.209 +end
4.210 +
4.211 +(* called by Take *)
4.212 +fun append_form p l f pt =
4.213 + insert_pt (PrfObj {cell = NONE, form = f, tac = Tactic.Empty_Tac, loc = (SOME l, NONE),
4.214 + branch = NoBranch, result = (Rule.e_term, []), ostate = Incomplete}) pt p;
4.215 +fun cappend_form pt p loc f =
4.216 + let
4.217 + val (pt', cs) = cut_tree pt (p, Frm)
4.218 + val pt'' = append_form p loc f pt'
4.219 + in (pt'', cs) end;
4.220 +
4.221 +fun append_problem [] l fmz (strs, spec, hdf) _ =
4.222 + (Nd (PblObj {cell = NONE, origin = (strs, spec, hdf), fmz = fmz, spec = Celem.empty_spec,
4.223 + probl = [], meth = [], ctxt = ContextC.e_ctxt, env = NONE, loc = (SOME l, NONE),
4.224 + branch = TransitiveB, result = (Rule.e_term, []), ostate = Incomplete}, []))
4.225 + | append_problem p l fmz (strs, spec, hdf) pt =
4.226 + insert_pt (PblObj {cell = NONE, origin = (strs, spec, hdf), fmz = fmz, spec = Celem.empty_spec,
4.227 + probl = [], meth = [], ctxt = ContextC.e_ctxt, env = NONE, loc = (SOME l, NONE),
4.228 + branch = TransitiveB, result = (Rule.e_term, []), ostate= Incomplete}) pt p;
4.229 +fun cappend_problem _ [] loc fmz ori = (append_problem [] loc fmz ori EmptyPtree, [])
4.230 + | cappend_problem pt p loc fmz ori =
4.231 + apfst (append_problem p loc fmz ori) (cut_tree pt (p, Frm));
4.232 +
4.233 +(*WN041022 deprecated, still for kbtest/diffapp.sml, /systest/root-equ.sml*)
4.234 +fun append_parent p l f r b pt =
4.235 + let
4.236 + val (ll, f) =
4.237 + if existpt p pt andalso Tactic.is_empty_tac (get_obj g_tac pt p)
4.238 + then ((fst (get_obj g_loc pt p), SOME l), get_obj g_form pt p)
4.239 + else ((SOME l, NONE), f)
4.240 + in insert_pt (PrfObj {cell = NONE, form = f, tac = r, loc = ll,
4.241 + branch = b, result = (Rule.e_term, []), ostate= Incomplete}) pt p
4.242 + end;
4.243 +fun cappend_parent pt p loc f r b = (* for tests only *)
4.244 + apfst (append_parent p loc f r b) (cut_tree pt (p, Und));
4.245 +
4.246 +fun append_atomic p l f r f' s pt =
4.247 + let
4.248 + val (iss, f) =
4.249 + if existpt p pt andalso Tactic.is_empty_tac (get_obj g_tac pt p)
4.250 + then (*after Take*) ((fst (get_obj g_loc pt p), SOME l), get_obj g_form pt p)
4.251 + else ((NONE, SOME l), f)
4.252 + in
4.253 + insert_pt (PrfObj {cell = NONE, form = f, tac = r, loc = iss, branch = NoBranch,
4.254 + result = f', ostate = s}) pt p
4.255 + end;
4.256 +
4.257 +(* 20.8.02: cappend_* FIXXXXME cut branches below cannot be decided here:
4.258 + detail - generate - cappend: inserted, not appended !!!
4.259 + cut decided in applicable_in !?!
4.260 +*)
4.261 +fun cappend_atomic pt p ist_res f r f' s =
4.262 + if existpt p pt andalso Tactic.is_empty_tac (get_obj g_tac pt p)
4.263 + then (*after Take: transfer Frm and respective istate*)
4.264 + let
4.265 + val (ist_form, f) =
4.266 + (get_loc pt (p,Frm), get_obj g_form pt p)
4.267 + val (pt, cs) = cut_tree pt (p,Frm)
4.268 + val pt = append_atomic p (Istate.e_istate, ContextC.e_ctxt) f r f' s pt
4.269 + val pt = update_loc' pt p (SOME ist_form, SOME ist_res)
4.270 + in (pt, cs) end
4.271 + else apfst (append_atomic p ist_res f r f' s) (cut_tree pt (p,Frm));
4.272 +
4.273 +fun append_result pt p l f s =
4.274 + (appl_obj (repl_result (fst (get_obj g_loc pt p), SOME l) f s) pt p, []);
4.275 +
4.276 +end
4.277 \ No newline at end of file
5.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
5.2 +++ b/src/Tools/isac/MathEngBasic/ctree-basic.sml Sat Oct 26 13:03:16 2019 +0200
5.3 @@ -0,0 +1,896 @@
5.4 +(* Title: the calctree, which holds a calculation
5.5 + Author: Walther Neuper 1999
5.6 + (c) due to copyright terms
5.7 +*)
5.8 +
5.9 +signature BASIC_CALC_TREE =
5.10 +sig (* vvv--- *.sml require these typs incrementally, with these exception -----------------vvv *)
5.11 + (*===\<Longrightarrow> other ?mstools.sml? =================================================================*)
5.12 + type state
5.13 + type con
5.14 +
5.15 + eqtype posel
5.16 + type pos = posel list
5.17 + val pos2str : int list -> string (* for datatypes.sml *)
5.18 + datatype pos_ = Frm | Met | Pbl | Res | Und
5.19 + val pos_2str : pos_ -> string
5.20 + type pos'
5.21 + val pos'2str : pos' -> string
5.22 + val str2pos_ : string -> pos_ (* for datatypes.sml *)
5.23 + val e_pos' : pos'
5.24 + (* for generate.sml ?!? ca.*)
5.25 + eqtype cellID
5.26 +
5.27 + datatype branch = AndB | CollectB | IntersectB | MapB | NoBranch | OrB | SequenceB | TransitiveB
5.28 + datatype ostate = Complete | Incomplete | Inconsistent
5.29 + datatype ppobj =
5.30 + PblObj of
5.31 + {branch: branch,
5.32 + cell: Celem.lrd option,
5.33 + loc: (Istate.T * Proof.context) option * (Istate.T * Proof.context) option,
5.34 + ostate: ostate,
5.35 + result: Selem.result,
5.36 +
5.37 + fmz: Selem.fmz,
5.38 + origin: Model.ori list * Celem.spec * term,
5.39 + probl: Model.itm list,
5.40 + meth: Model.itm list,
5.41 + spec: Celem.spec,
5.42 + ctxt: Proof.context,
5.43 + env: (Istate.T * Proof.context) option}
5.44 + | PrfObj of
5.45 + {branch: branch,
5.46 + cell: Celem.lrd option,
5.47 + loc: (Istate.T * Proof.context) option * (Istate.T * Proof.context) option,
5.48 + ostate: ostate,
5.49 + result: Selem.result,
5.50 +
5.51 + form: term,
5.52 + tac: Tactic.input}
5.53 +
5.54 + datatype ctree = EmptyPtree | Nd of ppobj * ctree list
5.55 + val e_ctree : ctree (* TODO: replace by EmptyPtree*)
5.56 + val existpt' : pos' -> ctree -> bool (* for interface.sml *)
5.57 + val is_interpos : pos' -> bool (* for interface.sml *)
5.58 + val lev_pred' : ctree -> pos' -> pos' (* for interface.sml *)
5.59 + val ins_chn : ctree list -> ctree -> pos -> ctree (* for solve.sml *)
5.60 + val children : ctree -> ctree list (* for solve.sml *)
5.61 + val get_nd : ctree -> pos -> ctree (* for solve.sml *)
5.62 + val just_created_ : ppobj -> bool (* for mathengine.sml *)
5.63 + val just_created : state -> bool (* for mathengine.sml *)
5.64 + val e_origin : Model.ori list * Celem.spec * term (* for mathengine.sml *)
5.65 +
5.66 + val is_pblobj : ppobj -> bool
5.67 + val is_pblobj' : ctree -> pos -> bool
5.68 + val is_pblnd : ctree -> bool
5.69 +
5.70 + val g_spec : ppobj -> Celem.spec
5.71 + val g_loc : ppobj -> (Istate.T * Proof.context) option * (Istate.T * Proof.context) option
5.72 + val g_form : ppobj -> term
5.73 + val g_pbl : ppobj -> Model.itm list
5.74 + val g_met : ppobj -> Model.itm list
5.75 + val g_metID : ppobj -> Celem.metID
5.76 + val g_result : ppobj -> Selem.result
5.77 + val g_tac : ppobj -> Tactic.input
5.78 + val g_domID : ppobj -> Rule.domID (* for appl.sml TODO: replace by thyID *)
5.79 + val g_env : ppobj -> (Istate.T * Proof.context) option (* for appl.sml *)
5.80 +
5.81 + val g_origin : ppobj -> Model.ori list * Celem.spec * term (* for script.sml *)
5.82 + val get_loc : ctree -> pos' -> Istate.T * Proof.context (* for script.sml *)
5.83 + val get_istate : ctree -> pos' -> Istate.T (* for script.sml *)
5.84 + val get_ctxt : ctree -> pos' -> Proof.context
5.85 + val get_obj : (ppobj -> 'a) -> ctree -> pos -> 'a
5.86 + val get_curr_formula : state -> term
5.87 + val get_assumptions_ : ctree -> pos' -> term list (* for appl.sml *)
5.88 +
5.89 + val is_e_ctxt : Proof.context -> bool (* for appl.sml *)
5.90 + val new_val : term -> Istate.T -> Istate.T
5.91 + (* for calchead.sml *)
5.92 + type cid = cellID list
5.93 + type ocalhd = bool * pos_ * term * Model.itm list * (bool * term) list * Celem.spec
5.94 + datatype ptform = Form of term | ModSpec of ocalhd
5.95 + val get_somespec' : Celem.spec -> Celem.spec -> Celem.spec
5.96 + exception PTREE of string;
5.97 +
5.98 + val par_pbl_det : ctree -> pos -> bool * pos * Rule.rls (* for appl.sml *)
5.99 + val rootthy : ctree -> theory (* for script.sml *)
5.100 +(* ---- made visible ONLY for structure CTaccess : CALC_TREE_ACCESS --------------------------- *)
5.101 + val appl_obj : (ppobj -> ppobj) -> ctree -> pos -> ctree
5.102 + val existpt : pos -> ctree -> bool (* also for tests *)
5.103 + val cut_tree : ctree -> pos * 'a -> ctree * pos' list (* also for tests *)
5.104 + val insert_pt : ppobj -> ctree -> int list -> ctree
5.105 +(* ---- made visible ONLY for structure CTnavi : CALC_TREE_NAVIGATION ------------------------- *)
5.106 + val g_branch : ppobj -> branch
5.107 + val g_form' : ctree -> term
5.108 + val g_ostate : ppobj -> ostate
5.109 + val g_ostate' : ctree -> ostate
5.110 + val g_res : ppobj -> term
5.111 + val g_res' : ctree -> term
5.112 +(*/---- duplicates in CTnavi, reconsider structs -----------------------------------------------
5.113 + val lev_on : CTbasic.pos -> CTbasic.pos (* duplicate in ctree-navi.sml *)
5.114 + val lev_dn : CTbasic.pos -> CTbasic.pos (* duplicate in ctree-navi.sml *)
5.115 + val par_pblobj : CTbasic.ctree -> CTbasic.pos -> CTbasic.pos (* duplicate in ctree-navi.sml *)
5.116 + ---- duplicates in CTnavi, reconsider structs ----------------------------------------------/*)
5.117 +
5.118 +(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
5.119 + val pr_ctree : (pos -> ppobj -> string) -> ctree -> string
5.120 + val pr_short : pos -> ppobj -> string
5.121 + val g_ctxt : ppobj -> Proof.context
5.122 + val g_fmz : ppobj -> Selem.fmz
5.123 + val get_allp : pos' list -> pos * (int list * pos_) -> ctree -> pos' list
5.124 + val get_allps : (pos * pos_) list -> posel list -> ctree list -> pos' list
5.125 + val get_allpos' : pos * posel -> ctree -> pos' list
5.126 + val get_allpos's : pos * posel -> ctree list -> (pos * pos_) list
5.127 + val cut_bottom : pos * posel -> ctree -> (ctree * pos' list) * bool
5.128 + val cut_level : pos' list -> pos -> ctree -> int list * pos_ -> ctree * pos' list
5.129 + val cut_level_'_ : pos' list -> pos -> ctree -> int list * pos_ -> ctree * pos' list
5.130 + val get_trace : ctree -> int list -> int list -> int list list
5.131 + val branch2str : branch -> string
5.132 +( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
5.133 +
5.134 +(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
5.135 + (* NONE *)
5.136 +end
5.137 +
5.138 +(**)
5.139 +structure CTbasic(**): BASIC_CALC_TREE(**) =
5.140 +struct
5.141 +(**)
5.142 +type env = (term * term) list;
5.143 +
5.144 +datatype branch =
5.145 + NoBranch | AndB | OrB
5.146 +| TransitiveB (* FIXXXME.0308: set branch from met in Apply_Method
5.147 + FIXXXME.0402: -"- in Begin_Trans'*)
5.148 +| SequenceB | IntersectB | CollectB | MapB;
5.149 +
5.150 +fun branch2str NoBranch = "NoBranch" (* for tests only *)
5.151 + | branch2str AndB = "AndB"
5.152 + | branch2str OrB = "OrB"
5.153 + | branch2str TransitiveB = "TransitiveB"
5.154 + | branch2str SequenceB = "SequenceB"
5.155 + | branch2str IntersectB = "IntersectB"
5.156 + | branch2str CollectB = "CollectB"
5.157 + | branch2str MapB = "MapB";
5.158 +
5.159 +datatype ostate =
5.160 + Incomplete | Complete | Inconsistent (* WN041020 latter still unused *);
5.161 +fun ostate2str Incomplete = "Incomplete" (* for tests only *)
5.162 + | ostate2str Complete = "Complete"
5.163 + | ostate2str Inconsistent = "Inconsistent";
5.164 +
5.165 +type cellID = int;
5.166 +type cid = cellID list;
5.167 +
5.168 +type posel = int; (* for readability in funs accessing Ctree *)
5.169 +type pos = int list;
5.170 +val pos2str = ints2str';
5.171 +datatype pos_ =
5.172 + Pbl (* PblObj-position: problem-type *)
5.173 +| Met (* PblObj-position: method *)
5.174 +| Frm (* PblObj-position: -> Pbl in ME (not by moveDown !)
5.175 + | PrfObj-position: formula *)
5.176 +| Res (* PblObj | PrfObj-position: result *)
5.177 +| Und; (* undefined*)
5.178 +fun pos_2str Pbl = "Pbl"
5.179 + | pos_2str Met = "Met"
5.180 + | pos_2str Frm = "Frm"
5.181 + | pos_2str Res = "Res"
5.182 + | pos_2str Und = "Und";
5.183 +fun str2pos_ "Pbl" = Pbl
5.184 + | str2pos_ "Met" = Met
5.185 + | str2pos_ "Frm" = Frm
5.186 + | str2pos_ "Res" = Res
5.187 + | str2pos_ "Und" = Und
5.188 + | str2pos_ str = error ("str2pos_: wrong argument = " ^ str)
5.189 +
5.190 +type pos' = pos * pos_;
5.191 +(*WN0312 remembering interator (pos * pos_) for ctree
5.192 + pos : lev_on, lev_dn, lev_up
5.193 + pos_:
5.194 +# generate1 sets pos_ if possible ...?WN0502?NOT...
5.195 +# generate1 does NOT set pos, because certain nodes can be lev_on OR lev_dn
5.196 + exceptions: Begin/End_Trans
5.197 +# thus generate(1) called in
5.198 +.# assy, locate_input_tactic
5.199 +.# begin_end_prog (tac_ -cases); general case:
5.200 + val pos' = case pos' of (p,Res) => (lev_on p',Res) | _ => pos'
5.201 +# WN050220, S(604):
5.202 + generate1...(Rewrite(f,..,res))..(pos, pos_)
5.203 + cappend_atomic.................pos ////// gets f+res always!!!
5.204 + cut_tree....................pos, pos_
5.205 +*)
5.206 +fun pos'2str (p, p_) = pair2str (ints2str' p, pos_2str p_);
5.207 +fun pos's2str ps = (strs2str' o (map pos'2str)) ps; (* for tests only *)
5.208 +val e_pos' = ([], Und);
5.209 +
5.210 +(* ATTENTION: does _not_ recognise Variable.declare_constraints, etc...*)
5.211 +fun is_e_ctxt ctxt = Context.eq_thy (Proof_Context.theory_of ctxt, @{theory "Pure"});
5.212 +
5.213 +type iist = Istate.T option * Istate.T option;
5.214 +(*val e_iist = (e_istate, e_istate); --- sinnlos f"ur NICHT-equality-type*)
5.215 +
5.216 +
5.217 +fun new_val v (Istate.Pstate (env, loc_, topt, _, safe, bool)) =
5.218 + (Istate.Pstate (env, loc_, topt, v, safe, bool))
5.219 + | new_val _ _ = error "new_val: only for Pstate";
5.220 +
5.221 +datatype con = land | lor;
5.222 +
5.223 +(* executed tactics (tac_s) with local environment etc.;
5.224 + used for continuing eval script + for generate *)
5.225 +type ets =
5.226 + (Celem.loc_ *(* of tactic in scr, tactic (weakly) associated with tac_ *)
5.227 + (Tactic.T * (* (for generate) *)
5.228 + env * (* with 'tactic=result' as rule, tactic ev. _not_ ready for 'parallel let' *)
5.229 + env * (* with results of (ready) tacs *)
5.230 + term * (* itr_arg of tactic, for upd. env at Repeat, Try *)
5.231 + term * (* result value of the tac *)
5.232 + Istate.safe))
5.233 + list;
5.234 +
5.235 +fun ets2s (l,(m,eno,env,iar,res,s)) =
5.236 + "\n(" ^ Celem.loc_2str l ^ ",(" ^ Tactic.tac_2str m ^
5.237 + ",\n ens= " ^ Env.subst2str eno ^
5.238 + ",\n env= " ^ Env.subst2str env ^
5.239 + ",\n iar= " ^ Rule.term2str iar ^
5.240 + ",\n res= " ^ Rule.term2str res ^
5.241 + ",\n " ^ Istate.safe2str s ^ "))";
5.242 +fun ets2str (ets: ets) = (strs2str o (map ets2s)) ets; (* for tests only *)
5.243 +
5.244 +type envp =(*9.5.03: unused, delete with field in ctree.PblObj FIXXXME*)
5.245 + (int * term list) list * (* assoc-list: args of met*)
5.246 + (int * Rule.rls) list * (* assoc-list: tacs already done ///15.9.00*)
5.247 + (int * ets) list * (* assoc-list: tacs etc. already done*)
5.248 + (string * pos) list; (* asms * from where*)
5.249 +
5.250 +datatype ppobj = (* TODO: arrange according to signature *)
5.251 + PrfObj of
5.252 + {cell : Celem.lrd option, (* where in form tac has been applied, FIXME.WN0607 rename field *)
5.253 + form : term, (* where tac is applied to *)
5.254 + tac : Tactic.input, (* also in istate *)
5.255 + loc : (Istate.T * (* script interpreter state *)
5.256 + Proof.context) (* context for provers, type inference *)
5.257 + option * (* both for interpreter location on Frm, Pbl, Met *)
5.258 + (Istate.T * (* script interpreter state *)
5.259 + Proof.context) (* context for provers, type inference *)
5.260 + option, (* both for interpreter location on Res *)
5.261 + (*(NONE,NONE) <==> e_istate ! see update_loc, get_loc *)
5.262 + branch: branch, (* only rudimentary *)
5.263 + result: Selem.result, (* result and assumptions *)
5.264 + ostate: ostate} (* Complete <=> result is OK *)
5.265 +| PblObj of
5.266 + {cell : Celem.lrd option, (* unused: meaningful only for some _Prf_Obj *)
5.267 + fmz : Selem.fmz, (* from init:FIXME never use this spec;-drop *)
5.268 + origin: (Model.ori list) *(* representation from fmz+pbt+met
5.269 + for efficiently adding items in probl, meth *)
5.270 + Celem.spec * (* updated by Refine_Tacitly *)
5.271 + term, (* headline of calc-head, as calculated initially(!) *)
5.272 + spec : Celem.spec, (* explicitly input *)
5.273 + probl : Model.itm list, (* itms explicitly input *)
5.274 + meth : Model.itm list, (* itms automatically added to copy of probl *)
5.275 + ctxt : Proof.context, (* WN110513 introduced to avoid [*] [**] *)
5.276 + env : (Istate.T * Proof.context) option, (* istate only for initac in script
5.277 + context for specify phase on this node NO..
5.278 +..NO: this conflicts with init_form/initac: see Apply_Method without init_form *)
5.279 + loc : (Istate.T * Proof.context) option * (Istate.T * (* like PrfObj *)
5.280 + Proof.context) option, (* for spec-phase [*], NO..
5.281 +..NO: raises errors not tracable on WN110513 [**] *)
5.282 + branch: branch, (* like PrfObj *)
5.283 + result: Selem.result, (* like PrfObj *)
5.284 + ostate: ostate}; (* like PrfObj *)
5.285 +
5.286 +(* this tree contains isac's calculations;
5.287 + the tree's structure has been copied from an early version of Theorema(c);
5.288 + it has the disadvantage, that there is no space
5.289 + for the first tactic in a script generating the first formula at (p,Frm);
5.290 + this trouble has been covered by 'init_form' and 'Take' so far,
5.291 + but it is crucial if the first tactic in a script is eg. 'Subproblem';
5.292 + see 'type tac', Apply_Method.
5.293 +*)
5.294 +datatype ctree =
5.295 + EmptyPtree
5.296 +| Nd of ppobj * (ctree list);
5.297 +val e_ctree = EmptyPtree;
5.298 +type state = ctree * pos'
5.299 +
5.300 +fun is_pblobj (PblObj _) = true
5.301 + | is_pblobj _ = false;
5.302 +
5.303 +exception PTREE of string;
5.304 +fun nth _ [] = raise PTREE "nth _ []"
5.305 + | nth 1 (x :: _) = x
5.306 + | nth n (_ :: xs) = nth (n - 1) xs;
5.307 +(*> nth 2 [11,22,33]; -->> val it = 22 : int*)
5.308 +
5.309 +
5.310 +(** convert ctree to a string **)
5.311 +
5.312 +(* convert a pos from list to string *)
5.313 +fun pr_pos ps = (space_implode "." (map string_of_int ps))^". ";
5.314 +(* show hd origin or form only *)
5.315 +fun pr_short p (PblObj _) = pr_pos p ^ " ----- pblobj -----\n" (* for tests only *)
5.316 + | pr_short p (PrfObj {form = form, ...}) = pr_pos p ^ Rule.term2str form ^ "\n";
5.317 +fun pr_ctree f pt = (* for tests only *)
5.318 + let
5.319 + fun pr_pt _ _ EmptyPtree = ""
5.320 + | pr_pt pfn ps (Nd (b, [])) = pfn ps b
5.321 + | pr_pt pfn ps (Nd (b, ts)) = pfn ps b ^ prts pfn ps 1 ts
5.322 + and prts _ _ _ [] = ""
5.323 + | prts pfn ps p (t :: ts) = (pr_pt pfn (ps @ [p]) t)^
5.324 + (prts pfn ps (p + 1) ts)
5.325 + in pr_pt f [] pt end;
5.326 +
5.327 +(** access the branches of ctree **)
5.328 +
5.329 +fun repl [] _ _ = raise PTREE "repl [] _ _"
5.330 + | repl (_ :: ls) 1 e = e :: ls
5.331 + | repl (l :: ls) n e = l :: (repl ls (n-1) e);
5.332 +fun repl_app ls n e =
5.333 + let
5.334 + val lim = 1 + length ls
5.335 + in
5.336 + if n > lim
5.337 + then raise PTREE "repl_app: n > lim"
5.338 + else if n = lim
5.339 + then ls @ [e]
5.340 + else repl ls n e end;
5.341 +
5.342 +(* get from obj at pos by f : ppobj -> 'a *)
5.343 +fun get_obj _ EmptyPtree _ = raise PTREE "get_obj f EmptyPtree"
5.344 + | get_obj f (Nd (b, _)) [] = f b
5.345 + | get_obj f (Nd (_, bs)) (p :: ps) =
5.346 + let
5.347 + val _ = (nth p bs)
5.348 + handle _ => raise PTREE ("get_obj: pos = " ^ ints2str' (p::ps) ^ " does not exist");
5.349 + in
5.350 + (get_obj f (nth p bs) ps)
5.351 + handle _ => raise PTREE ("get_obj: pos = " ^ ints2str' (p::ps) ^ " does not exist")
5.352 + end;
5.353 +fun get_nd EmptyPtree _ = raise PTREE "get_nd EmptyPtree"
5.354 + | get_nd n [] = n
5.355 + | get_nd (Nd (_, nds)) (pos as p :: ps) = (get_nd (nth p nds) ps)
5.356 + handle _ => raise PTREE ("get_nd: not existent pos = " ^ ints2str' pos);
5.357 +
5.358 +(* for use by get_obj *)
5.359 +fun g_form (PrfObj {form = f,...}) = f
5.360 + | g_form (PblObj {origin= (_,_,f),...}) = f;
5.361 +fun g_form' (Nd (PrfObj {form = f, ...}, _)) = f
5.362 + | g_form' (Nd (PblObj {origin= (_, _, f),...}, _)) = f
5.363 + | g_form' _ = error "g_form': uncovered fun def.";
5.364 +(* | g_form _ = raise PTREE "g_form not for PblObj";*)
5.365 +fun g_origin (PblObj {origin = ori, ...}) = ori
5.366 + | g_origin _ = raise PTREE "g_origin not for PrfObj";
5.367 +fun g_fmz (PblObj {fmz = f, ...}) = f (* for tests only *)
5.368 + | g_fmz _ = raise PTREE "g_fmz not for PrfObj";
5.369 +fun g_spec (PblObj {spec = s, ...}) = s
5.370 + | g_spec _ = raise PTREE "g_spec not for PrfObj";
5.371 +fun g_pbl (PblObj {probl = p, ...}) = p
5.372 + | g_pbl _ = raise PTREE "g_pbl not for PrfObj";
5.373 +fun g_met (PblObj {meth = p, ...}) = p
5.374 + | g_met _ = raise PTREE "g_met not for PrfObj";
5.375 +fun g_domID (PblObj {spec = (d, _, _), ...}) = d
5.376 + | g_domID _ = raise PTREE "g_metID not for PrfObj";
5.377 +fun g_metID (PblObj {spec = (_, _, m), ...}) = m
5.378 + | g_metID _ = raise PTREE "g_metID not for PrfObj";
5.379 +fun g_ctxt (PblObj {ctxt, ...}) = ctxt
5.380 + | g_ctxt _ = raise PTREE "g_ctxt not for PrfObj";
5.381 +fun g_env (PblObj {env, ...}) = env
5.382 + | g_env _ = raise PTREE "g_env not for PrfObj";
5.383 +fun g_loc (PblObj {loc = l, ...}) = l
5.384 + | g_loc (PrfObj {loc = l, ...}) = l;
5.385 +fun g_branch (PblObj {branch = b, ...}) = b
5.386 + | g_branch (PrfObj {branch = b, ...}) = b;
5.387 +fun g_tac (PblObj {spec = (_, _, m),...}) = Tactic.Apply_Method m
5.388 + | g_tac (PrfObj {tac = m, ...}) = m;
5.389 +fun g_result (PblObj {result = r, ...}) = r
5.390 + | g_result (PrfObj {result = r, ...}) = r;
5.391 +fun g_res (PblObj {result = (r, _) ,...}) = r
5.392 + | g_res (PrfObj {result = (r, _),...}) = r;
5.393 +fun g_res' (Nd (PblObj {result = (r, _), ...}, _)) = r
5.394 + | g_res' (Nd (PrfObj {result = (r, _),...}, _)) = r
5.395 + | g_res' _ = raise PTREE "g_res': uncovered fun def.";
5.396 +fun g_ostate (PblObj {ostate = r, ...}) = r
5.397 + | g_ostate (PrfObj {ostate = r, ...}) = r;
5.398 +fun g_ostate' (Nd (PblObj {ostate = r, ...}, _)) = r
5.399 + | g_ostate' (Nd (PrfObj {ostate = r, ...}, _)) = r
5.400 + | g_ostate' _ = raise PTREE "g_ostate': uncovered fun def.";
5.401 +
5.402 +(* get the formula preceeding the current position in a calculation *)
5.403 +fun get_curr_formula (pt, (p, p_)) =
5.404 + case p_ of
5.405 + Frm => get_obj g_form pt p
5.406 + | Res => (fst o (get_obj g_result pt)) p
5.407 + | _ => #3 (get_obj g_origin pt p);
5.408 +
5.409 +(* in CalcTree/Subproblem an 'just_created_' model is created;
5.410 + this is filled to 'untouched' by Model/Refine_Problem *)
5.411 +fun just_created_ (PblObj {meth, probl, spec, ...}) =
5.412 + null meth andalso null probl andalso spec = Celem.e_spec
5.413 + | just_created_ _ = raise PTREE "g_ostate': uncovered fun def.";
5.414 +val e_origin = ([], Celem.e_spec, Rule.e_term);
5.415 +
5.416 +fun just_created (pt, (p, _)) =
5.417 + let val ppobj = get_obj I pt p
5.418 + in is_pblobj ppobj andalso just_created_ ppobj end;
5.419 +
5.420 +(* does the pos in the ctree exist ? *)
5.421 +fun existpt pos pt = can (get_obj I pt) pos;
5.422 +(* does the pos' in the ctree exist, ie. extra check for result in the node *)
5.423 +fun existpt' (p, p_) pt =
5.424 + if can (get_obj I pt) p
5.425 + then case p_ of
5.426 + Res => get_obj g_ostate pt p = Complete
5.427 + | _ => true
5.428 + else false;
5.429 +
5.430 +(* is this position appropriate for calculating intermediate steps? *)
5.431 +fun is_interpos (_, Res) = true
5.432 + | is_interpos _ = false;
5.433 +
5.434 +(* get the children of a node in ctree *)
5.435 +fun children (Nd (PblObj _, cn)) = cn
5.436 + | children (Nd (PrfObj _, cn)) = cn
5.437 + | children _ = error "children: uncovered fun def.";
5.438 +
5.439 +(*/--------------- duplicates in ctree-navi.sml: required also here below ---------------\*)
5.440 +fun lev_on [] = raise PTREE "lev_on []"
5.441 + | lev_on pos =
5.442 + let val len = length pos
5.443 + in (drop_last pos) @ [(nth len pos)+1] end;
5.444 +fun lev_up [] = raise PTREE "lev_up []"
5.445 + | lev_up p = (drop_last p):pos;
5.446 +(* find the position of the next parent which is a PblObj in ctree *)
5.447 +fun par_pblobj _ [] = []
5.448 + | par_pblobj pt p =
5.449 + let
5.450 + fun par _ [] = []
5.451 + | par pt p =
5.452 + if is_pblobj (get_obj I pt p)
5.453 + then p
5.454 + else par pt (lev_up p)
5.455 + in par pt (lev_up p) end;
5.456 +(*\--------------- duplicates in ctree-navi.sml: required also here below ---------------/*)
5.457 +
5.458 +(* find the next parent, which is either a PblObj (return true)
5.459 + or a PrfObj with tac = Detail_Set (return false)
5.460 + FIXME.030403: re-organize par_pbl_det after rls' --> rls*)
5.461 +fun par_pbl_det pt [] = (true, [], Rule.Erls)
5.462 + | par_pbl_det pt p =
5.463 + let
5.464 + fun par _ [] = (true, [], Rule.Erls)
5.465 + | par pt p =
5.466 + if is_pblobj (get_obj I pt p)
5.467 + then (true, p, Rule.Erls)
5.468 + else case get_obj g_tac pt p of
5.469 + Tactic.Rewrite_Set rls' => (false, p, assoc_rls rls')
5.470 + | Tactic.Rewrite_Set_Inst (_, rls') => (false, p, assoc_rls rls')
5.471 + | _ => par pt (lev_up p)
5.472 + in par pt (lev_up p) end;
5.473 +
5.474 +(* insert obj b into ctree at pos, ev.overwriting this pos *)
5.475 +fun insert_pt b EmptyPtree [] = Nd (b, [])
5.476 + | insert_pt _ EmptyPtree _ = raise PTREE "insert_pt b Empty _"
5.477 + | insert_pt _ (Nd ( _, _)) [] = raise PTREE "insert_pt b _ []"
5.478 + | insert_pt b (Nd (b', bs)) (p :: []) = Nd (b', repl_app bs p (Nd (b, [])))
5.479 + | insert_pt b (Nd (b', bs)) (p :: ps) = Nd (b', repl_app bs p (insert_pt b (nth p bs) ps));
5.480 +
5.481 +(* insert children to a node without children. compare: fun insert_pt *)
5.482 +fun ins_chn _ EmptyPtree _ = raise PTREE "ins_chn: EmptyPtree"
5.483 + | ins_chn _ (Nd _) [] = raise PTREE "ins_chn: pos = []"
5.484 + | ins_chn ns (Nd (b, bs)) (p :: []) =
5.485 + if p > length bs
5.486 + then raise PTREE "ins_chn: pos not existent"
5.487 + else
5.488 + let
5.489 + val (b', bs') = case nth p bs of
5.490 + Nd (b', bs') => (b', bs')
5.491 + | _ => error "ins_chn: uncovered case nth"
5.492 + in
5.493 + if null bs'
5.494 + then Nd (b, repl_app bs p (Nd (b', ns)))
5.495 + else raise PTREE "ins_chn: pos mustNOT be overwritten"
5.496 + end
5.497 + | ins_chn ns (Nd (b, bs)) (p::ps) = Nd (b, repl_app bs p (ins_chn ns (nth p bs) ps));
5.498 +
5.499 +(* apply f to obj at pos, f: ppobj -> ppobj *)
5.500 +fun appl_to_node f (Nd (b, bs)) = Nd (f b, bs)
5.501 + | appl_to_node _ _ = error "appl_to_node: uncovered fun def.";
5.502 +fun appl_obj _ EmptyPtree [] = EmptyPtree
5.503 + | appl_obj _ EmptyPtree _ = raise PTREE "appl_obj f Empty _"
5.504 + | appl_obj f (Nd (b, bs)) [] = Nd (f b, bs)
5.505 + | appl_obj f (Nd (b, bs)) (p :: []) = Nd (b, repl_app bs p (((appl_to_node f) o (nth p)) bs))
5.506 + | appl_obj f (Nd (b, bs)) (p :: ps) = Nd (b, repl_app bs p (appl_obj f (nth p bs) (ps:pos)));
5.507 +
5.508 +
5.509 +type ocalhd =
5.510 + bool * (* ALL itms+preconds true *)
5.511 + pos_ * (* model belongs to Problem | Method *)
5.512 + term * (* header: Problem... or Cas FIXME.0312: item for marking syntaxerrors *)
5.513 + Model.itm list * (* model: given, find, relate *)
5.514 + ((bool * term) list) *(* model: preconds *)
5.515 + Celem.spec; (* specification *)
5.516 +val e_ocalhd = (false, Und, Rule.e_term, [Model.e_itm], [(false, Rule.e_term)], Celem.e_spec);
5.517 +
5.518 +datatype ptform = Form of term | ModSpec of ocalhd;
5.519 +
5.520 +(* for cut_level; (deprecated) *)
5.521 +fun test_trans (PrfObj {branch, ...}) = true andalso branch = TransitiveB
5.522 + | test_trans (PblObj {branch, ...}) = true andalso branch = TransitiveB;
5.523 +
5.524 +fun is_pblobj' pt p =
5.525 + let val ppobj = get_obj I pt p
5.526 + in is_pblobj ppobj end;
5.527 +
5.528 +fun del_res (PblObj {cell, fmz, origin, spec, probl, meth, ctxt, env, loc= (l1, _), branch, ...}) =
5.529 + PblObj {cell = cell, fmz = fmz, origin = origin, spec = spec, probl = probl, meth = meth,
5.530 + ctxt = ctxt, env = env, loc= (l1, NONE), branch = branch,
5.531 + result = (Rule.e_term, []), ostate = Incomplete}
5.532 + | del_res (PrfObj {cell, form, tac, loc= (l1, _), branch, ...}) =
5.533 + PrfObj {cell = cell, form = form, tac = tac, loc = (l1, NONE), branch = branch,
5.534 + result = (Rule.e_term, []), ostate = Incomplete};
5.535 +
5.536 +
5.537 +fun get_loc EmptyPtree _ = (Istate.e_istate, ContextC.e_ctxt)
5.538 + | get_loc pt (p, Res) =
5.539 + (case get_obj g_loc pt p of
5.540 + (SOME i, NONE) => i
5.541 + | (NONE , NONE) => (Istate.e_istate, ContextC.e_ctxt)
5.542 + | (_ , SOME i) => i)
5.543 + | get_loc pt (p, _) =
5.544 + (case get_obj g_loc pt p of
5.545 + (NONE , SOME i) => i (*13.8.02 just copied from ^^^: too liberal ?*)
5.546 + | (NONE , NONE) => (Istate.e_istate, ContextC.e_ctxt)
5.547 + | (SOME i, _) => i);
5.548 +fun get_istate pt p = get_loc pt p |> #1;
5.549 +fun get_ctxt pt (pos as (p, p_)) =
5.550 + if member op = [Frm, Res] p_
5.551 + then get_loc pt pos |> #2 (*for script interpretation rely on fun get_loc*)
5.552 + else get_obj g_ctxt pt p (*for specify phase take ctx from PblObj*)
5.553 +
5.554 +fun get_assumptions_ pt p = get_ctxt pt p |> ContextC.get_assumptions;
5.555 +
5.556 +fun get_somespec' (dI, pI, mI) (dI', pI', mI') =
5.557 + let
5.558 + val domID = if dI = Rule.e_domID then dI' else dI
5.559 + val pblID = if pI = Celem.e_pblID then pI' else pI
5.560 + val metID = if mI = Celem.e_metID then mI' else mI
5.561 + in (domID, pblID, metID) end;
5.562 +
5.563 +(**.development for extracting an 'interval' from ptree.**)
5.564 +
5.565 +(*WN0510 version stopped in favour of get_interval with !!!move_dn, getFormulaeFromTo
5.566 + actually used (inefficient) version with move_dn: see modspec.sml*)
5.567 +local
5.568 +
5.569 +fun hdp [] = 1 | hdp [0] = 1 | hdp x = hd x;(*start with first*)
5.570 +fun hdq [] = 99999 | hdq [0] = 99999 | hdq x = hd x;(*take until last*)
5.571 +fun tlp [] = [0] | tlp [_] = [0] | tlp x = tl x;
5.572 +fun tlq [] = [99999] | tlq [_] = [99999] | tlq x = tl x;
5.573 +
5.574 +fun getnd i (b,p) q (Nd (po, nds)) =
5.575 + (if i <= 0 then [[b]] else []) @
5.576 + (getnds (i-1) true (b@[hdp p], tlp p) (tlq q)
5.577 + (take_fromto (hdp p) (hdq q) nds))
5.578 +
5.579 +and getnds _ _ _ _ [] = [] (*no children*)
5.580 + | getnds i _ (b,p) q [nd] = (getnd i (b,p) q nd) (*l+r-margin*)
5.581 +
5.582 + | getnds i true (b,p) q [n1, n2] = (*l-margin, r-margin*)
5.583 + (getnd i ( b, p ) [99999] n1) @
5.584 + (getnd ~99999 (lev_on b,[0]) q n2)
5.585 +
5.586 + | getnds i _ (b,p) q [n1, n2] = (*intern, r-margin*)
5.587 + (getnd i ( b,[0]) [99999] n1) @
5.588 + (getnd ~99999 (lev_on b,[0]) q n2)
5.589 +
5.590 + | getnds i true (b,p) q (nd::(nds as _::_)) = (*l-margin, intern*)
5.591 + (getnd i ( b, p ) [99999] nd) @
5.592 + (getnds ~99999 false (lev_on b,[0]) q nds)
5.593 +
5.594 + | getnds i _ (b,p) q (nd::(nds as _::_)) = (*intern, ...*)
5.595 + (getnd i ( b,[0]) [99999] nd) @
5.596 + (getnds ~99999 false (lev_on b,[0]) q nds);
5.597 +in
5.598 +(*get an 'interval from to' from a ptree as 'intervals f t' of respective nodes
5.599 + where 'from' are pos, i.e. a key as int list, 'f' an int (to,t analoguous)
5.600 +(1) the 'f' are given
5.601 +(1a) by 'from' if 'f' = the respective element of 'from' (left margin)
5.602 +(1b) -inifinity, if 'f' > the respective element of 'from' (internal node)
5.603 +(2) the 't' ar given
5.604 +(2a) by 'to' if 't' = the respective element of 'to' (right margin)
5.605 +(2b) inifinity, if 't' < the respective element of 'to (internal node)'
5.606 +the 'f' and 't' are set by hdp,... *)
5.607 +fun get_trace pt p q =
5.608 + (flat o (getnds ((length p) -1) true ([hdp p], tlp p) (tlq q)))
5.609 + (take_fromto (hdp p) (hdq q) (children pt));
5.610 +end;
5.611 +
5.612 +(*extract a formula or model from ctree for itms2itemppc or model2xml*)
5.613 +fun preconds2str bts =
5.614 + (strs2str o (map (Celem.linefeed o pair2str o
5.615 + (apsnd Rule.term2str) o
5.616 + (apfst bool2str)))) bts;
5.617 +fun ocalhd2str (b, p, hdf, itms, prec, spec) = (* for tests only *)
5.618 + "(" ^ bool2str b ^ ", " ^ pos_2str p ^ ", " ^ Rule.term2str hdf ^
5.619 + ", " ^ Model.itms2str_ (Rule.thy2ctxt' "Isac_Knowledge") itms ^
5.620 + ", " ^ preconds2str prec ^ ", \n" ^ Celem.spec2str spec ^ " )";
5.621 +
5.622 +fun is_pblnd (Nd (ppobj, _)) = is_pblobj ppobj
5.623 + | is_pblnd _ = error "is_pblnd: uncovered fun def.";
5.624 +
5.625 +
5.626 +(* determine the previous pos' on the same level
5.627 + WN0502 made for interSteps; _only_ works for branch TransitiveB WN120517 compare lev_back *)
5.628 +fun lev_pred' _ ([], Res) = ([], Pbl)
5.629 + | lev_pred' pt (p, Res) =
5.630 + let val (p', last) = split_last p
5.631 + in
5.632 + if last = 1
5.633 + then if (is_pblobj o (get_obj I pt)) p then (p, Pbl) else (p, Frm)
5.634 + else if get_obj g_res pt (p' @ [last - 1]) = get_obj g_form pt p
5.635 + then (p' @ [last - 1], Res) (* TransitiveB *)
5.636 + else if (is_pblobj o (get_obj I pt)) p then (p,Pbl) else (p, Frm)
5.637 + end
5.638 + | lev_pred' _ _ = error "";
5.639 +
5.640 +
5.641 +(**.insert into ctree and cut branches accordingly.**)
5.642 +
5.643 +(* get all positions of certain intervals on the ctree.
5.644 + OLD VERSION without move_dn; kept for occasional redesign
5.645 + get all pos's to be cut in a ctree
5.646 + below a pos or from a ctree list after i-th element (NO level_up) *)
5.647 +fun get_allpos' (_, _) EmptyPtree = []
5.648 + | get_allpos' (p, 1) (Nd (b, bs)) = (* p is pos of Nd *)
5.649 + if g_ostate b = Incomplete
5.650 + then (p, Frm) :: (get_allpos's (p, 1) bs)
5.651 + else (p, Frm) :: (get_allpos's (p, 1) bs) @ [(p, Res)]
5.652 + | get_allpos' (p, i) (Nd (b, bs)) = (* p is pos of Nd *)
5.653 + if length bs > 0 orelse is_pblobj b
5.654 + then if g_ostate b = Incomplete
5.655 + then [(p,Frm)] @ (get_allpos's (p, 1) bs)
5.656 + else [(p,Frm)] @ (get_allpos's (p, 1) bs) @ [(p, Res)]
5.657 + else if g_ostate b = Incomplete then [] else [(p, Res)]
5.658 +and get_allpos's _ [] = []
5.659 + | get_allpos's (p, i) (pt :: pts) = (* p is pos of parent-Nd *)
5.660 + (get_allpos' (p @ [i], i) pt) @ (get_allpos's (p, i + 1) pts);
5.661 +
5.662 +(*WN050106 like cut_level, but deletes exactly 1 node *)
5.663 +fun cut_level_'_ _ _ EmptyPtree _ =raise PTREE "cut_level_'_ Empty _" (* for tests ONLY *)
5.664 + | cut_level_'_ _ _ (Nd ( _, _)) ([], _) = raise PTREE "cut_level_'_ _ []"
5.665 + | cut_level_'_ cuts P (Nd (b, bs)) (p :: [], p_) =
5.666 + if test_trans b
5.667 + then
5.668 + (Nd (b, drop_nth [] (p:posel, bs)),
5.669 + cuts @ (if p_ = Frm then [(P @ [p], Res)] else []) @
5.670 + (get_allpos's (P, p + 1) (drop_nth [] (p, bs))))
5.671 + else (Nd (b, bs), cuts)
5.672 + | cut_level_'_ cuts P (Nd (b, bs)) ((p :: ps), p_) =
5.673 + let
5.674 + val (bs', cuts') = cut_level_'_ cuts P (nth p bs) (ps, p_)
5.675 + in (Nd (b, repl_app bs p bs'), cuts @ cuts') end;
5.676 +
5.677 +fun cut_level _ _ EmptyPtree _ = raise PTREE "cut_level EmptyPtree _"
5.678 + | cut_level _ _ (Nd ( _, _)) ([],_) = raise PTREE "cut_level _ []"
5.679 + | cut_level cuts P (Nd (b, bs)) (p :: [], p_) =
5.680 + if test_trans b
5.681 + then
5.682 + (Nd (b, take (p:posel, bs)),
5.683 + cuts @
5.684 + (if p_ = Frm andalso (*#*) g_ostate b = Complete then [(P@[p],Res)] else ([]:pos' list)) @
5.685 + (get_allpos's (P, p+1) (takerest (p, bs))))
5.686 + else (Nd (b, bs), cuts)
5.687 + | cut_level cuts P (Nd (b, bs)) ((p :: ps), p_) =
5.688 + let
5.689 + val (bs', cuts') = cut_level cuts P (nth p bs) (ps, p_)
5.690 + in (Nd (b, repl_app bs p bs'), cuts @ cuts') end;
5.691 +
5.692 +(*OLD version before WN050219, overwritten below*)
5.693 +fun cut_tree _ ([], _) = raise PTREE "cut_tree _ ([],_)" (* for test only *)
5.694 + | cut_tree pt (pos as ([_], _)) =
5.695 + let
5.696 + val (pt', cuts) = cut_level [] [] pt pos
5.697 + in
5.698 + (pt', cuts @ (if get_obj g_ostate pt [] = Incomplete then [] else [([], Res)]))
5.699 + end
5.700 + | cut_tree pt (p,p_) =
5.701 + let
5.702 + fun cutfn pt cuts (p, p_) =
5.703 + let
5.704 + val (pt', cuts') = cut_level [] (lev_up p) pt (p,p_)
5.705 + in
5.706 + if length cuts' > 0 andalso length p > 1
5.707 + then cutfn pt' (cuts @ cuts') (lev_up p, Frm(*-->(p,Res)*))
5.708 + else (pt', cuts @ cuts')
5.709 + end
5.710 + val (pt', cuts) = cutfn pt [] (p, p_)
5.711 + in
5.712 + (pt', cuts @ (if get_obj g_ostate pt [] = Incomplete then [] else [([], Res)]))
5.713 + end;
5.714 +
5.715 +local
5.716 +fun move_dn _ (Nd (_, ns)) ([],p_) = (* root problem *)
5.717 + (case p_ of
5.718 + Res => raise PTREE "move_dn: end of calculation"
5.719 + | _ =>
5.720 + if null ns (* go down from Pbl + Met *)
5.721 + then raise PTREE "move_dn: solve problem not started"
5.722 + else ([1], Frm))
5.723 + | move_dn P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate to end of pos *)
5.724 + if p > length ns
5.725 + then raise PTREE "move_dn: pos not existent 2"
5.726 + else move_dn (P @ [p]) (nth p ns) (ps, p_)
5.727 + | move_dn P (Nd (c, ns)) ([p], p_) = (* act on last element of pos *)
5.728 + if p > length ns
5.729 + then raise PTREE "move_dn: pos not existent 3"
5.730 + else
5.731 + (case p_ of
5.732 + Res =>
5.733 + if p = length ns (* last Res on this level: go a level up *)
5.734 + then if g_ostate c = Complete
5.735 + then (P, Res)
5.736 + else raise PTREE (ints2str' P ^ " not complete 1")
5.737 + else (* go to the next Nd on this level, or down into the next Nd *)
5.738 + if is_pblnd (nth (p + 1) ns) then (P@[p + 1], Pbl)
5.739 + else if g_res' (nth p ns) = g_form' (nth (p + 1) ns)
5.740 + then if (null o children o (nth (p + 1))) ns
5.741 + then (* take the Res if Complete *)
5.742 + if g_ostate' (nth (p + 1) ns) = Complete
5.743 + then (P@[p + 1], Res)
5.744 + else raise PTREE (ints2str' (P@[p + 1]) ^ " not complete 2")
5.745 + else (P@[p + 1, 1], Frm) (* go down into the next PrfObj *)
5.746 + else (P@[p + 1], Frm) (* take Frm: exists if the Nd exists *)
5.747 + | Frm => (*go down or to the Res of this Nd*)
5.748 + if (null o children o (nth p)) ns
5.749 + then if g_ostate' (nth p ns) = Complete then (P @ [p], Res)
5.750 + else raise PTREE (ints2str' (P @ [p])^" not complete 3")
5.751 + else (P @ [p, 1], Frm)
5.752 + | _ => (* is Pbl or Met *)
5.753 + if (null o children o (nth p)) ns
5.754 + then raise PTREE "move_dn:solve subproblem not startd"
5.755 + else (P @ [p, 1],
5.756 + if (is_pblnd o hd o children o (nth p)) ns
5.757 + then Pbl else Frm))
5.758 + | move_dn _ _ _ = error "";
5.759 +in
5.760 +(* get all positions in a ctree until ([],Res) or ostate=Incomplete
5.761 +val get_allp = fn :
5.762 + pos' list -> : accumulated, start with []
5.763 + pos -> : the offset for subtrees wrt the root
5.764 + ctree -> : (sub)tree
5.765 + pos' : initialization (the last pos' before ...)
5.766 + -> pos' list : of positions in this (sub) tree (relative to the root)
5.767 +*)
5.768 +fun get_allp cuts (P, pos) pt =
5.769 + (let
5.770 + val nxt = move_dn [] pt pos (*exn if Incomplete reached*)
5.771 + in
5.772 + if nxt <> ([], Res)
5.773 + then get_allp (cuts @ [nxt]) (P, nxt) pt
5.774 + else map (apfst (curry op @ P)) (cuts @ [nxt])
5.775 + end)
5.776 + handle PTREE _ => (map (apfst (curry op@ P)) cuts);
5.777 +end
5.778 +
5.779 +(* the pts are assumed to be on the same level *)
5.780 +fun get_allps cuts _ [] = cuts
5.781 + | get_allps cuts P (pt :: pts) =
5.782 + let
5.783 + val below = get_allp [] (P, ([], Frm)) pt
5.784 + val levfrm =
5.785 + if is_pblnd pt
5.786 + then (P, Pbl) :: below
5.787 + else if last_elem P = 1
5.788 + then (P, Frm) :: below
5.789 + else (*Trans*) below
5.790 + val levres = levfrm @ (if null below then [(P, Res)] else [])
5.791 + in
5.792 + get_allps (cuts @ levres) (lev_on P) pts
5.793 + end;
5.794 +
5.795 +(** these 2 funs decide on how far cut_tree goes **)
5.796 +(* shall the nodes _after_ the pos to be inserted at be deleted?
5.797 + shall cutting be continued on the higher level(s)? the Nd regarded will NOT be changed *)
5.798 +fun test_trans (PrfObj {branch, ...}) = (branch = TransitiveB orelse branch = NoBranch)
5.799 + | test_trans (PblObj {branch, ...}) = (branch = TransitiveB orelse branch = NoBranch);
5.800 +
5.801 +(* cut_bottom new sml603..608
5.802 +cut the level at the bottom of the pos (used by cappend_...)
5.803 +and handle the parent in order to avoid extra case for root
5.804 +fn: ctree -> : the _whole_ ctree for cut_levup
5.805 + pos * posel -> : the pos after split_last
5.806 + ctree -> : the parent of the Nd to be cut
5.807 +return
5.808 + (ctree * : the updated ctree
5.809 + pos' list) * : the pos's cut
5.810 + bool : cutting shall be continued on the higher level(s)
5.811 +*)
5.812 +fun cut_bottom _ (pt' as Nd (b, [])) = ((pt', []), test_trans b)
5.813 + | cut_bottom (P, p) (Nd (b, bs)) =
5.814 + let (*divide level into 3 parts...*)
5.815 + val keep = take (p - 1, bs)
5.816 + val pt' = case nth p bs of
5.817 + pt' as Nd _ => pt'
5.818 + | _ => error "cut_bottom: uncovered case nth p bs"
5.819 + (*^^^^^_here_ will be 'insert_pt'ed by 'append_..'*)
5.820 + val (tail, _) = (takerest (p, bs), if null (takerest (p, bs)) then 0 else p + 1)
5.821 + val (children, cuts) =
5.822 + if test_trans b
5.823 + then
5.824 + (keep, (if is_pblnd pt' then [(P @ [p], Pbl)] else [])
5.825 + @ (get_allp [] (P @ [p], (P, Frm)) pt')
5.826 + @ (get_allps [] (P @ [p + 1]) tail))
5.827 + else (keep @ [(*'insert_pt'ed by 'append_..'*)] @ tail,
5.828 + get_allp [] (P @ [p], (P, Frm)) pt')
5.829 + val (pt'', cuts) =
5.830 + if test_trans b
5.831 + then (Nd (del_res b, children), cuts @ (if g_ostate b = Incomplete then [] else [(P, Res)]))
5.832 + else (Nd (b, children), cuts)
5.833 + in ((pt'', cuts), test_trans b) end
5.834 + | cut_bottom _ _ = error "cut_bottom: uncovered fun def.";
5.835 +
5.836 +
5.837 +(* go all levels from the bottom of 'pos' up to the root,
5.838 + on each level compose the children of a node and accumulate the cut Nds
5.839 +args
5.840 + pos' list -> : for accumulation
5.841 + bool -> : cutting shall be continued on the higher level(s)
5.842 + ctree -> : the whole ctree for 'get_nd pt P' on each level
5.843 + ctree -> : the Nd from the lower level for insertion at path
5.844 + pos * posel -> : pos=path split for convenience
5.845 + ctree -> : Nd the children of are under consideration on this call
5.846 +returns :
5.847 + ctree * pos' list : the updated parent-Nd and the pos's of the Nds cut
5.848 +*)
5.849 +fun cut_levup (cuts:pos' list) clevup pt pt' (P:pos, p:posel) (Nd (b, bs)) =
5.850 + let (*divide level into 3 parts...*)
5.851 + val keep = take (p - 1, bs)
5.852 + (*val pt' comes as argument from below*)
5.853 + val (tail, _) =
5.854 + (takerest (p, bs), if null (takerest (p, bs)) then 0 else p + 1)
5.855 + val (children, cuts') =
5.856 + if clevup
5.857 + then (keep @ [pt'], get_allps [] (P @ [p+1]) tail)
5.858 + else (keep @ [pt'] @ tail, [])
5.859 + val clevup' = if clevup then test_trans b else false
5.860 + (*the first Nd with false stops cutting on all levels above*)
5.861 + val (pt'', cuts') =
5.862 + if clevup'
5.863 + then (Nd (del_res b, children), cuts' @ (if g_ostate b = Incomplete then [] else [(P, Res)]))
5.864 + else (Nd (b, children), cuts')
5.865 + in
5.866 + if null P
5.867 + then (pt'', cuts @ cuts')
5.868 + else
5.869 + let val (P, p) = split_last P
5.870 + in cut_levup (cuts @ cuts') clevup' pt pt'' (P, p) (get_nd pt P) end
5.871 + end
5.872 + | cut_levup _ _ _ _ _ _ = error "cut_levup: uncovered fun def.";
5.873 +
5.874 +(* cut nodes after and below an inserted node in the ctree;
5.875 + the cuts range is limited by the predicate 'fun cutlevup' *)
5.876 +fun cut_tree pt (pos, _) =
5.877 + if not (existpt pos pt)
5.878 + then (pt,[]) (*appending a formula never cuts anything*)
5.879 + else
5.880 + let
5.881 + val (P, p) = split_last pos
5.882 + val ((pt', cuts), clevup) = cut_bottom (P, p) (get_nd pt P)
5.883 + (* pt' is the updated parent of the Nd to cappend_..*)
5.884 + in
5.885 + if null P
5.886 + then (pt', cuts)
5.887 + else
5.888 + let val (P, p) = split_last P
5.889 + in cut_levup cuts clevup pt pt' (P, p) (get_nd pt P) end
5.890 + end;
5.891 +
5.892 +(* get the theory explicitly specified for the rootpbl;
5.893 + thus use this function _after_ finishing specification *)
5.894 +fun rootthy (Nd (PblObj {spec = (thyID, _, _), ...}, _)) = Celem.assoc_thy thyID
5.895 + | rootthy _ = error "rootthy: uncovered fun def.";
5.896 +
5.897 +(**)
5.898 +end;
5.899 +(**)
6.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
6.2 +++ b/src/Tools/isac/MathEngBasic/ctree-navi.sml Sat Oct 26 13:03:16 2019 +0200
6.3 @@ -0,0 +1,240 @@
6.4 +(* Title: navigation on the calctree
6.5 + Author: Walther Neuper 2017
6.6 + (c) due to copyright terms
6.7 +*)
6.8 +signature CALC_TREE_NAVIGATION =
6.9 +sig
6.10 + val lev_of : CTbasic.pos' -> int
6.11 + val pos_plus : int -> CTbasic.pos' -> CTbasic.pos'
6.12 + val last_onlev : CTbasic.ctree -> CTbasic.pos -> bool
6.13 + val exist_lev_on' : CTbasic.ctree -> CTbasic.pos' -> bool (* for interface.sml *)
6.14 + val is_curr_endof_calc : CTbasic.ctree -> CTbasic.pos' -> bool (* for interface.sml *)
6.15 +
6.16 + val lev_dn_ : CTbasic.pos' -> CTbasic.pos'
6.17 + val lev_up : CTbasic.pos -> CTbasic.pos
6.18 + val lev_back' : CTbasic.pos' -> CTbasic.pos' (* for inform.sml *)
6.19 + val lev_back : CTbasic.pos' -> CTbasic.pos' (* for inform.sml *)
6.20 +
6.21 + val lev_dn : CTbasic.pos -> CTbasic.pos (* duplicate in ctree-basic.sml *)
6.22 + val lev_on : CTbasic.pos -> CTbasic.pos (* duplicate in ctree-basic.sml *)
6.23 + val par_pblobj : CTbasic.ctree -> CTbasic.pos -> CTbasic.pos (* duplicate in ctree-basic.sml *)
6.24 +
6.25 + val lev_on' : CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos' (* for interface.sml *)
6.26 + val move_dn : CTbasic.pos -> CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos'
6.27 + val move_up : CTbasic.pos -> CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos'(* or interface.sml *)
6.28 + val movelevel_dn : CTbasic.pos -> CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos'(*nterface.sml *)
6.29 + val movelevel_up : CTbasic.pos -> CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos'(*nterface.sml *)
6.30 + val movecalchd_up : CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos' (* for interface.sml *)
6.31 +
6.32 +(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
6.33 + (* NONE *)
6.34 +(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
6.35 + (* NONE *)
6.36 +( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
6.37 +
6.38 +(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
6.39 + (* NONE *)
6.40 +end
6.41 +
6.42 +(**)
6.43 +structure CTnavi(**): CALC_TREE_NAVIGATION(**) =
6.44 +struct
6.45 +(**)
6.46 +open CTbasic
6.47 +
6.48 +(* duplicates in ctree-basic.sml *)
6.49 +fun lev_on [] = raise PTREE "lev_on []"
6.50 + | lev_on pos =
6.51 + let val len = length pos
6.52 + in (drop_last pos) @ [(nth len pos)+1] end;
6.53 +fun lev_up [] = raise PTREE "lev_up []"
6.54 + | lev_up p = (drop_last p):pos;
6.55 +
6.56 +(*040216: for inform --> embed_deriv: remains on same level TODO.WN120517 compare lev_pred*)
6.57 +fun lev_back' ([], _) = raise PTREE "lev_back': called by ([],_)"
6.58 + | lev_back' (p, _) =
6.59 + if last_elem p <= 1 then (p, Frm)
6.60 + else ((drop_last p) @ [(nth (length p) p) - 1], Res);
6.61 +fun lev_back ([], p_) = ([], p_)
6.62 + | lev_back (p, _) =
6.63 + if last_elem p <= 1 then (p, Frm)
6.64 + else ((drop_last p) @ [(nth (length p) p) - 1], Res);
6.65 +(* increase pos by n within a level *)
6.66 +fun pos_plus 0 pos = pos
6.67 + | pos_plus n (p, Frm) = pos_plus (n - 1) (p, Res)
6.68 + | pos_plus n (p, _) = pos_plus (n - 1) (lev_on p, Res);
6.69 +
6.70 +fun lev_dn p = p @ [0];
6.71 +fun lev_dn_ (p, _) = (lev_dn p, Res)
6.72 +fun lev_of (p,_) = length p;
6.73 +
6.74 +fun last_onlev pt pos = not (existpt (lev_on pos) pt);
6.75 +
6.76 +(* find the position of the next parent which is a PblObj in ctree *)
6.77 +fun par_pblobj _ [] = []
6.78 + | par_pblobj pt p =
6.79 + let
6.80 + fun par _ [] = []
6.81 + | par pt p =
6.82 + if is_pblobj (get_obj I pt p)
6.83 + then p
6.84 + else par pt (lev_up p)
6.85 + in par pt (lev_up p) end;
6.86 +
6.87 +(* determine the next pos' on the same level *)
6.88 +fun lev_on' _ ([], Pbl) = ([], Res)
6.89 + | lev_on' pt (p, Res) =
6.90 + if get_obj g_res pt p = get_obj g_form pt (lev_on p)(*TransitiveB*)
6.91 + then if existpt' (lev_on p, Res) pt
6.92 + then (lev_on p, Res)
6.93 + else error ("lev_on': (p, Res) -> (p, Res) not existent, p = " ^ ints2str' (lev_on p))
6.94 + else (lev_on p, Frm)
6.95 + | lev_on' pt (p, _) =
6.96 + if existpt' (p, Res) pt
6.97 + then (p, Res)
6.98 + else error ("lev_on': (p, Frm) -> (p, Res) not existent, p = " ^ ints2str' p);
6.99 +
6.100 +fun exist_lev_on' pt p = (lev_on' pt p; true) handle _ => false;
6.101 +
6.102 +(* is the pos' at the last element of a calulation _AND_ can be continued *)
6.103 +fun is_curr_endof_calc _ ([],Res) = false
6.104 + | is_curr_endof_calc pt (pos as (p, _)) =
6.105 + not (exist_lev_on' pt pos) andalso get_obj g_ostate pt (lev_up p) = Incomplete;
6.106 +
6.107 +(* move one step down into existing nodes of ctree; skip Res = Frm.nxt;
6.108 + move_dn at the end of the calc-tree raises PTREE *)
6.109 +fun move_dn _ (Nd (_, ns)) ([],p_) = (* root problem *)
6.110 + (case p_ of
6.111 + Res => raise PTREE "move_dn: end of calculation"
6.112 + | _ =>
6.113 + if null ns (* go down from Pbl + Met *)
6.114 + then raise PTREE "move_dn: solve problem not started"
6.115 + else ([1], Frm))
6.116 + | move_dn P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate to end of pos *)
6.117 + if p > length ns
6.118 + then raise PTREE "move_dn: pos not existent 2"
6.119 + else move_dn (P @ [p]) (nth p ns) (ps, p_)
6.120 + | move_dn P (Nd (c, ns)) ([p], p_) = (* act on last element of pos *)
6.121 + if p > length ns
6.122 + then raise PTREE "move_dn: pos not existent 3"
6.123 + else
6.124 + (case p_ of
6.125 + Res =>
6.126 + if p = length ns (* last Res on this level: go a level up *)
6.127 + then if g_ostate c = Complete
6.128 + then (P, Res)
6.129 + else raise PTREE (ints2str' P ^ " not complete 1")
6.130 + else (* go to the next Nd on this level, or down into the next Nd *)
6.131 + if is_pblnd (nth (p + 1) ns) then (P@[p + 1], Pbl)
6.132 + else if g_res' (nth p ns) = g_form' (nth (p + 1) ns)
6.133 + then if (null o children o (nth (p + 1))) ns
6.134 + then (* take the Res if Complete *)
6.135 + if g_ostate' (nth (p + 1) ns) = Complete
6.136 + then (P@[p + 1], Res)
6.137 + else raise PTREE (ints2str' (P@[p + 1]) ^ " not complete 2")
6.138 + else (P@[p + 1, 1], Frm) (* go down into the next PrfObj *)
6.139 + else (P@[p + 1], Frm) (* take Frm: exists if the Nd exists *)
6.140 + | Frm => (*go down or to the Res of this Nd*)
6.141 + if (null o children o (nth p)) ns
6.142 + then if g_ostate' (nth p ns) = Complete then (P @ [p], Res)
6.143 + else raise PTREE (ints2str' (P @ [p])^" not complete 3")
6.144 + else (P @ [p, 1], Frm)
6.145 + | _ => (* is Pbl or Met *)
6.146 + if (null o children o (nth p)) ns
6.147 + then raise PTREE "move_dn:solve subproblem not startd"
6.148 + else (P @ [p, 1],
6.149 + if (is_pblnd o hd o children o (nth p)) ns
6.150 + then Pbl else Frm))
6.151 + | move_dn _ _ _ = error "";
6.152 +
6.153 +(* go one level down into ctree *)
6.154 +fun movelevel_dn [] (Nd (c, ns)) ([], _) = (* root problem *)
6.155 + if is_pblobj c
6.156 + then if null ns
6.157 + then raise PTREE "solve problem not started"
6.158 + else ([1], if (is_pblnd o hd) ns then Pbl else Frm)
6.159 + else raise PTREE "pos not existent 1"
6.160 + | movelevel_dn P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate towards end of pos *)
6.161 + if p > length ns
6.162 + then raise PTREE "pos not existent 2"
6.163 + else movelevel_dn (P@[p]) (nth p ns) (ps, p_)
6.164 + | movelevel_dn P (Nd (c, ns)) ([p], p_) = (*act on last element of pos*)
6.165 + if p > length ns
6.166 + then raise PTREE "pos not existent 3"
6.167 + else
6.168 + (case p_ of Res =>
6.169 + if p = length ns
6.170 + then raise PTREE "no children"
6.171 + else
6.172 + if g_branch c = TransitiveB
6.173 + then if (null o children o (nth (p+1))) ns
6.174 + then raise PTREE "no children"
6.175 + else (P @ [p+1, 1], if (is_pblnd o hd o children o (nth (p+1))) ns then Pbl else Frm)
6.176 + else if (null o children o (nth p)) ns
6.177 + then raise PTREE "no children"
6.178 + else (P @ [p, 1], if (is_pblnd o hd o children o (nth p)) ns then Pbl else Frm)
6.179 + | _ =>
6.180 + if (null o children o (nth p)) ns
6.181 + then raise PTREE "no children"
6.182 + else (P @ [p, 1], (* go down *)
6.183 + if (is_pblnd o hd o children o (nth p)) ns then Pbl else Frm))
6.184 + | movelevel_dn _ _ _ = error "";
6.185 +
6.186 +(* go to the previous position in ctree; regard TransitiveB *)
6.187 +fun move_up _ (Nd (c, ns)) ([], p_) = (*root problem*)
6.188 + if is_pblobj c
6.189 + then case p_ of Res => if null ns then ([], Pbl) (*Res -> Pbl (not Met)!*)
6.190 + else ([length ns], Res)
6.191 + | _ => raise PTREE "begin of calculation"
6.192 + else raise PTREE "pos not existent"
6.193 + | move_up P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate to end of pos *)
6.194 + if p > length ns
6.195 + then raise PTREE "pos not existent"
6.196 + else move_up (P@[p]) (nth p ns) (ps,p_)
6.197 + | move_up P (Nd (c, ns)) ([p], p_) = (* act on last element of pos *)
6.198 + if p > length ns
6.199 + then raise PTREE "pos not existent"
6.200 + else if is_pblnd (nth p ns)
6.201 + then
6.202 + case p_ of Res =>
6.203 + let val nc = (length o children o (nth p)) ns
6.204 + in
6.205 + if nc = 0
6.206 + then (P @ [p], Pbl) (* Res -> Pbl (not Met) *)
6.207 + else (P @ [p, nc], Res) end (* go down *)
6.208 + | _ => if p = 1 then (P, Pbl) else (P @ [p - 1], Res)
6.209 + else
6.210 + (case p_ of Frm =>
6.211 + if p <> 1
6.212 + then (P, Frm)
6.213 + else if is_pblobj c then (P, Pbl) else (P, Frm)
6.214 + | Res =>
6.215 + let val nc = (length o children o (nth p)) ns
6.216 + in
6.217 + if nc = 0 (* cannot go down *)
6.218 + then if g_branch c = TransitiveB andalso p <> 1
6.219 + then (P @ [p - 1], Res)
6.220 + else (P @ [p], Frm)
6.221 + else (P @ [p, nc], Res) end (* go down *)
6.222 + | _ => error "move_up, NOT is_pblnd: uncovered case pos_")
6.223 + | move_up _ _ _ = error "move_up: uncovered fun def."
6.224 +
6.225 +(* go one level up in ctree; sets the position on Frm *)
6.226 +fun movelevel_up _ _ (([], _)) = raise PTREE "pos not existent" (* root problem *)
6.227 + | movelevel_up P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate towards end of pos *)
6.228 + if p > length ns
6.229 + then raise PTREE "pos not existent"
6.230 + else movelevel_up (P @ [p]) (nth p ns) (ps, p_)
6.231 + | movelevel_up P (Nd (c, ns)) ([p], _) = (* act on last element of pos *)
6.232 + if p > length ns then raise PTREE "pos not existent"
6.233 + else if is_pblobj c then (P, Pbl) else (P, Frm)
6.234 + | movelevel_up _ _ _ = error "movelevel_up: uncovered fun def."
6.235 +
6.236 +(* go to the next calc-head up in the calc-tree *)
6.237 +fun movecalchd_up pt (p, Res) = (par_pblobj pt p, Pbl)
6.238 + | movecalchd_up pt (p, _) =
6.239 + if is_pblobj (get_obj I pt p)
6.240 + then (p, Pbl)
6.241 + else (par_pblobj pt p, Pbl);
6.242 +
6.243 +end
6.244 \ No newline at end of file
7.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
7.2 +++ b/src/Tools/isac/MathEngBasic/ctree.sml Sat Oct 26 13:03:16 2019 +0200
7.3 @@ -0,0 +1,34 @@
7.4 +(* Title: the calctree
7.5 + Author: Walther Neuper 161228
7.6 + (c) due to copyright terms
7.7 +*)
7.8 +
7.9 +signature CTREE =
7.10 +sig
7.11 + include BASIC_CALC_TREE
7.12 + include CALC_TREE_NAVIGATION
7.13 + include CALC_TREE_ACCESS
7.14 +end
7.15 +structure Ctree : CTREE =
7.16 +struct
7.17 + open CTbasic
7.18 + open CTnavi
7.19 + open CTaccess
7.20 +end;
7.21 +(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
7.22 + open Ctree;
7.23 +( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
7.24 +
7.25 +(* policy for "open" structures:
7.26 +--------------------------------
7.27 +The above "open Ctree" creates an unclear situation with structures, in particular in test/.
7.28 +This is work in progress, but urges to make policy explicit:
7.29 +
7.30 +(1) All structures are closed with a signature; this prepares for re-arrangement of structures.
7.31 +(2) Some structures are pervasive (e.g. Ctree) such, that an "open" ensures readability locally.
7.32 +(3) test/ is preceeded by "open" for all structures, in order to ease copy&paste from scr/ to test/
7.33 +
7.34 +ad (1) Presently this point is under construction.
7.35 +ad (2) Such local "open" are kept to a minimum (with the goal to reach Isabelle's state).
7.36 +ad (3) See https://intra.ist.tugraz.at/hg/isa/file/2ba35efb07b7/test/Tools/isac/Test_Isac.thy#l70
7.37 +*)
8.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
8.2 +++ b/src/Tools/isac/MathEngBasic/istate.sml Sat Oct 26 13:03:16 2019 +0200
8.3 @@ -0,0 +1,146 @@
8.4 +(* Title: interpreter-state for Lucas-Interpretation
8.5 + Author: Walther Neuper 190724
8.6 + (c) due to copyright terms
8.7 +*)
8.8 +signature INTERPRETER_STATE =
8.9 +sig
8.10 + datatype safe = Sundef | Safe | Unsafe | Helpless;
8.11 + val safe2str: safe -> string
8.12 +
8.13 + type pstate
8.14 + val e_scrstate: pstate
8.15 + val scrstate2str: Rule.subst * Celem.loc_ * term option * term * safe * bool -> string
8.16 +
8.17 + datatype T = RrlsState of Rule.rrlsstate | Pstate of pstate | Uistate
8.18 + val istate2str: T -> string
8.19 + val istates2str: T option * T option -> string
8.20 + val e_istate: T
8.21 +
8.22 + val get_path: pstate -> Celem.loc_
8.23 + val get_path_up: pstate -> Celem.loc_
8.24 + val get_act: pstate -> term
8.25 + val get_env: pstate -> Env.T
8.26 + val get_act_env: pstate -> (term * Env.T)
8.27 +(*val get_form_env: pstate -> (term option * Env.T)*)
8.28 + val get_subst: pstate -> (Env.T * (term option * term))
8.29 + val get_assoc: pstate -> bool
8.30 +
8.31 + val trans_ass: pstate -> pstate -> pstate
8.32 + val trans_env_act: pstate -> pstate -> pstate
8.33 +
8.34 + val path_down: Celem.loc_ -> pstate -> pstate
8.35 + val path_down_form: (Celem.loc_ * term) -> pstate -> pstate
8.36 + val path_up: pstate -> pstate
8.37 + val path_up_down: Celem.loc_ -> pstate -> pstate
8.38 +
8.39 + val upd_form: term -> pstate -> pstate
8.40 + val upd_env: Env.T -> pstate -> pstate
8.41 + val upd_env': term -> pstate -> pstate
8.42 + val upd_env'': Env.T * (term * term) -> pstate -> pstate
8.43 + val upd_form_env: (term * Env.T) -> pstate -> pstate
8.44 + val upd_act_env: (term * Env.T) -> pstate -> pstate
8.45 + val upd_subst: Env.T -> (term * term) -> pstate -> pstate
8.46 + val upd_subst_true: (term option * term) -> pstate -> pstate
8.47 + val upd_subst_false: (term option * term) -> pstate -> pstate
8.48 +
8.49 +end
8.50 +
8.51 +(**)
8.52 +structure Istate(**): INTERPRETER_STATE(**) =
8.53 +struct
8.54 +(**)
8.55 +
8.56 +datatype safe = Sundef | Safe | Unsafe | Helpless;
8.57 +fun safe2str Sundef = "Sundef"
8.58 + | safe2str Safe = "Safe"
8.59 + | safe2str Unsafe = "Unsafe"
8.60 + | safe2str Helpless = "Helpless";
8.61 +
8.62 +type pstate = (* state for script interpreter *)
8.63 + Env.T(*stack*) (* used to instantiate tac for checking associate
8.64 + 12.03.noticed: e_ not updated during execution ?!? *)
8.65 + * Celem.loc_ (* location of tac in script *)
8.66 + * term option (*id FORMal ARGument of curried functions *)
8.67 + * term (*vl ACTual ARGument (value) for execution of Tactic.T
8.68 + updated also after a derivation by 'new_val' *)
8.69 + * safe (* estimation of how result will be obtained *)
8.70 + * bool; (* true = strongly .., false = weakly associated:
8.71 + only used during ass_dn/up *)
8.72 +val e_scrstate =
8.73 + ([]: Env.T, []:Celem.loc_, SOME Rule.e_term, Rule.e_term, Sundef, false) : pstate
8.74 +fun topt2str NONE = "NONE"
8.75 + | topt2str (SOME t) = "SOME" ^ Rule.term2str t;
8.76 +fun scrstate2str (env, loc_, topt, t, safe, bool) = (* for tests only *)
8.77 + "(" ^ Env.env2str env ^ ", " ^ Celem.loc_2str loc_ ^ ", " ^ topt2str topt ^ ", \n" ^
8.78 + Rule.term2str t ^ ", " ^ safe2str safe ^ ", " ^ bool2str bool ^ ")";
8.79 +
8.80 +(* for handling type T see fun from_pblobj_or_detail', +? *)
8.81 +datatype T = (*interpreter state*)
8.82 + Uistate (*undefined in modspec, in '_deriv'ation*)
8.83 + | Pstate of pstate (*for script interpreter*)
8.84 + | RrlsState of Rule.rrlsstate; (*for reverse rewriting*)
8.85 +val e_istate = (Pstate ([], [], NONE, Rule.e_term, Sundef, false));
8.86 +
8.87 +fun rta2str (r, (t, a)) = "\n(" ^ Rule.rule2str r ^ ",(" ^ Rule.term2str t ^", " ^ Rule.terms2str a ^ "))";
8.88 +fun istate2str Uistate = "Uistate"
8.89 + | istate2str (Pstate (e, l, to, t, s, b)) =
8.90 + "Pstate ("^ Env.subst2str e ^ ",\n " ^
8.91 + Celem.loc_2str l ^ ", " ^ Rule.termopt2str to ^ ",\n " ^
8.92 + Rule.term2str t ^ ", " ^ safe2str s ^ ", " ^ bool2str b ^ ")"
8.93 + | istate2str (RrlsState (t, t1, rss, rtas)) =
8.94 + "RrlsState (" ^ Rule.term2str t ^ ", " ^ Rule.term2str t1 ^ ", " ^
8.95 + (strs2str o (map (strs2str o (map Rule.rule2str)))) rss ^ ", " ^
8.96 + (strs2str o (map rta2str)) rtas ^ ")";
8.97 +fun istates2str (NONE, NONE) = "(#NONE, #NONE)" (* for tests only *)
8.98 + | istates2str (NONE, SOME ist) = "(#NONE,\n#SOME " ^ istate2str ist ^ ")"
8.99 + | istates2str (SOME ist, NONE) = "(#SOME " ^ istate2str ist ^ ",\n #NONE)"
8.100 + | istates2str (SOME i1, SOME i2) = "(#SOME " ^ istate2str i1 ^ ",\n #SOME " ^ istate2str i2 ^ ")";
8.101 +
8.102 +fun get_path (_, path, _, _, _, _) = path
8.103 +fun get_path_up (ist as (_, path, _, _, _, _)) =
8.104 + if length path > 1 then drop_last path else raise ERROR ("get_path_up [] with " ^ scrstate2str ist)
8.105 +fun get_act (_, _, _, act_arg, _, _) = act_arg
8.106 +fun get_env (env, _, _, _, _, _) = env
8.107 +fun get_act_env (env, _, _, act_arg, _, _) = (act_arg, env)
8.108 +(*fun get_form_env (env, _, form_arg, _, _, _) = (form_arg, env)*)
8.109 +fun get_assoc (_, _, _, _, _, ass) = ass
8.110 +fun get_subst (env, _, form_arg, act_arg, _, _) = (env, (form_arg, act_arg))
8.111 +
8.112 +fun trans_ass (_, _, _, _, _, ass) (env, path, form_arg, act_arg, safe, _) =
8.113 + (env, path, form_arg, act_arg, safe, ass)
8.114 +fun trans_env_act (env, _, _, act_arg, _, _) (_, path, form_arg, _, safe, ass) =
8.115 + (env, path, form_arg, act_arg, safe, ass)
8.116 +
8.117 +fun path_down path (env, p, form_arg, act_arg, safe, ass) =
8.118 + (env, p @ path, form_arg, act_arg, safe, ass)
8.119 +fun path_down_form (path, form_arg) (env, p, _, act_arg, safe, ass) =
8.120 + (env, p @ path, SOME form_arg, act_arg, safe, ass)
8.121 +fun path_up (env, path, form_arg, act_arg, safe, ass) =
8.122 + (env, drop_last path, form_arg, act_arg, safe, ass)
8.123 +fun path_up_down path (env, p, form_arg, act_arg, safe, ass) =
8.124 + (env, (drop_last p) @ path, form_arg, act_arg, safe, ass)
8.125 +
8.126 +fun upd_form form (env, path, _, act_arg, safe, ass) =
8.127 + (env, path, SOME form, act_arg, safe, ass)
8.128 +
8.129 +fun upd_env env (_, path, form_arg, act_arg, safe, ass) =
8.130 + (env, path, form_arg, act_arg, safe, ass)
8.131 +fun upd_env' form (env, path, form_arg, act_arg, safe, ass) =
8.132 + (Env.upd_env env (form, act_arg), path, form_arg, act_arg, safe, ass)
8.133 +fun upd_env'' (env, (form, act)) (_, path, _, _, safe, ass) =
8.134 + (Env.upd_env env (form, act), path, SOME form, act, safe, ass)
8.135 +
8.136 +fun upd_form_env (form_arg, env) (_, path, _, act_arg, safe, ass) =
8.137 + (env, path, SOME form_arg, act_arg, safe, ass)
8.138 +fun upd_act_env (act_arg, env) (_, path, form_arg, _, safe, ass) =
8.139 + (env, path, form_arg, act_arg, safe, ass)
8.140 +
8.141 +fun upd_subst env (form_arg, act_arg) (_, path, _, _, safe, ass) =
8.142 + (env, path, SOME form_arg, act_arg, safe, ass)
8.143 +fun upd_subst_true (form_arg, act_arg) (env, path, _, _, safe, _) =
8.144 + (env, path, form_arg, act_arg, safe, true)
8.145 +fun upd_subst_false (form_arg, act_arg) (env, path, _, _, safe, _) =
8.146 + (env, path, form_arg, act_arg, safe, false)
8.147 +
8.148 +(**)end(**)
8.149 +
9.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
9.2 +++ b/src/Tools/isac/MathEngBasic/model.sml Sat Oct 26 13:03:16 2019 +0200
9.3 @@ -0,0 +1,470 @@
9.4 +(* Title: Model for (sub-)calculations.
9.5 + Various representations: item and ppc for frontend, itm_ and itm for internal functions.
9.6 + The former are related to structure Specify, the latter to structure Chead --
9.7 + -- apt to re-arrangement of structures
9.8 + Author: Walther Neuper 170207
9.9 + (c) due to copyright terms
9.10 +*)
9.11 +
9.12 +signature MODEL =
9.13 +sig
9.14 + type ori
9.15 + val oris2str : ori list -> string
9.16 + val e_ori : ori
9.17 + datatype item
9.18 + = Correct of Rule.cterm' | False of Rule.cterm' | Incompl of Rule.cterm' | Missing of Rule.cterm' | Superfl of string
9.19 + | SyntaxE of string | TypeE of string
9.20 + datatype itm_ = Cor of (term * (term list)) * (term * (term list))
9.21 + | Syn of Rule.cterm' | Typ of Rule.cterm' | Inc of (term * (term list)) * (term * (term list))
9.22 + | Sup of (term * (term list)) | Mis of (term * term) | Par of Rule.cterm'
9.23 + val itm_2str : itm_ -> string
9.24 + val itm_2str_ : Proof.context -> itm_ -> string
9.25 + type itm
9.26 + val itm2str_ : Proof.context -> itm -> string
9.27 + val itms2str_ : Proof.context -> itm list -> string
9.28 + val e_itm : itm
9.29 + type 'a ppc
9.30 + val empty_ppc : item ppc
9.31 + val ppc2str : {Find: string list, Given: string list, Relate: string list, Where: string list,
9.32 + With: string list} -> string
9.33 + val itemppc2str : item ppc -> string
9.34 +
9.35 + type vats
9.36 + val comp_dts : term * term list -> term
9.37 + val comp_dts' : term * term list -> term
9.38 + val comp_dts'' : term * term list -> string
9.39 + val comp_ts : term * term list -> term
9.40 + val split_dts : term -> term * term list
9.41 + val split_dts' : term * term -> term list
9.42 + val pbl_ids' : term -> term list -> term list
9.43 + val mkval' : term list -> term
9.44 +
9.45 + val d_in : itm_ -> term
9.46 + val ts_in : itm_ -> term list
9.47 + val penvval_in : itm_ -> term list
9.48 + val mk_env : itm list -> (term * term) list (* close to Chead.all_dsc_in, Chead.is_error, etc *)
9.49 + val vars_of : itm list -> term list
9.50 + val max_vt : itm list -> int
9.51 +
9.52 +(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
9.53 + type penv
9.54 + val penv2str_ : Proof.context -> penv -> string (* NONE *)
9.55 + type preori
9.56 + val preoris2str : preori list -> string
9.57 +(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
9.58 + (* NONE *)
9.59 +( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
9.60 +
9.61 +(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
9.62 + val untouched : itm list -> bool
9.63 + type envv
9.64 + val upds_envv : Proof.context -> envv -> (vats * term * term * term) list -> envv
9.65 + val item_ppc : string ppc -> item ppc
9.66 + val all_ts_in : itm_ list -> term list
9.67 + val pres2str : (bool * term) list -> string
9.68 +end
9.69 +
9.70 +structure Model(**) : MODEL(**) =
9.71 +struct
9.72 +(*==========================================================================
9.73 +23.3.02 TODO: ideas on redesign of type itm_,type item,type ori,type item ppc
9.74 +(1) kinds of itms:
9.75 + (1.1) untouched: for modeling only dsc displayed(impossible after match_itms)
9.76 + =(presently) Mis (? should be Inc initially, and Mis after match_itms?)
9.77 + (1.2) Syn,Typ,Sup: not related to oris
9.78 + Syn, Typ (presently) should be accepted in appl_add (instead Error')
9.79 + Sup (presently) should be accepted in appl_add (instead Error')
9.80 + _could_ be w.r.t current vat (and then _is_ related to vat
9.81 + Mis should _not_ be made Inc ((presently, by appl_add & match_itms)
9.82 +- dsc in itm_ is timeconsuming -- keep id for respective queries ?
9.83 +- order of items in ppc should be stable w.r.t order of itms
9.84 +
9.85 +- stepwise input of itms --- match_itms (in one go) ..not coordinated
9.86 + - unify code
9.87 + - match_itms / match_itms_oris ..2 versions ?!
9.88 + (fast, for refine / slow, for modeling)
9.89 +
9.90 +- clarify: efficiency <--> simplicity !!!
9.91 + ?: shift dsc itm_ -> itm | discard int in ori,itm | take int instead dsc
9.92 + | take int for perserving order of item ppc in itms
9.93 + | make all(!?) handling of itms stable against reordering(?)
9.94 + | field in ori ?? (not from fmz!) -- meant for efficiency (not doc!???)
9.95 + -"- "#undef" ?= not touched ?= (id,..)
9.96 +-----------------------------------------------------------------
9.97 +27.3.02:
9.98 +def: type pbt = (field, (dsc, pid)) *** design considerations ***
9.99 +
9.100 +(1) fmz + pbt -> oris
9.101 +(2) input + oris -> itm
9.102 +(3) match_itms : schnell(?) f"ur refine
9.103 + match_itms_oris : r"uckmeldung f"ur item ppc
9.104 +
9.105 +(1.1) in oris fehlt daher pid: (i,v,f,d,ts,pid)
9.106 +---------- ^^^^^ --- dh. pbt meist als argument zu viel !!!
9.107 +
9.108 +(3.1) abwarten, wie das matchen mehr unterschiedlicher pbt's sich macht;
9.109 + wenn Problem pbt v"ollig neue, dann w"are eigentlich n"otig ????:
9.110 + (a) (_,_,d1,ts,_):ori + pbt -> (i,vt,d2,ts,pid) dh.vt neu ????
9.111 + (b)
9.112 +==========================================================================*)
9.113 +
9.114 +val script_parse = the o (@{theory ProgLang} |> Rule.thy2ctxt |> TermC.parseNEW);
9.115 +val e_listReal = script_parse "[]::(real list)";
9.116 +val e_listBool = script_parse "[]::(bool list)";
9.117 +
9.118 +(* take list-term apart w.r.t. handling elementwise input: @{term "[a, b]"} \<rightarrow> ["[a]","[b]"] *)
9.119 +fun take_apart t =
9.120 + let val elems = TermC.isalist2list t
9.121 + in map ((TermC.list2isalist (type_of (hd elems))) o single) elems end;
9.122 +fun take_apart_inv ts = (* t = (take_apart_inv o take_apart) t *)
9.123 + let val elems = (flat o (map TermC.isalist2list)) ts;
9.124 + in TermC.list2isalist (type_of (hd elems)) elems end;
9.125 +
9.126 +fun is_var (Free _) = true
9.127 + | is_var _ = false;
9.128 +
9.129 +(* special handling for lists. ?WN:14.5.03 ??!? *)
9.130 +fun dest_list (d, ts) =
9.131 + let fun dest t =
9.132 + if Input_Descript.is_list_dsc d andalso not (Input_Descript.is_unl d) andalso not (is_var t) (*..for pbt*)
9.133 + then TermC.isalist2list t
9.134 + else [t]
9.135 + in (flat o (map dest)) ts end;
9.136 +
9.137 +(* revert split_dts only for ts; compare comp_dts *)
9.138 +fun comp_ts (d, ts) =
9.139 + if Input_Descript.is_list_dsc d
9.140 + then if TermC.is_list (hd ts)
9.141 + then if Input_Descript.is_unl d
9.142 + then (hd ts) (* e.g. someList [1,3,2] *)
9.143 + else (take_apart_inv ts) (* [ [a], [b] ] -> [a,b] *)
9.144 + else (hd ts) (* a variable or metavariable for a list *)
9.145 + else (hd ts);
9.146 +fun comp_dts (d, []) =
9.147 + if Input_Descript.is_reall_dsc d
9.148 + then (d $ e_listReal)
9.149 + else if Input_Descript.is_booll_dsc d then (d $ e_listBool) else d
9.150 + | comp_dts (d, ts) = (d $ (comp_ts (d, ts)))
9.151 + handle _ => error ("comp_dts: " ^ Rule.term2str d ^ " $ " ^ Rule.term2str (hd ts));
9.152 +fun comp_dts' (d, []) =
9.153 + if Input_Descript.is_reall_dsc d
9.154 + then (d $ e_listReal)
9.155 + else if Input_Descript.is_booll_dsc d then (d $ e_listBool) else d
9.156 + | comp_dts' (d, ts) = (d $ (comp_ts (d, ts)))
9.157 + handle _ => error ("comp_dts': " ^ Rule.term2str d ^ " $ " ^ Rule.term2str (hd ts));
9.158 +fun comp_dts'' (d, []) =
9.159 + if Input_Descript.is_reall_dsc d
9.160 + then Rule.term2str (d $ e_listReal)
9.161 + else if Input_Descript.is_booll_dsc d
9.162 + then Rule.term2str (d $ e_listBool)
9.163 + else Rule.term2str d
9.164 + | comp_dts'' (d, ts) = Rule.term2str (d $ (comp_ts (d, ts)))
9.165 + handle _ => error ("comp_dts'': " ^ Rule.term2str d ^ " $ " ^ Rule.term2str (hd ts));
9.166 +
9.167 +(* decompose an input into description, terms (ev. elems of lists),
9.168 + and the value for the problem-environment; inv to comp_dts *)
9.169 +fun split_dts (t as d $ arg) =
9.170 + if Input_Descript.is_dsc d
9.171 + then if Input_Descript.is_list_dsc d andalso TermC.is_list arg andalso Input_Descript.is_unl d |> not
9.172 + then (d, take_apart arg)
9.173 + else (d, [arg])
9.174 + else (Rule.e_term, TermC.dest_list' t)
9.175 + | split_dts t =
9.176 + let val t' as (h, _) = strip_comb t;
9.177 + in
9.178 + if Input_Descript.is_dsc h
9.179 + then (h, dest_list t')
9.180 + else (Rule.e_term, TermC.dest_list' t)
9.181 + end;
9.182 +(* version returning ts only *)
9.183 +fun split_dts' (d, arg) =
9.184 + if Input_Descript.is_dsc d
9.185 + then if Input_Descript.is_list_dsc d
9.186 + then if TermC.is_list arg
9.187 + then if Input_Descript.is_unl d
9.188 + then ([arg]) (* e.g. someList [1,3,2] *)
9.189 + else (take_apart arg) (* [a,b] --> SML[ [a], [b] ]SML *)
9.190 + else ([arg]) (* a variable or metavariable for a list *)
9.191 + else ([arg])
9.192 + else (TermC.dest_list' arg)
9.193 +(* WN170204: Warning "redundant"
9.194 + | split_dts' (d, t) = (*either dsc or term; 14.5.03 only copied*)
9.195 + let val (h,argl) = strip_comb t
9.196 + in
9.197 + if (not o is_dsc) h
9.198 + then (dest_list' t)
9.199 + else (dest_list (h,argl))
9.200 + end;*)
9.201 +(* revert split_:
9.202 + WN050903 we do NOT know which is from subtheory, description or term;
9.203 + typecheck thus may lead to TYPE-error 'unknown constant';
9.204 + solution: typecheck with (Thy_Info_get_theory "Isac_Knowledge"); i.e. arg 'thy' superfluous*)
9.205 +(*fun comp_dts thy (d,[]) =
9.206 + Thm.global_cterm_of (*(sign_of o assoc_thy) "Isac_Knowledge"*)
9.207 + (Thy_Info_get_theory "Isac_Knowledge")
9.208 + (*comp_dts:FIXXME stay with term for efficiency !!!*)
9.209 + (if is_reall_dsc d then (d $ e_listReal)
9.210 + else if is_booll_dsc d then (d $ e_listBool)
9.211 + else d)
9.212 + | comp_dts (d,ts) =
9.213 + (Thm.global_cterm_of (*(sign_of o assoc_thy) "Isac_Knowledge"*)
9.214 + (Thy_Info_get_theory "Isac_Knowledge")
9.215 + (*comp_dts:FIXXME stay with term for efficiency !!*)
9.216 + (d $ (comp_ts (d, ts)))
9.217 + handle _ => error ("comp_dts: "^(term2str d)^
9.218 + " $ "^(term2str (hd ts))));*)
9.219 +
9.220 +(* 27.8.01: problem-environment
9.221 +WN.6.5.03: FIXXME reconsider if penv is worth the effort --
9.222 + -- just rerun a whole expl with num/var may show the same ?!
9.223 +WN.9.5.03: penv-concept stalled, immediately generate script env !
9.224 + but [#0, epsilon] only outcommented for eventual reconsideration *)
9.225 +type penv = (* problem-environment *)
9.226 + (term (* err_ *)
9.227 + * (term list) (* [#0, epsilon] 9.5.03 outcommented *)
9.228 + ) list;
9.229 +fun pen2str ctxt (t, ts) =
9.230 + pair2str (Rule.term_to_string' ctxt t, (strs2str' o map (Rule.term_to_string' ctxt)) ts);
9.231 +fun penv2str_ thy penv = (strs2str' o (map (pen2str thy))) penv;
9.232 +
9.233 +(* get the constant value from a penv *)
9.234 +fun getval (id, values) =
9.235 + case values of
9.236 + [] => error ("penv_value: no values in '" ^ Rule.term2str id)
9.237 + | [v] => (id, v)
9.238 + | (v1 :: v2 :: _) => (case v1 of
9.239 + Const ("Program.Arbfix",_) => (id, v2)
9.240 + | _ => (id, v1));
9.241 +
9.242 +(* 9.5.03: still unused, but left for eventual future development *)
9.243 +type envv = (int * penv) list; (* over variants *)
9.244 +
9.245 +(* 14.9.01: not used after putting penv-values into itm_
9.246 + make the result of split_* a value of problem-environment *)
9.247 +fun mkval _(*dsc*) [] = error "mkval called with []"
9.248 + | mkval _ [t] = t
9.249 + | mkval _ ts = TermC.list2isalist ((type_of o hd) ts) ts;
9.250 +fun mkval' x = mkval Rule.e_term x;
9.251 +
9.252 +(* the internal representation of a models' item
9.253 + 4.9.01: not consistent:
9.254 + after Init_Proof 'Inc', but after copy_probl 'Mis' - for same situation
9.255 + (involves 'is_error');
9.256 + bool in itm really necessary ???*)
9.257 +datatype itm_ =
9.258 + Cor of (term * (* description *)
9.259 + (term list)) * (* for list: elem-wise input *)
9.260 + (term * (term list)) (* elem of penv ---- penv delayed to future *)
9.261 +| Syn of Rule.cterm'
9.262 +| Typ of Rule.cterm'
9.263 +| Inc of (term * (term list)) * (term * (term list)) (*lists,
9.264 + + init_pbl WN.11.03 FIXXME: empty penv .. bad; init_pbl should return Mis !!! *)
9.265 +| Sup of (term * (term list)) (* user-input not found in pbt(+?oris?11.03)*)
9.266 +| Mis of (term * term) (* after re-specification pbt-item not found in pbl: only dsc, pid_*)
9.267 +| Par of Rule.cterm'; (* internal state from fun parsitm *)
9.268 +
9.269 +type vats = int list; (* variants in formalizations *)
9.270 +
9.271 +(* data-type for working on pbl/met-ppc:
9.272 + in pbl initially holds descriptions (only) for user guidance *)
9.273 +type itm =
9.274 + int * (* id =0 .. untouched - descript (only) from init
9.275 + seems to correspond to ori (fun insert_ppc) <> maintain order in item ppc? *)
9.276 + vats * (* variants - copy from ori *)
9.277 + bool * (* input on this item is not/complete *)
9.278 + string * (* #Given | #Find | #Relate *)
9.279 + itm_; (* *)
9.280 +val e_itm = (0, [], false, "e_itm", Syn "e_itm");
9.281 +
9.282 +(* in CalcTree/Subproblem an 'untouched' model is created
9.283 + FIXME.WN.9.03 model should be filled to 'untouched' by Model/Refine_Problem*)
9.284 +fun untouched itms = foldl and_ (true , map ((curry op = 0) o (#1 : itm -> int)) itms);
9.285 +
9.286 +(* find most frequent variant v in itms *)
9.287 +fun vts_in itms = (distinct o flat o (map #2)) (itms:itm list);
9.288 +
9.289 +fun cnt itms v = (v, (length o (filter (curry op = v)) o flat o (map #2)) itms);
9.290 +fun vts_cnt vts itms = map (cnt itms) vts;
9.291 +fun max2 [] = error "max2 of []"
9.292 + | max2 (y :: ys) =
9.293 + let
9.294 + fun mx (a,x) [] = (a,x)
9.295 + | mx (a, x) ((b,y) :: ys) = if x < y then mx (b, y) ys else mx (a, x) ys;
9.296 + in mx y ys end;
9.297 +
9.298 +(* find the variant with most items already input *)
9.299 +fun max_vt itms =
9.300 + let val vts = (vts_cnt (vts_in itms)) itms;
9.301 + in if vts = [] then 0 else (fst o max2) vts end;
9.302 +
9.303 +(* TODO ev. make more efficient by avoiding flat *)
9.304 +fun mk_e (Cor (_, iv)) = [getval iv]
9.305 + | mk_e (Syn _) = []
9.306 + | mk_e (Typ _) = []
9.307 + | mk_e (Inc (_, iv)) = [getval iv]
9.308 + | mk_e (Sup _) = []
9.309 + | mk_e (Mis _) = []
9.310 + | mk_e _ = error "mk_e: uncovered case in fun.def.";
9.311 +fun mk_en vt (_, vts, _, _, itm_) = if member op = vts vt then mk_e itm_ else [];
9.312 +
9.313 +(* extract the environment from an item list; takes the variant with most items *)
9.314 +fun mk_env itms =
9.315 + let val vt = max_vt itms
9.316 + in (flat o (map (mk_en vt))) itms end;
9.317 +
9.318 +(* example as provided by an author, complete w.r.t. pbt specified
9.319 + not touched by any user action *)
9.320 +type ori =
9.321 + (int * (* id: 10.3.00ff impl. only <>0 .. touched
9.322 + 21.3.02: insert_ppc needs it ! ?:purpose maintain order in item ppc ??? *)
9.323 + vats * (* variants 21.3.02: related to pbt..discard ? *)
9.324 + string * (* #Given | #Find | #Relate 21.3.02: discard ? *)
9.325 + term * (* description *)
9.326 + term list (* isalist2list t | [t] *)
9.327 + );
9.328 +val e_ori = (0, [], "", Rule.e_term, [Rule.e_term]) : ori;
9.329 +
9.330 +fun ori2str (i, vs, fi, t, ts) =
9.331 + "(" ^ string_of_int i ^ ", " ^ (strs2str o (map string_of_int)) vs ^ ", " ^ fi ^ "," ^
9.332 + Rule.term2str t ^ ", " ^ (strs2str o (map Rule.term2str)) ts ^ ")";
9.333 +val oris2str = strs2str' o (map (Celem.linefeed o ori2str));
9.334 +
9.335 +(* an or without leading integer *)
9.336 +type preori = (vats * string * term * term list);
9.337 +fun preori2str (vs, fi, t, ts) =
9.338 + "(" ^ (strs2str o (map string_of_int)) vs ^ ", " ^ fi ^ ", " ^
9.339 + Rule.term2str t ^ ", " ^ (strs2str o (map Rule.term2str)) ts ^ ")";
9.340 +val preoris2str = (strs2str' o (map (Celem.linefeed o preori2str)));
9.341 +
9.342 +(* 9.5.03 penv postponed: pbl_ids' *)
9.343 +fun pbl_ids' d vs = [comp_ts (d, vs)];
9.344 +
9.345 +(* 14.9.01: not used after putting values for penv into itm_
9.346 + WN.5.5.03: used in upd .. upd_envv *)
9.347 +fun upd_penv ctxt penv dsc (id, vl) =
9.348 +(tracing"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
9.349 + tracing"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
9.350 + tracing"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
9.351 + overwrite (penv, (id, Input_Descript.pbl_ids ctxt dsc vl))
9.352 +);
9.353 +
9.354 +(* WN.9.5.03: not reconsidered; looks strange !!!*)
9.355 +fun upd thy envv dsc (id, vl) i =
9.356 + let val penv = case assoc (envv, i) of
9.357 + SOME e => e
9.358 + | NONE => [];
9.359 + val penv' = upd_penv thy penv dsc (id, vl);
9.360 + in (i, penv') end;
9.361 +
9.362 +(* 14.9.01: not used after putting pre-penv into itm_*)
9.363 +fun upd_envv thy envv vats dsc id vl =
9.364 + let val vats = if length vats = 0
9.365 + then (*unknown id to _all_ variants*)
9.366 + if length envv = 0 then [1]
9.367 + else (intsto o length) envv
9.368 + else vats
9.369 + fun isin vats (i, _) = member op = vats i;
9.370 + val envs_notin_vat = filter_out (isin vats) envv;
9.371 + in (map (upd thy envv dsc (id, vl)) vats) @ envs_notin_vat end;
9.372 +
9.373 +(* update envv by folding from a list of arguments *)
9.374 +fun upds_envv _ envv [] = envv
9.375 + | upds_envv thy envv ((vs, dsc, id, vl) :: ps) =
9.376 + upds_envv thy (upd_envv thy envv vs dsc id vl) ps;
9.377 +
9.378 +(* for _output_ of the items of a Model *)
9.379 +datatype item =
9.380 + Correct of Rule.cterm' (* labels a correct formula (type cterm') *)
9.381 + | SyntaxE of string (**)
9.382 + | TypeE of string (**)
9.383 + | False of Rule.cterm' (* WN050618 notexistent in itm_: only used in Where *)
9.384 + | Incompl of Rule.cterm' (**)
9.385 + | Superfl of string (**)
9.386 + | Missing of Rule.cterm';
9.387 +fun item2str (Correct s) ="Correct " ^ s
9.388 + | item2str (SyntaxE s) ="SyntaxE " ^ s
9.389 + | item2str (TypeE s) ="TypeE " ^ s
9.390 + | item2str (False s) ="False " ^ s
9.391 + | item2str (Incompl s) ="Incompl " ^ s
9.392 + | item2str (Superfl s) ="Superfl " ^ s
9.393 + | item2str (Missing s) ="Missing " ^ s;
9.394 +(*make string for error-msgs*)
9.395 +fun itm_2str_ ctxt (Cor ((d, ts), penv)) =
9.396 + "Cor " ^ Rule.term_to_string' ctxt (comp_dts (d, ts)) ^ " ," ^ pen2str ctxt penv
9.397 + | itm_2str_ _ (Syn c) = "Syn " ^ c
9.398 + | itm_2str_ _ (Typ c) = "Typ " ^ c
9.399 + | itm_2str_ ctxt (Inc ((d, ts), penv)) =
9.400 + "Inc " ^ Rule.term_to_string' ctxt (comp_dts (d, ts)) ^ " ," ^ pen2str ctxt penv
9.401 + | itm_2str_ ctxt (Sup (d, ts)) =
9.402 + "Sup " ^ Rule.term_to_string' ctxt (comp_dts (d, ts))
9.403 + | itm_2str_ ctxt (Mis (d, pid)) =
9.404 + "Mis "^ Rule.term_to_string' ctxt d ^ " " ^ Rule.term_to_string' ctxt pid
9.405 + | itm_2str_ _ (Par s) = "Trm "^s;
9.406 +fun itm_2str t = itm_2str_ (Rule.thy2ctxt' "Isac_Knowledge") t;
9.407 +fun itm2str_ ctxt ((i, is, b, s, itm_):itm) =
9.408 + "(" ^ string_of_int i ^ " ," ^ ints2str' is ^ " ," ^ bool2str b ^ " ," ^
9.409 + s ^ " ," ^ itm_2str_ ctxt itm_ ^ ")";
9.410 +fun itms2str_ ctxt itms = strs2str' (map (Celem.linefeed o (itm2str_ ctxt)) itms);
9.411 +fun init_item str = SyntaxE str;
9.412 +
9.413 +type 'a ppc =
9.414 + {Given : 'a list, Where: 'a list, Find : 'a list, With : 'a list, Relate: 'a list};
9.415 +fun ppc2str {Given = Given, Where = Where, Find = Find, With = With, Relate = Relate}=
9.416 + "{Given =" ^ strs2str Given ^ ",Where=" ^ strs2str Where ^ ",Find =" ^ strs2str Find ^
9.417 + ",With =" ^ strs2str With ^ ",Relate=" ^ strs2str Relate ^ "}";
9.418 +
9.419 +fun item_ppc {Given = gi, Where= wh, Find = fi, With = wi, Relate= re} =
9.420 + {Given = map init_item gi, Where= map init_item wh, Find = map init_item fi,
9.421 + With = map init_item wi, Relate= map init_item re};
9.422 +fun itemppc2str ({Given=Given,Where=Where,
9.423 + Find=Find,With=With,Relate=Relate}:item ppc)=
9.424 + ("{Given =" ^ ((strs2str' o (map item2str)) Given ) ^
9.425 + ",Where=" ^ ((strs2str' o (map item2str)) Where) ^
9.426 + ",Find =" ^ ((strs2str' o (map item2str)) Find ) ^
9.427 + ",With =" ^ ((strs2str' o (map item2str)) With ) ^
9.428 + ",Relate=" ^ ((strs2str' o (map item2str)) Relate) ^ "}");
9.429 +
9.430 +val empty_ppc = {Given = [], Where= [], Find = [], With = [], Relate= []};
9.431 +
9.432 +fun ts_in (Cor ((_, ts), _)) = ts
9.433 + | ts_in (Syn _) = []
9.434 + | ts_in (Typ _) = []
9.435 + | ts_in (Inc ((_, ts), _)) = ts
9.436 + | ts_in (Sup (_, ts)) = ts
9.437 + | ts_in (Mis _) = []
9.438 + | ts_in _ = error "ts_in: uncovered case in fun.def.";
9.439 +(*WN050629 unused*)
9.440 +fun all_ts_in itm_s = (flat o (map ts_in)) itm_s;
9.441 +val unique = (Thm.term_of o the o (TermC.parse @{theory "Real"} )) "UnIqE_tErM";
9.442 +fun d_in (Cor ((d ,_), _)) = d
9.443 + | d_in (Syn c) = (tracing ("*** d_in: Syn ("^c^")"); unique)
9.444 + | d_in (Typ c) = (tracing ("*** d_in: Typ ("^c^")"); unique)
9.445 + | d_in (Inc ((d, _), _)) = d
9.446 + | d_in (Sup (d, _)) = d
9.447 + | d_in (Mis (d, _)) = d
9.448 + | d_in _ = error "d_in: uncovered case in fun.def.";
9.449 +
9.450 +fun dts2str (d, ts) = pair2str (Rule.term2str d, Rule.terms2str ts);
9.451 +fun penvval_in (Cor ((d, _), (_, ts))) = [comp_ts (d,ts)]
9.452 + | penvval_in (Syn (c)) = (tracing("*** penvval_in: Syn ("^c^")"); [])
9.453 + | penvval_in (Typ (c)) = (tracing("*** penvval_in: Typ ("^c^")"); [])
9.454 + | penvval_in (Inc (_, (_, ts))) = ts
9.455 + | penvval_in (Sup dts) = (tracing ("*** penvval_in: Sup "^(dts2str dts)); [])
9.456 + | penvval_in (Mis (d, t)) = (tracing ("*** penvval_in: Mis " ^
9.457 + pair2str(Rule.term2str d, Rule.term2str t)); [])
9.458 + | penvval_in _ = error "penvval_in: uncovered case in fun.def.";
9.459 +
9.460 +(* check a predicate labelled with indication of incomplete substitution;
9.461 + rls -> (* for eval_true *)
9.462 + bool * (* have _all_ variables(Free) from the model-pattern
9.463 + been substituted by a value from the pattern's environment ?*)
9.464 + term -> (* the precondition *)
9.465 + bool * (* has the precondition evaluated to true *)
9.466 + term (* the precondition (for map) *)
9.467 +*)
9.468 +fun pre2str (b, t) = pair2str(bool2str b, Rule.term2str t);
9.469 +fun pres2str pres = strs2str' (map (Celem.linefeed o pre2str) pres);
9.470 +
9.471 +fun vars_of itms = itms |> mk_env |> map snd
9.472 +
9.473 +end;
9.474 \ No newline at end of file
10.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
10.2 +++ b/src/Tools/isac/MathEngBasic/mstools.sml Sat Oct 26 13:03:16 2019 +0200
10.3 @@ -0,0 +1,98 @@
10.4 +(* Title: tools for 'modeling' und 'specifying' to be used in
10.5 + modspec.sml. The types are separated into this file,
10.6 + because some of them are stored in the calc-tree, and thus are required
10.7 + _before_ ctree.sml.
10.8 + TODO: allocate elements of Selem and of Stool appropriately
10.9 + Author: Walther Neuper, Mathias Lehnfeld
10.10 + (c) due to copyright terms
10.11 +*)
10.12 +
10.13 +signature SPECIFY_TOOL =
10.14 +sig
10.15 + val check_preconds : 'a -> Rule.rls -> term list -> Model.itm list -> (bool * term) list
10.16 + val check_preconds' : Rule.rls -> term list -> Model.itm list -> 'a -> (bool * term) list
10.17 +
10.18 + datatype match_ = Match_ of Celem.pblID * (Model.itm list * (bool * term) list) | NoMatch_
10.19 + val refined_ : match_ list -> match_ option
10.20 + datatype match = Matches of Celem.pblID * Model.item Model.ppc | NoMatch of Celem.pblID * Model.item Model.ppc
10.21 + val matchs2str : match list -> string
10.22 + val common_subthy : theory * theory -> theory
10.23 +(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
10.24 + val pres2str : (bool * term) list -> string
10.25 + val refined : match list -> Celem.pblID
10.26 +(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
10.27 + (*NONE*)
10.28 +( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
10.29 +
10.30 +(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
10.31 + val pblID_of_match : match -> Celem.pblID
10.32 + val refined_IDitms : match list -> match option
10.33 +end
10.34 +
10.35 +structure Stool(**) : SPECIFY_TOOL(**) =
10.36 +struct
10.37 +
10.38 +datatype match =
10.39 + Matches of Celem.pblID * Model.item Model.ppc
10.40 +| NoMatch of Celem.pblID * Model.item Model.ppc;
10.41 +fun match2str (Matches (pI, ppc)) = "Matches (" ^ strs2str pI ^ ", " ^ Model.itemppc2str ppc ^ ")"
10.42 + | match2str (NoMatch (pI, ppc)) = "NoMatch (" ^ strs2str pI ^ ", " ^ Model.itemppc2str ppc ^ ")";
10.43 +fun matchs2str ms = (strs2str o (map match2str)) ms;
10.44 +fun pblID_of_match (Matches (pI, _)) = pI
10.45 + | pblID_of_match (NoMatch (pI, _)) = pI;
10.46 +
10.47 +(* 10.03 for Refine_Problem *)
10.48 +datatype match_ =
10.49 + Match_ of Celem.pblID * (( Model.itm list) * ((bool * term) list))
10.50 +| NoMatch_;
10.51 +
10.52 +(* the refined pbt is the last_element Matches in the list *)
10.53 +fun is_matches (Matches _) = true
10.54 + | is_matches _ = false;
10.55 +fun matches_pblID (Matches (pI, _)) = pI
10.56 + | matches_pblID _ = error "matches_pblID: uncovered case in fun.def.";
10.57 +fun refined ms = ((matches_pblID o the o (find_first is_matches) o rev) ms)
10.58 + handle _ => [];
10.59 +fun refined_IDitms ms = ((find_first is_matches) o rev) ms;
10.60 +
10.61 +(* the refined pbt is the last_element Matches in the list, for Refine_Problem, tryrefine *)
10.62 +fun is_matches_ (Match_ _) = true
10.63 + | is_matches_ _ = false;
10.64 +fun refined_ ms = ((find_first is_matches_) o rev) ms;
10.65 +
10.66 +(* check a predicate labelled with indication of incomplete substitution;
10.67 + rls -> (* for eval_true *)
10.68 + bool * (* have _all_ variables(Free) from the model-pattern
10.69 + been substituted by a value from the pattern's environment ?*)
10.70 + term -> (* the precondition *)
10.71 + bool * (* has the precondition evaluated to true *)
10.72 + term (* the precondition (for map) *)
10.73 +*)
10.74 +fun evalprecond _ (false, pre) =
10.75 + (*NOT ALL Free's have been substituted, eg. because of incomplete model*)
10.76 + (false, pre)
10.77 + | evalprecond prls (true, pre) =
10.78 + if Rewrite.eval_true (Celem.assoc_thy "Isac_Knowledge") (* for Pattern.match *)
10.79 + [pre] prls (* pre parsed, prls.thy *)
10.80 + then (true , pre)
10.81 + else (false , pre);
10.82 +
10.83 +fun pre2str (b, t) = pair2str (bool2str b, Rule.term2str t);
10.84 +fun pres2str pres = strs2str' (map (Celem.linefeed o pre2str) pres);
10.85 +
10.86 +(* check preconditions, return true if all true *)
10.87 +fun check_preconds' _ [] _ _ = [] (* empty preconditions are true *)
10.88 + | check_preconds' prls pres pbl _ (* FIXME.WN0308 mvat re-introduce *) =
10.89 + let
10.90 + val env = Model.mk_env pbl;
10.91 + val pres' = map (TermC.subst_atomic_all env) pres;
10.92 + in map (evalprecond prls) pres' end;
10.93 +fun check_preconds _(*thy*) prls pres pbl = check_preconds' prls pres pbl (Model.max_vt pbl);
10.94 +
10.95 +
10.96 +fun common_subthy (thy1, thy2) =
10.97 + if Context.subthy (thy1, thy2) then thy2
10.98 + else if Context.subthy (thy2, thy1) then thy1
10.99 + else Celem.assoc_thy "Isac_Knowledge"
10.100 +
10.101 +end;
11.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
11.2 +++ b/src/Tools/isac/MathEngBasic/specification-elems.sml Sat Oct 26 13:03:16 2019 +0200
11.3 @@ -0,0 +1,112 @@
11.4 +(* Title: Specify-phase: specifying and modeling a problem or a subproblem. The
11.5 + most important types are declared in mstools.sml.
11.6 + TODO: allocate elements of Selem and of Stool appropriately
11.7 + Author: Walther Neuper 991122, Mathias Lehnfeld
11.8 + (c) due to copyright terms
11.9 +*)
11.10 +signature SPECIFY_ELEMENT =
11.11 +sig
11.12 + type fmz
11.13 + type fmz_
11.14 + type result
11.15 + val res2str : term * term list -> string
11.16 + type subs (* substitution as seen by learner. rename stubst_user ["(''bdv'', x)"]*)
11.17 + type sube (* = subs. delete ! = stubst_user *)
11.18 + type subte (* _sub_stitution as _t_erms of _e_qualities: revise ! [bdv = x] *)
11.19 + type subst' (* substitution in isac-programs; rename subst_prog [(bdv, x)] *)
11.20 +(*type subst for rewriting, in Rule (+?Isabelle); rename subst_rew [(bools, x)] *)
11.21 + (* TODO use these types in functions below and elsewhere; rename below according to types *)
11.22 + val subst'_to_sube : subst' -> Rule.cterm' list (* e.g. rename to subst_user_of_prog *)
11.23 + val subst_to_subst' : Rule.subst -> subst'
11.24 + val subst'_to_subst : subst' -> (term * term) list
11.25 + val sube2str : Rule.cterm' list -> string
11.26 + val sube2subst : theory -> Rule.cterm' list -> (term * term) list
11.27 + val sube2subte : Rule.cterm' list -> term list
11.28 + val subs2subst : theory -> Rule.cterm' list -> (term * term) list
11.29 + val subst2sube : (term * term) list -> Rule.cterm' list (* for datatypes.sml *)
11.30 + val subst2subs : (term * term) list -> Rule.cterm' list
11.31 + val subst2subs' : (term * term) list -> (string * string) list
11.32 + val subte2sube : term list -> Rule.cterm' list
11.33 +
11.34 +(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
11.35 + val e_fmz : fmz_ * Celem.spec (* for datatypes.sml *)
11.36 + val e_sube : Rule.cterm' list
11.37 + val e_subs : string list
11.38 + val subte2subst : term list -> (term * term) list
11.39 +(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
11.40 + (* NONE *)
11.41 +( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
11.42 +
11.43 +(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
11.44 +(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
11.45 + (* NONE *)
11.46 +end
11.47 +
11.48 +structure Selem(**): SPECIFY_ELEMENT(**) =
11.49 +struct
11.50 +
11.51 +fun subst2str s =
11.52 + (strs2str o
11.53 + (map (
11.54 + Celem.linefeed o pair2str o (apsnd Rule.term2str) o (apfst Rule.term2str)))) s;
11.55 +type fmz_ = Rule.cterm' list;
11.56 +(* a formalization of an example contains data
11.57 + sufficient for mechanically finding the solution for the example.
11.58 + FIXME.WN051014: dont store fmz = (_,spec) in the PblObj, this is done in origin *)
11.59 +type fmz = fmz_ * Celem.spec;
11.60 +val e_fmz = ([], Celem.e_spec);
11.61 +
11.62 +type result = term * term list
11.63 +fun res2str (t, ts) = pair2str (Rule.term2str t, Rule.terms2str ts); (* for tests only *)
11.64 +
11.65 +type subs = Rule.cterm' list; (* substitution as seen by learner in tactics, in programs, etc.
11.66 + questionable design. rename to stubst_user *)
11.67 +val e_subs = ["(''bdv'', x)"]; (* for tests only *)
11.68 +
11.69 +(* argument type of tac Rewrite_Inst *)
11.70 +type sube = Rule.cterm' list; (* = subs. delete *)
11.71 +val e_sube = []: Rule.cterm' list; (* for tests only *)
11.72 +fun sube2str s = strs2str s;
11.73 +
11.74 +type subte = term list; (* _sub_stitution as _t_erms of _e_qualities: revise ! *)
11.75 +
11.76 +type subst' = term; (* substitution in isac-programs. rename to subst_prog
11.77 + is "(char list * term) list", where term is Free ("xxx", _)
11.78 + e.g. @{term "[(''bdv_1'', x::real), (''bdv_2'', y::real), (''bdv_3'', z::real)]"} *)
11.79 +fun subst'_to_sube sub = (sub
11.80 + |> HOLogic.dest_list
11.81 + |> map HOLogic.dest_prod
11.82 + |> map (fn (e1, e2) => (HOLogic.dest_string e1, Rule.term2str e2))
11.83 + |> map (fn (e1, e2) => "(''" ^ e1 ^ "'', " ^ e2 ^ ")"): Rule.cterm' list)
11.84 + handle TERM _ => raise TERM ("subst'_to_sube: wrong argument ", [sub])
11.85 +fun subst_to_subst' subst = subst
11.86 + |> map (apfst TermC.free2str)
11.87 + |> map (apfst HOLogic.mk_string)
11.88 + |> map HOLogic.mk_prod
11.89 + |> HOLogic.mk_list (HOLogic.mk_prodT (HOLogic.stringT, HOLogic.realT (*FIXME: 'a*)))
11.90 +fun subst'_to_subst t = (t
11.91 + |> HOLogic.dest_list
11.92 + |> map HOLogic.dest_prod
11.93 + |> map (apfst HOLogic.dest_string))
11.94 + |> map (apfst (fn e1 => (TermC.mk_Free (e1, HOLogic.realT))))
11.95 + handle TERM _ => raise TERM ("subst'_to_subst: wrong argument ", [t])
11.96 +val subte2sube = map Rule.term2str;
11.97 +fun subst2subs subst_rew = (subst_rew
11.98 + |> map (apsnd Rule.term2str)
11.99 + |> map (apfst Rule.term2str)
11.100 + |> map (apfst (enclose "''" "''")))
11.101 + |> map pair2str
11.102 + handle TERM _ => raise TERM ("subst2subs: wrong argument " ^ subst2str subst_rew, [])
11.103 +fun subst2sube subst = map Rule.term2str (map HOLogic.mk_eq subst)
11.104 +val subst2subs' = map ((apfst Rule.term2str) o (apsnd Rule.term2str));
11.105 +fun subs2subst thy subs = (subs
11.106 + |> map (TermC.parse_patt thy(*FIXME use context, get type of snd (e.g. x,y,z), copy to fst*))
11.107 + |> map TermC.isapair2pair
11.108 + |> map (apfst HOLogic.dest_string)
11.109 + |> map (apfst (fn str => (TermC.mk_Free (str, HOLogic.realT)))))
11.110 + handle TERM _ => raise TERM ("subs2subst: wrong argument " ^ strs2str' subs, [])
11.111 +fun sube2subst thy s = map (TermC.dest_equals o (TermC.parse_patt thy)) s;
11.112 +val sube2subte = map TermC.str2term;
11.113 +val subte2subst = map HOLogic.dest_eq;
11.114 +
11.115 +end
12.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
12.2 +++ b/src/Tools/isac/MathEngBasic/tactic.sml Sat Oct 26 13:03:16 2019 +0200
12.3 @@ -0,0 +1,448 @@
12.4 +(* Title: Tactics; tac_ for interaction with frontend, input for internal use.
12.5 + Author: Walther Neuper 170121
12.6 + (c) due to copyright terms
12.7 +
12.8 +regular expression for search:
12.9 +
12.10 +Add_Find|Add_Given|Add_Relation|Apply_Assumption|Apply_Method|Begin_Sequ|Begin_Trans|Split_And|Split_Or|Split_Intersect|Conclude_And|Conclude_Or|Collect_Trues|End_Sequ|End_Trans|End_Ruleset|End_Subproblem|End_Intersect|End_Proof|CAScmd|Calculate|Check_Postcond|Check_elementwise|Del_Find|Del_Given|Del_Relation|Derive|Detail_Set|Detail_Set_Inst|End_Detail|Empty_Tac|Free_Solve|Init_Proof|Model_Problem Or_to_List|Refine_Problem|Refine_Tacitly| Rewrite|Rewrite_Asm|Rewrite_Inst|Rewrite_Set|Rewrite_Set_Inst|Specify_Method|Specify_Problem|Specify_Theory|Subproblem|Substitute|Tac|Take|Take_Inst
12.11 +
12.12 +*)
12.13 +signature TACTIC =
12.14 +sig
12.15 + datatype T =
12.16 + Add_Find' of Rule.cterm' * Model.itm list | Add_Given' of Rule.cterm' * Model.itm list
12.17 + | Add_Relation' of Rule.cterm' * Model.itm list
12.18 + | Apply_Assumption' of term list * term
12.19 + | Apply_Method' of Celem.metID * term option * Istate.T * Proof.context
12.20 +
12.21 + | Begin_Sequ' | Begin_Trans' of term
12.22 + | Split_And' of term | Split_Or' of term | Split_Intersect' of term
12.23 + | Conclude_And' of term | Conclude_Or' of term | Collect_Trues' of term
12.24 + | End_Sequ' | End_Trans' of Selem.result
12.25 + | End_Ruleset' of term | End_Subproblem' of term | End_Intersect' of term | End_Proof''
12.26 +
12.27 + | CAScmd' of term
12.28 + | Calculate' of Rule.theory' * string * term * (term * Celem.thm')
12.29 + | Check_Postcond' of Celem.pblID * Selem.result
12.30 + | Check_elementwise' of term * Rule.cterm' * Selem.result
12.31 + | Del_Find' of Rule.cterm' | Del_Given' of Rule.cterm' | Del_Relation' of Rule.cterm'
12.32 +
12.33 + | Derive' of Rule.rls
12.34 + | Detail_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
12.35 + | Detail_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
12.36 + | End_Detail' of Selem.result
12.37 +
12.38 + | Empty_Tac_
12.39 + | Free_Solve'
12.40 +
12.41 + | Init_Proof' of Rule.cterm' list * Celem.spec
12.42 + | Model_Problem' of Celem.pblID * Model.itm list * Model.itm list
12.43 + | Or_to_List' of term * term
12.44 + | Refine_Problem' of Celem.pblID * (Model.itm list * (bool * term) list)
12.45 + | Refine_Tacitly' of Celem.pblID * Celem.pblID * Rule.domID * Celem.metID * Model.itm list
12.46 +
12.47 + | Rewrite' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
12.48 + | Rewrite_Asm' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
12.49 + | Rewrite_Inst' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Rule.subst * Celem.thm'' * term * Selem.result
12.50 + | Rewrite_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
12.51 + | Rewrite_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
12.52 +
12.53 + | Specify_Method' of Celem.metID * Model.ori list * Model.itm list
12.54 + | Specify_Problem' of Celem.pblID * (bool * (Model.itm list * (bool * term) list))
12.55 + | Specify_Theory' of Rule.domID
12.56 + | Subproblem' of Celem.spec * Model.ori list * term * Selem.fmz_ * Proof.context * term
12.57 + | Substitute' of Rule.rew_ord_ * Rule.rls * Selem.subte * term * term
12.58 + | Tac_ of theory * string * string * string
12.59 + | Take' of term | Take_Inst' of term
12.60 + val tac_2str : T -> string
12.61 +
12.62 + datatype input =
12.63 + Add_Find of Rule.cterm' | Add_Given of Rule.cterm' | Add_Relation of Rule.cterm'
12.64 + | Apply_Assumption of Rule.cterm' list
12.65 + | Apply_Method of Celem.metID
12.66 + (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
12.67 + | Begin_Sequ | Begin_Trans
12.68 + | Split_And | Split_Or | Split_Intersect
12.69 + | Conclude_And | Conclude_Or | Collect_Trues
12.70 + | End_Sequ | End_Trans
12.71 + | End_Ruleset | End_Subproblem | End_Intersect | End_Proof'
12.72 + (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
12.73 + | CAScmd of Rule.cterm'
12.74 + | Calculate of string
12.75 + | Check_Postcond of Celem.pblID
12.76 + | Check_elementwise of Rule.cterm'
12.77 + | Del_Find of Rule.cterm' | Del_Given of Rule.cterm' | Del_Relation of Rule.cterm'
12.78 +
12.79 + | Derive of Rule.rls'
12.80 + | Detail_Set of Rule.rls'
12.81 + | Detail_Set_Inst of Selem.subs * Rule.rls'
12.82 + | End_Detail
12.83 +
12.84 + | Empty_Tac
12.85 + | Free_Solve
12.86 +
12.87 + | Init_Proof of Rule.cterm' list * Celem.spec
12.88 + | Model_Problem
12.89 + | Or_to_List
12.90 + | Refine_Problem of Celem.pblID
12.91 + | Refine_Tacitly of Celem.pblID
12.92 +
12.93 + | Rewrite of Celem.thm''
12.94 + | Rewrite_Asm of Celem.thm''
12.95 + | Rewrite_Inst of Selem.subs * Celem.thm''
12.96 + | Rewrite_Set of Rule.rls'
12.97 + | Rewrite_Set_Inst of Selem.subs * Rule.rls'
12.98 +
12.99 + | Specify_Method of Celem.metID
12.100 + | Specify_Problem of Celem.pblID
12.101 + | Specify_Theory of Rule.domID
12.102 + | Subproblem of Rule.domID * Celem.pblID
12.103 +
12.104 + | Substitute of Selem.sube
12.105 + | Tac of string
12.106 + | Take of Rule.cterm' | Take_Inst of Rule.cterm'
12.107 + val tac2str : input -> string
12.108 +
12.109 + val eq_tac : input * input -> bool (* for script.sml *)
12.110 + val is_empty_tac : input -> bool (* also for tests *)
12.111 + val is_rewtac : input -> bool (* for interface.sml *)
12.112 + val is_rewset : input -> bool (* for mathengine.sml *)
12.113 + val rls_of : input -> Rule.rls' (* for solve.sml *)
12.114 + val tac2IDstr : input -> string
12.115 + val rule2tac : theory -> (term * term) list -> Rule.rule -> input (* for rewtools.sml *)
12.116 +(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
12.117 + (* NONE *)
12.118 +(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
12.119 + (* NONE *)
12.120 +( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
12.121 +
12.122 +(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
12.123 + (* NONE *)
12.124 +end
12.125 +
12.126 +structure Tactic(**): TACTIC(**) =
12.127 +struct
12.128 +
12.129 +(* tactics for user at front-end.
12.130 + input propagates the construction of the calc-tree;
12.131 + there are
12.132 + (a) 'specsteps' for the specify-phase, and others for the solve-phase
12.133 + (b) those of the solve-phase are 'initac's and others;
12.134 + initacs start with a formula different from the preceding formula.
12.135 + see 'type tac_' for the internal representation of tactics
12.136 +*)
12.137 +datatype input =
12.138 + Add_Find of Rule.cterm' | Add_Given of Rule.cterm' | Add_Relation of Rule.cterm'
12.139 + | Apply_Assumption of Rule.cterm' list
12.140 + | Apply_Method of Celem.metID
12.141 + (* creates an "istate" in PblObj.env; in case of "init_form"
12.142 + creates a formula at ((lev_on o lev_dn) p, Frm) and in this "ppobj.loc"
12.143 + a "SOME istate" at fst of "loc".
12.144 + As each step (in the solve-phase) has a resulting formula (at the front-end)
12.145 + Apply_Method also does the 1st step in the script (an "initac") if there is no "init_form" *)
12.146 + (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
12.147 + | Begin_Sequ | Begin_Trans
12.148 + | Split_And | Split_Or | Split_Intersect
12.149 + | Conclude_And | Conclude_Or | Collect_Trues
12.150 + | End_Sequ | End_Trans
12.151 + | End_Ruleset | End_Subproblem (* WN0509 drop *) | End_Intersect | End_Proof'
12.152 + (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
12.153 + | CAScmd of Rule.cterm'
12.154 + | Calculate of string
12.155 + | Check_Postcond of Celem.pblID
12.156 + | Check_elementwise of Rule.cterm'
12.157 + | Del_Find of Rule.cterm' | Del_Given of Rule.cterm' | Del_Relation of Rule.cterm'
12.158 +
12.159 + | Derive of Rule.rls' (* WN0509 drop *)
12.160 + | Detail_Set of Rule.rls' (* WN0509 drop *)
12.161 + | Detail_Set_Inst of Selem.subs * Rule.rls' (* WN0509 drop *)
12.162 + | End_Detail (* WN0509 drop *)
12.163 +
12.164 + | Empty_Tac
12.165 + | Free_Solve
12.166 +
12.167 + | Init_Proof of Rule.cterm' list * Celem.spec
12.168 + | Model_Problem
12.169 + | Or_to_List
12.170 + | Refine_Problem of Celem.pblID
12.171 + | Refine_Tacitly of Celem.pblID
12.172 +
12.173 + (* rewrite-tactics can transport a (thmID, thm) to and (!) from the java-front-end
12.174 + because there all the thms are present with both (thmID, thm)
12.175 + (where user-views can show both or only one of (thmID, thm)),
12.176 + and thm is created from ThmID by assoc_thm'' when entering isabisac *)
12.177 + | Rewrite of Celem.thm''
12.178 + | Rewrite_Asm of Celem.thm''
12.179 + | Rewrite_Inst of Selem.subs * Celem.thm''
12.180 + | Rewrite_Set of Rule.rls'
12.181 + | Rewrite_Set_Inst of Selem.subs * Rule.rls'
12.182 +
12.183 + | Specify_Method of Celem.metID
12.184 + | Specify_Problem of Celem.pblID
12.185 + | Specify_Theory of Rule.domID
12.186 + | Subproblem of Rule.domID * Celem.pblID (* WN0509 drop *)
12.187 +
12.188 + | Substitute of Selem.sube
12.189 + | Tac of string (* WN0509 drop *)
12.190 + | Take of Rule.cterm' | Take_Inst of Rule.cterm'
12.191 +
12.192 +fun tac2str ma = case ma of
12.193 + Init_Proof (ppc, spec) =>
12.194 + "Init_Proof "^(pair2str (strs2str ppc, Celem.spec2str spec))
12.195 + | Model_Problem => "Model_Problem "
12.196 + | Refine_Tacitly pblID => "Refine_Tacitly " ^ strs2str pblID
12.197 + | Refine_Problem pblID => "Refine_Problem " ^ strs2str pblID
12.198 + | Add_Given cterm' => "Add_Given " ^ cterm'
12.199 + | Del_Given cterm' => "Del_Given " ^ cterm'
12.200 + | Add_Find cterm' => "Add_Find " ^ cterm'
12.201 + | Del_Find cterm' => "Del_Find " ^ cterm'
12.202 + | Add_Relation cterm' => "Add_Relation " ^ cterm'
12.203 + | Del_Relation cterm' => "Del_Relation " ^ cterm'
12.204 +
12.205 + | Specify_Theory domID => "Specify_Theory " ^ quote domID
12.206 + | Specify_Problem pblID => "Specify_Problem " ^ strs2str pblID
12.207 + | Specify_Method metID => "Specify_Method " ^ strs2str metID
12.208 + | Apply_Method metID => "Apply_Method " ^ strs2str metID
12.209 + | Check_Postcond pblID => "Check_Postcond " ^ strs2str pblID
12.210 + | Free_Solve => "Free_Solve"
12.211 +
12.212 + | Rewrite_Inst (subs, (id, thm)) =>
12.213 + "Rewrite_Inst " ^ (pair2str (subs2str subs, spair2str (id, thm |> Thm.prop_of |> Rule.term2str)))
12.214 + | Rewrite (id, thm) => "Rewrite " ^ spair2str (id, thm |> Thm.prop_of |> Rule.term2str)
12.215 + | Rewrite_Asm (id, thm) => "Rewrite_Asm " ^ spair2str (id, thm |> Thm.prop_of |> Rule.term2str)
12.216 + | Rewrite_Set_Inst (subs, rls) =>
12.217 + "Rewrite_Set_Inst " ^ pair2str (subs2str subs, quote rls)
12.218 + | Rewrite_Set rls => "Rewrite_Set " ^ quote rls
12.219 + | Detail_Set rls => "Detail_Set " ^ quote rls
12.220 + | Detail_Set_Inst (subs, rls) => "Detail_Set_Inst " ^ pair2str (subs2str subs, quote rls)
12.221 + | End_Detail => "End_Detail"
12.222 + | Derive rls' => "Derive " ^ rls'
12.223 + | Calculate op_ => "Calculate " ^ op_
12.224 + | Substitute sube => "Substitute " ^ Selem.sube2str sube
12.225 + | Apply_Assumption ct's => "Apply_Assumption " ^ strs2str ct's
12.226 +
12.227 + | Take cterm' => "Take " ^ quote cterm'
12.228 + | Take_Inst cterm' => "Take_Inst " ^ quote cterm'
12.229 + | Subproblem (domID, pblID) => "Subproblem " ^ pair2str (domID, strs2str pblID)
12.230 + | End_Subproblem => "End_Subproblem"
12.231 + | CAScmd cterm' => "CAScmd " ^ quote cterm'
12.232 +
12.233 + | Check_elementwise cterm'=> "Check_elementwise " ^ quote cterm'
12.234 + | Or_to_List => "Or_to_List "
12.235 + | Collect_Trues => "Collect_Trues"
12.236 +
12.237 + | Empty_Tac => "Empty_Tac"
12.238 + | Tac string => "Tac " ^ string
12.239 + | End_Proof' => "input End_Proof'"
12.240 + | _ => "tac2str not impl. for ?!";
12.241 +
12.242 +fun is_empty_tac input = case input of Empty_Tac => true | _ => false
12.243 +
12.244 +fun eq_tac (Rewrite (id1, _), Rewrite (id2, _)) = id1 = id2
12.245 + | eq_tac (Rewrite_Inst (_, (id1, _)), Rewrite_Inst (_, (id2, _))) = id1 = id2
12.246 + | eq_tac (Rewrite_Set id1, Rewrite_Set id2) = id1 = id2
12.247 + | eq_tac (Rewrite_Set_Inst (_, id1), Rewrite_Set_Inst (_, id2)) = id1 = id2
12.248 + | eq_tac (Calculate id1, Calculate id2) = id1 = id2
12.249 + | eq_tac _ = false
12.250 +
12.251 +fun is_rewset (Rewrite_Set_Inst _) = true
12.252 + | is_rewset (Rewrite_Set _) = true
12.253 + | is_rewset _ = false;
12.254 +fun is_rewtac (Rewrite _) = true
12.255 + | is_rewtac (Rewrite_Inst _) = true
12.256 + | is_rewtac (Rewrite_Asm _) = true
12.257 + | is_rewtac input = is_rewset input;
12.258 +
12.259 +fun tac2IDstr ma = case ma of
12.260 + Model_Problem => "Model_Problem"
12.261 + | Refine_Tacitly _ => "Refine_Tacitly"
12.262 + | Refine_Problem _ => "Refine_Problem"
12.263 + | Add_Given _ => "Add_Given"
12.264 + | Del_Given _ => "Del_Given"
12.265 + | Add_Find _ => "Add_Find"
12.266 + | Del_Find _ => "Del_Find"
12.267 + | Add_Relation _ => "Add_Relation"
12.268 + | Del_Relation _ => "Del_Relation"
12.269 +
12.270 + | Specify_Theory _ => "Specify_Theory"
12.271 + | Specify_Problem _ => "Specify_Problem"
12.272 + | Specify_Method _ => "Specify_Method"
12.273 + | Apply_Method _ => "Apply_Method"
12.274 + | Check_Postcond _ => "Check_Postcond"
12.275 + | Free_Solve => "Free_Solve"
12.276 +
12.277 + | Rewrite_Inst _ => "Rewrite_Inst"
12.278 + | Rewrite _ => "Rewrite"
12.279 + | Rewrite_Asm _ => "Rewrite_Asm"
12.280 + | Rewrite_Set_Inst _ => "Rewrite_Set_Inst"
12.281 + | Rewrite_Set _ => "Rewrite_Set"
12.282 + | Detail_Set _ => "Detail_Set"
12.283 + | Detail_Set_Inst _ => "Detail_Set_Inst"
12.284 + | Derive _ => "Derive "
12.285 + | Calculate _ => "Calculate "
12.286 + | Substitute _ => "Substitute"
12.287 + | Apply_Assumption _ => "Apply_Assumption"
12.288 +
12.289 + | Take _ => "Take"
12.290 + | Take_Inst _ => "Take_Inst"
12.291 + | Subproblem _ => "Subproblem"
12.292 + | End_Subproblem => "End_Subproblem"
12.293 + | CAScmd _ => "CAScmd"
12.294 +
12.295 + | Check_elementwise _ => "Check_elementwise"
12.296 + | Or_to_List => "Or_to_List "
12.297 + | Collect_Trues => "Collect_Trues"
12.298 +
12.299 + | Empty_Tac => "Empty_Tac"
12.300 + | Tac _ => "Tac "
12.301 + | End_Proof' => "End_Proof'"
12.302 + | _ => "tac2str not impl. for ?!";
12.303 +
12.304 +fun rls_of (Rewrite_Set_Inst (_, rls)) = rls
12.305 + | rls_of (Rewrite_Set rls) = rls
12.306 + | rls_of input = error ("rls_of: called with input \"" ^ tac2IDstr input ^ "\"");
12.307 +
12.308 +fun rule2tac thy _ (Rule.Calc (opID, _)) = Calculate (assoc_calc thy opID)
12.309 + | rule2tac _ [] (Rule.Thm thm'') = Rewrite thm''
12.310 + | rule2tac _ subst (Rule.Thm thm'') =
12.311 + Rewrite_Inst (Selem.subst2subs subst, thm'')
12.312 + | rule2tac _ [] (Rule.Rls_ rls) = Rewrite_Set (Rule.id_rls rls)
12.313 + | rule2tac _ subst (Rule.Rls_ rls) =
12.314 + Rewrite_Set_Inst (Selem.subst2subs subst, (Rule.id_rls rls))
12.315 + | rule2tac _ _ rule =
12.316 + error ("rule2tac: called with \"" ^ Rule.rule2str rule ^ "\"");
12.317 +
12.318 +(* tactics for for internal use, compare "input" for user at the front-end.
12.319 + tac_ contains results from check in 'fun applicable_in'.
12.320 + This is useful for costly results, e.g. from rewriting;
12.321 + however, these results might be changed by Scripts like
12.322 + " eq = (Rewrite_Set ''ansatz_rls'' False) eql;" ^
12.323 + " eq = (Rewrite_Set equival_trans False) eq;" ^
12.324 + TODO.WN120106 ANALOGOUSLY TO Substitute':
12.325 + So tac_ contains the term t the result was calculated from
12.326 + in order to compare t with t' possibly changed by "Expr "
12.327 + and re-calculate result if t<>t'
12.328 + TODO.WN161219: replace *every* cterm' by term
12.329 +*)
12.330 + datatype T =
12.331 + Add_Find' of Rule.cterm' * Model.itm list | Add_Given' of Rule.cterm' * Model.itm list
12.332 + | Add_Relation' of Rule.cterm' * Model.itm list
12.333 + | Apply_Assumption' of term list * term
12.334 + | Apply_Method' of Celem.metID * term option * Istate.T * Proof.context
12.335 + (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
12.336 + | Begin_Sequ' | Begin_Trans' of term
12.337 + | Split_And' of term | Split_Or' of term | Split_Intersect' of term
12.338 + | Conclude_And' of term | Conclude_Or' of term | Collect_Trues' of term
12.339 + | End_Sequ' | End_Trans' of Selem.result
12.340 + | End_Ruleset' of term | End_Subproblem' of term | End_Intersect' of term | End_Proof''
12.341 + (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
12.342 + | CAScmd' of term
12.343 + | Calculate' of Rule.theory' * string * term * (term * Celem.thm')
12.344 + | Check_Postcond' of Celem.pblID *
12.345 + Selem.result (* returnvalue of script in solve *)
12.346 + | Check_elementwise' of (*special case:*)
12.347 + term * (* (1) the current formula: [x=1,x=...] *)
12.348 + string * (* (2) the pred from Check_elementwise *)
12.349 + Selem.result (* (3) composed from (1) and (2): {x. pred} *)
12.350 + | Del_Find' of Rule.cterm' | Del_Given' of Rule.cterm' | Del_Relation' of Rule.cterm'
12.351 +
12.352 + | Derive' of Rule.rls
12.353 + | Detail_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
12.354 + | Detail_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
12.355 + | End_Detail' of Selem.result
12.356 +
12.357 + | Empty_Tac_
12.358 + | Free_Solve'
12.359 +
12.360 + | Init_Proof' of Rule.cterm' list * Celem.spec
12.361 + | Model_Problem' of Celem.pblID *
12.362 + Model.itm list * (* the 'untouched' pbl *)
12.363 + Model.itm list (* the casually completed met *)
12.364 + | Or_to_List' of term * term
12.365 + | Refine_Problem' of Celem.pblID * (Model.itm list * (bool * term) list)
12.366 + | Refine_Tacitly' of
12.367 + Celem.pblID * (* input*)
12.368 + Celem.pblID * (* the refined from applicable_in *)
12.369 + Rule.domID * (* from new pbt?! filled in specify *)
12.370 + Celem.metID * (* from new pbt?! filled in specify *)
12.371 + Model.itm list (* drop ! 9.03: remains [] for Model_Problem recognizing its activation *)
12.372 + | Rewrite' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
12.373 + | Rewrite_Asm' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
12.374 + | Rewrite_Inst' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Rule.subst * Celem.thm'' * term * Selem.result
12.375 + | Rewrite_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
12.376 + | Rewrite_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
12.377 +
12.378 + | Specify_Method' of Celem.metID * Model.ori list * Model.itm list
12.379 + | Specify_Problem' of Celem.pblID *
12.380 + (bool * (* matches *)
12.381 + (Model.itm list * (* ppc *)
12.382 + (bool * term) list)) (* preconditions *)
12.383 + | Specify_Theory' of Rule.domID
12.384 + | Subproblem' of
12.385 + Celem.spec *
12.386 + (Model.ori list) * (* filled in associate Subproblem' *)
12.387 + term * (* filled -"-, headline of calc-head *)
12.388 + Selem.fmz_ *
12.389 + Proof.context * (* DEPRECATED shifted into loc for all ppobj *)
12.390 + term (* Subproblem (thyID, pbl) OR cascmd *)
12.391 + | Substitute' of
12.392 + Rule.rew_ord_ * (* for re-calculation *)
12.393 + Rule.rls * (* for re-calculation *)
12.394 + Selem.subte * (* the 'substitution': terms of type bool *)
12.395 + term * (* to be substituted into *)
12.396 + term (* resulting from the substitution *)
12.397 + | Tac_ of theory * string * string * string
12.398 + | Take' of term | Take_Inst' of term
12.399 +
12.400 +fun tac_2str ma = case ma of
12.401 + Init_Proof' (ppc, spec) => "Init_Proof' " ^ pair2str (strs2str ppc, Celem.spec2str spec)
12.402 + | Model_Problem' (pblID, _, _) => "Model_Problem' " ^ strs2str pblID
12.403 + | Refine_Tacitly'(p, prefin, domID, metID, _) => "Refine_Tacitly' (" ^ strs2str p ^ ", " ^
12.404 + strs2str prefin ^ ", " ^ domID ^ ", " ^ strs2str metID ^ ", pbl-itms)"
12.405 + | Refine_Problem' _ => "Refine_Problem' (" ^ (*matchs2str ms*)"..." ^ ")"
12.406 + | Add_Given' _ => "Add_Given' "(*^cterm'*)
12.407 + | Del_Given' _ => "Del_Given' "(*^cterm'*)
12.408 + | Add_Find' _ => "Add_Find' "(*^cterm'*)
12.409 + | Del_Find' _ => "Del_Find' "(*^cterm'*)
12.410 + | Add_Relation' _ => "Add_Relation' "(*^cterm'*)
12.411 + | Del_Relation' _ => "Del_Relation' "(*^cterm'*)
12.412 +
12.413 + | Specify_Theory' domID => "Specify_Theory' " ^ quote domID
12.414 + | Specify_Problem' (pI, (ok, _)) => "Specify_Problem' " ^
12.415 + spair2str (strs2str pI, spair2str (bool2str ok, spair2str ("itms2str_ itms", "items2str pre")))
12.416 + | Specify_Method' (pI, oris, _) => "Specify_Method' (" ^
12.417 + Celem.metID2str pI ^ ", " ^ Model.oris2str oris ^ ", )"
12.418 +
12.419 + | Apply_Method' (metID, _, _, _) => "Apply_Method' " ^ strs2str metID
12.420 + | Check_Postcond' (pblID, (scval, asm)) => "Check_Postcond' " ^
12.421 + (spair2str (strs2str pblID, spair2str (Rule.term2str scval, Rule.terms2str asm)))
12.422 +
12.423 + | Free_Solve' => "Free_Solve'"
12.424 +
12.425 + | Rewrite_Inst' (*subs,thm'*) _ => "Rewrite_Inst' "(*^(pair2str (subs2str subs, spair2str thm'))*)
12.426 + | Rewrite' _(*thm'*) => "Rewrite' "(*^(spair2str thm')*)
12.427 + | Rewrite_Asm' _(*thm'*) => "Rewrite_Asm' "(*^(spair2str thm')*)
12.428 + | Rewrite_Set_Inst' _(*subs,thm'*) => "Rewrite_Set_Inst' "(*^(pair2str (subs2str subs, quote rls))*)
12.429 + | Rewrite_Set' (thy', pasm, rls', f, (f', asm)) => "Rewrite_Set' (" ^ thy' ^ "," ^ bool2str pasm ^
12.430 + "," ^ Rule.id_rls rls' ^ "," ^ Rule.term2str f ^ ",(" ^ Rule.term2str f' ^ "," ^ Rule.terms2str asm ^ "))"
12.431 + | End_Detail' _ => "End_Detail' xxx"
12.432 + | Detail_Set' _ => "Detail_Set' xxx"
12.433 + | Detail_Set_Inst' _ => "Detail_Set_Inst' xxx"
12.434 +
12.435 + | Derive' rls => "Derive' " ^ Rule.id_rls rls
12.436 + | Calculate' _ => "Calculate' "
12.437 + | Substitute' _ => "Substitute' "(*^(subs2str subs)*)
12.438 + | Apply_Assumption' _(* ct's*) => "Apply_Assumption' "(*^(strs2str ct's)*)
12.439 +
12.440 + | Take' _(*cterm'*) => "Take' "(*^(quote cterm' )*)
12.441 + | Take_Inst' _(*cterm'*) => "Take_Inst' "(*^(quote cterm' )*)
12.442 + | Subproblem' _(*(spec, oris, _, _, _, pbl_form)*) =>
12.443 + "Subproblem' "(*^(pair2str (domID, strs2str ,))*)
12.444 + | End_Subproblem' _ => "End_Subproblem'"
12.445 + | CAScmd' _(*cterm'*) => "CAScmd' "(*^(quote cterm')*)
12.446 +
12.447 + | Empty_Tac_ => "Empty_Tac_"
12.448 + | Tac_ (_, form, id, result) => "Tac_ (thy," ^ form ^ "," ^ id ^ "," ^ result ^ ")"
12.449 + | _ => "tac_2str not impl. for arg";
12.450 +
12.451 +end
13.1 --- a/src/Tools/isac/Specify/Specify.thy Fri Oct 25 16:07:15 2019 +0200
13.2 +++ b/src/Tools/isac/Specify/Specify.thy Sat Oct 26 13:03:16 2019 +0200
13.3 @@ -4,18 +4,9 @@
13.4 *)
13.5
13.6 theory Specify
13.7 -imports "~~/src/Tools/isac/ProgLang/ProgLang" Input_Descript
13.8 +imports "~~/src/Tools/isac/MathEngBasic/MathEngBasic"
13.9 begin
13.10 (* removed all warnings here, only "handle _" remains *)
13.11 - ML_file model.sml
13.12 - ML_file mstools.sml
13.13 - ML_file "specification-elems.sml"
13.14 - ML_file istate.sml
13.15 - ML_file tactic.sml
13.16 - ML_file "ctree-basic.sml" (*shift to base in common with Interpret*)
13.17 - ML_file "ctree-access.sml"(*shift to base in common with Interpret*)
13.18 - ML_file "ctree-navi.sml" (*shift to base in common with Interpret*)
13.19 - ML_file ctree.sml (*shift to base in common with Interpret*)
13.20 ML_file ptyps.sml
13.21 ML_file generate.sml
13.22 ML_file calchead.sml
14.1 --- a/src/Tools/isac/Specify/ctree-access.sml Fri Oct 25 16:07:15 2019 +0200
14.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
14.3 @@ -1,273 +0,0 @@
14.4 -(* Title: read and write access to the calctree
14.5 - Author: Walther Neuper 2017
14.6 - (c) due to copyright terms
14.7 -*)
14.8 -signature CALC_TREE_ACCESS =
14.9 -sig
14.10 -
14.11 - val get_last_formula: CTbasic.state -> term
14.12 - val update_branch : CTbasic.ctree -> CTbasic.pos -> CTbasic.branch -> CTbasic.ctree
14.13 - val update_ctxt : CTbasic.ctree -> CTbasic.pos -> Proof.context -> CTbasic.ctree
14.14 - val update_env : CTbasic.ctree -> CTbasic.pos -> (Istate.T * Proof.context) option -> CTbasic.ctree
14.15 - val update_domID : CTbasic.ctree -> CTbasic.pos -> Rule.domID -> CTbasic.ctree
14.16 - val update_met : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =vvv= ? *)
14.17 - val update_metppc : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =^^^= ? *)
14.18 - val update_metID : CTbasic.ctree -> CTbasic.pos -> Celem.metID -> CTbasic.ctree
14.19 - val update_pbl : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =vvv= ? *)
14.20 - val update_pblppc : CTbasic.ctree -> CTbasic.pos -> Model.itm list -> CTbasic.ctree (* =^^^= ? *)
14.21 - val update_pblID : CTbasic.ctree -> CTbasic.pos -> Celem.pblID -> CTbasic.ctree
14.22 - val update_oris : CTbasic.ctree -> CTbasic.pos -> Model.ori list -> CTbasic.ctree
14.23 - val update_orispec : CTbasic.ctree -> CTbasic.pos -> Celem.spec -> CTbasic.ctree
14.24 - val update_spec : CTbasic.ctree -> CTbasic.pos -> Celem.spec -> CTbasic.ctree
14.25 - val update_tac : CTbasic.ctree -> CTbasic.pos -> Tactic.input -> CTbasic.ctree
14.26 -
14.27 - val upd_istate_ctxt : CTbasic.state -> Istate.T * Proof.context -> CTbasic.ctree
14.28 - val upd_istate : CTbasic.state -> Istate.T -> CTbasic.ctree
14.29 - val upd_ctxt : CTbasic.state ->Proof.context -> CTbasic.ctree
14.30 -
14.31 - val cappend_form : CTbasic.ctree -> CTbasic.pos -> Istate.T * Proof.context -> term ->
14.32 - CTbasic.ctree * CTbasic.pos' list
14.33 - val cappend_problem : CTbasic.ctree -> CTbasic.pos -> Istate.T * Proof.context ->
14.34 - Selem.fmz -> Model.ori list * Celem.spec * term -> CTbasic.ctree * CTbasic.pos' list
14.35 - val append_result : CTbasic.ctree -> CTbasic.pos -> Istate.T * Proof.context ->
14.36 - Selem.result -> CTbasic.ostate -> CTbasic.ctree * 'a list
14.37 - val append_atomic : (* for solve.sml *)
14.38 - CTbasic.pos -> Istate.T * Proof.context -> term -> Tactic.input -> Selem.result ->
14.39 - CTbasic.ostate -> CTbasic.ctree -> CTbasic.ctree
14.40 - val cappend_atomic : CTbasic.ctree -> CTbasic.pos -> Istate.T * Proof.context -> term ->
14.41 - Tactic.input -> Selem.result -> CTbasic.ostate -> CTbasic.ctree * CTbasic.pos' list
14.42 -(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
14.43 - val cappend_parent : CTbasic.ctree -> int list -> Istate.T * Proof.context -> term ->
14.44 - Tactic.input -> CTbasic.branch -> CTbasic.ctree * CTbasic.pos' list
14.45 -(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
14.46 - val update_loc' : CTbasic.ctree -> CTbasic.pos ->
14.47 - (Istate.T * Proof.context) option * (Istate.T * Proof.context) option -> CTbasic.ctree
14.48 - val append_problem : int list -> Istate.T * Proof.context -> Selem.fmz ->
14.49 - Model.ori list * Celem.spec * term -> CTbasic.ctree -> CTbasic.ctree
14.50 -( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
14.51 -end
14.52 -(**)
14.53 -structure CTaccess(**): CALC_TREE_ACCESS(**) =
14.54 -struct
14.55 -(**)
14.56 -open CTbasic
14.57 -
14.58 -fun get_last_formula (pt, (p, _)) =
14.59 - let
14.60 - val res = get_obj g_res pt p
14.61 - in
14.62 - if res = Rule.e_term
14.63 - then get_obj g_form pt p
14.64 - else res
14.65 - end
14.66 -
14.67 -(* for use by appl_obj *)
14.68 -fun repl_pbl x (PblObj {cell, origin, fmz, spec, probl = _, meth, ctxt, env, loc,
14.69 - branch, result, ostate}) =
14.70 - PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl= x, meth = meth,
14.71 - ctxt = ctxt, env = env, loc = loc, branch = branch, result = result, ostate = ostate}
14.72 - | repl_pbl _ _ = raise PTREE "repl_pbl takes no PrfObj";
14.73 -fun repl_met x (PblObj {cell, origin, fmz, spec, probl, meth = _, ctxt, env, loc,
14.74 - branch, result, ostate}) =
14.75 - PblObj {cell = cell, origin = origin, fmz= fmz, spec = spec, probl = probl,
14.76 - meth = x, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
14.77 - ostate = ostate}
14.78 - | repl_met _ _ = raise PTREE "repl_pbl takes no PrfObj";
14.79 -fun repl_spec x (PblObj {cell, origin, fmz, spec = _, probl, meth, ctxt, env, loc,
14.80 - branch, result, ostate}) =
14.81 - PblObj {cell = cell, origin = origin, fmz = fmz, spec = x, probl = probl,
14.82 - meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
14.83 - ostate = ostate}
14.84 - | repl_spec _ _ = raise PTREE "repl_domID takes no PrfObj";
14.85 -fun repl_domID x (PblObj {cell, origin, fmz, spec = (_, p, m), probl, meth, ctxt, env, loc,
14.86 - branch, result, ostate}) =
14.87 - PblObj {cell = cell, origin = origin, fmz = fmz, spec= (x, p, m), probl = probl,
14.88 - meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
14.89 - ostate = ostate}
14.90 - | repl_domID _ _ = raise PTREE "repl_domID takes no PrfObj";
14.91 -fun repl_pblID x (PblObj {cell, origin, fmz, spec= (d, _, m), probl, meth, ctxt, env, loc,
14.92 - branch, result, ostate}) =
14.93 - PblObj {cell = cell, origin = origin, fmz = fmz, spec= (d, x, m), probl = probl,
14.94 - meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
14.95 - ostate = ostate}
14.96 - | repl_pblID _ _ = raise PTREE "repl_pblID takes no PrfObj";
14.97 -fun repl_metID x (PblObj {cell, origin, fmz, spec = (d, p,_), probl, meth, ctxt, env, loc,
14.98 - branch, result, ostate}) =
14.99 - PblObj {cell = cell, origin = origin, fmz = fmz, spec = (d, p, x), probl = probl,
14.100 - meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
14.101 - ostate = ostate}
14.102 - | repl_metID _ _ = raise PTREE "repl_metID takes no PrfObj";
14.103 -fun repl_result l f' s (PrfObj {cell, form, tac, loc = _, branch, result = _ , ostate = _}) =
14.104 - PrfObj {cell = cell, form = form, tac = tac, loc = l, branch = branch, result = f', ostate = s}
14.105 - | repl_result l f' s (PblObj {cell, origin, fmz, spec, probl, meth, ctxt, env, loc = _,
14.106 - branch, result = _ , ostate= _}) =
14.107 - PblObj {cell = cell, origin = origin, fmz= fmz, spec = spec, probl = probl,
14.108 - meth = meth, ctxt = ctxt, env = env, loc = l, branch = branch, result = f', ostate = s};
14.109 -fun repl_tac x (PrfObj {cell, form, tac = _, loc, branch, result, ostate}) =
14.110 - PrfObj {cell = cell, form = form, tac = x, loc = loc, branch = branch,
14.111 - result = result, ostate = ostate}
14.112 - | repl_tac _ _ = raise PTREE "repl_tac takes no PblObj";
14.113 -fun repl_ctxt x (PblObj {cell, origin, fmz, spec, probl, meth,
14.114 - ctxt = _, env, loc, branch, result, ostate}) =
14.115 - PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl = probl,
14.116 - meth = meth, ctxt = x, env = env, loc = loc, branch = branch, result = result,
14.117 - ostate = ostate}
14.118 - | repl_ctxt _ _ = raise PTREE "repl_env takes no PrfObj";
14.119 -fun repl_env e (PblObj {cell, origin, fmz, spec, probl, meth,
14.120 - ctxt, env = _, loc, branch, result, ostate}) =
14.121 - PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl = probl,
14.122 - meth = meth, ctxt = ctxt, env = e, loc = loc, branch = branch, result = result,
14.123 - ostate = ostate}
14.124 - | repl_env _ _ = raise PTREE "repl_env takes no PrfObj";
14.125 -fun repl_oris oris (PblObj { cell, origin = (_, spe, hdf),fmz, spec, probl, meth,
14.126 - ctxt, env, loc, branch, result, ostate}) =
14.127 - PblObj{cell = cell, origin = (oris, spe, hdf), fmz = fmz, spec = spec, probl = probl,
14.128 - meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
14.129 - ostate = ostate}
14.130 - | repl_oris _ _ = raise PTREE "repl_oris takes no PrfObj";
14.131 -fun repl_orispec spe (PblObj {cell, origin = (oris, _, hdf), fmz, spec, probl, meth,
14.132 - ctxt, env, loc, branch, result, ostate}) =
14.133 - PblObj{cell = cell, origin = (oris, spe, hdf), fmz = fmz, spec = spec, probl = probl,
14.134 - meth = meth, ctxt = ctxt, env = env, loc = loc, branch = branch, result = result,
14.135 - ostate = ostate}
14.136 - | repl_orispec _ _ = raise PTREE "repl_orispec takes no PrfObj";
14.137 -fun repl_loc l (PblObj {cell, origin, fmz, spec, probl, meth,
14.138 - ctxt, env, loc = _ , branch, result, ostate}) =
14.139 - PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl = probl,
14.140 - meth = meth, ctxt = ctxt, env = env, loc = l, branch = branch, result = result,
14.141 - ostate = ostate}
14.142 - | repl_loc l (PrfObj {cell, form, tac, loc = _, branch, result, ostate}) =
14.143 - PrfObj {cell = cell, form = form, tac = tac, loc= l, branch = branch, result = result,
14.144 - ostate = ostate}
14.145 -
14.146 -
14.147 -fun repl_branch b (PblObj {cell, origin, fmz, spec, probl, meth, ctxt, env, loc, branch = _,
14.148 - result, ostate}) =
14.149 - PblObj {cell = cell, origin = origin, fmz = fmz, spec = spec, probl = probl,
14.150 - meth = meth, ctxt = ctxt, env = env, loc = loc, branch = b, result = result,
14.151 - ostate = ostate}
14.152 - | repl_branch b (PrfObj {cell, form, tac, loc, branch = _, result, ostate}) =
14.153 - PrfObj {cell = cell, form = form, tac = tac, loc = loc, branch = b,
14.154 - result = result, ostate = ostate};
14.155 -
14.156 -fun update_branch pt pos x = appl_obj (repl_branch x) pt pos;
14.157 -fun update_ctxt pt pos x = appl_obj (repl_ctxt x) pt pos; (* for use on PblObj,
14.158 - otherwise use fun generate1; compare fun get_ctxt*)
14.159 -fun update_env pt pos x = appl_obj (repl_env x) pt pos;
14.160 -fun update_domID pt pos x = appl_obj (repl_domID x) pt pos;
14.161 -fun update_met pt pos x = appl_obj (repl_met x) pt pos;
14.162 -fun update_metppc pt pos x = appl_obj (repl_met x) pt pos;
14.163 -fun update_metID pt pos x = appl_obj (repl_metID x) pt pos;
14.164 -fun update_pbl pt pos x = appl_obj (repl_pbl x) pt pos;
14.165 -fun update_pblppc pt pos x = appl_obj (repl_pbl x) pt pos;
14.166 -fun update_pblID pt pos x = appl_obj (repl_pblID x) pt pos;
14.167 -fun update_oris pt pos x = appl_obj (repl_oris x) pt pos;
14.168 -fun update_orispec pt pos x = appl_obj (repl_orispec x) pt pos;
14.169 -fun update_spec pt pos x = appl_obj (repl_spec x) pt pos;
14.170 -fun update_tac pt pos x = appl_obj (repl_tac x) pt pos;
14.171 -
14.172 -fun update_loc' pt pos x = appl_obj (repl_loc x) pt pos;
14.173 -(* the update wrt. get_ctxt, get_istate; all other functions are deprecated*)
14.174 -fun upd_istate_ctxt (pt, (p, p_)) (istate, ctxt) =
14.175 - let
14.176 - val (for_other, for_result) = get_obj g_loc pt p
14.177 - in
14.178 - if p_ = Res
14.179 - then update_loc' pt p (for_other, SOME (istate, ctxt))
14.180 - else update_loc' pt p (SOME (istate, ctxt), for_result)
14.181 -end
14.182 -fun upd_istate (pt, (p, p_)) istate =
14.183 - let
14.184 - val (for_other, for_result) = get_obj g_loc pt p
14.185 - in
14.186 - if p_ = Res
14.187 - then
14.188 - case for_result of
14.189 - NONE => update_loc' pt p (for_other, SOME (istate, ContextC.e_ctxt(*!!!*)))
14.190 - | SOME (_, ctxt) => update_loc' pt p (for_other, SOME (istate, ctxt))
14.191 - else
14.192 - case for_other of
14.193 - NONE => update_loc' pt p (SOME (istate, ContextC.e_ctxt(*!!!*)), for_result)
14.194 - | SOME (_, ctxt) => update_loc' pt p (SOME (istate, ctxt), for_result)
14.195 -end
14.196 -fun upd_ctxt (pt, (p, p_)) ctxt =
14.197 - let
14.198 - val (for_other, for_result) = get_obj g_loc pt p
14.199 - in
14.200 - if p_ = Res
14.201 - then
14.202 - case for_result of
14.203 - NONE => update_loc' pt p (for_other, SOME (Istate.e_istate(*!!!*), ctxt))
14.204 - | SOME (istate, _) => update_loc' pt p (for_other, SOME (istate, ctxt))
14.205 - else
14.206 - case for_other of
14.207 - NONE => update_loc' pt p (SOME (Istate.e_istate(*!!!*), ctxt), for_result)
14.208 - | SOME (istate, _) => update_loc' pt p (SOME (istate, ctxt), for_result)
14.209 -end
14.210 -
14.211 -(* called by Take *)
14.212 -fun append_form p l f pt =
14.213 - insert_pt (PrfObj {cell = NONE, form = f, tac = Tactic.Empty_Tac, loc = (SOME l, NONE),
14.214 - branch = NoBranch, result = (Rule.e_term, []), ostate = Incomplete}) pt p;
14.215 -fun cappend_form pt p loc f =
14.216 - let
14.217 - val (pt', cs) = cut_tree pt (p, Frm)
14.218 - val pt'' = append_form p loc f pt'
14.219 - in (pt'', cs) end;
14.220 -
14.221 -fun append_problem [] l fmz (strs, spec, hdf) _ =
14.222 - (Nd (PblObj {cell = NONE, origin = (strs, spec, hdf), fmz = fmz, spec = Celem.empty_spec,
14.223 - probl = [], meth = [], ctxt = ContextC.e_ctxt, env = NONE, loc = (SOME l, NONE),
14.224 - branch = TransitiveB, result = (Rule.e_term, []), ostate = Incomplete}, []))
14.225 - | append_problem p l fmz (strs, spec, hdf) pt =
14.226 - insert_pt (PblObj {cell = NONE, origin = (strs, spec, hdf), fmz = fmz, spec = Celem.empty_spec,
14.227 - probl = [], meth = [], ctxt = ContextC.e_ctxt, env = NONE, loc = (SOME l, NONE),
14.228 - branch = TransitiveB, result = (Rule.e_term, []), ostate= Incomplete}) pt p;
14.229 -fun cappend_problem _ [] loc fmz ori = (append_problem [] loc fmz ori EmptyPtree, [])
14.230 - | cappend_problem pt p loc fmz ori =
14.231 - apfst (append_problem p loc fmz ori) (cut_tree pt (p, Frm));
14.232 -
14.233 -(*WN041022 deprecated, still for kbtest/diffapp.sml, /systest/root-equ.sml*)
14.234 -fun append_parent p l f r b pt =
14.235 - let
14.236 - val (ll, f) =
14.237 - if existpt p pt andalso Tactic.is_empty_tac (get_obj g_tac pt p)
14.238 - then ((fst (get_obj g_loc pt p), SOME l), get_obj g_form pt p)
14.239 - else ((SOME l, NONE), f)
14.240 - in insert_pt (PrfObj {cell = NONE, form = f, tac = r, loc = ll,
14.241 - branch = b, result = (Rule.e_term, []), ostate= Incomplete}) pt p
14.242 - end;
14.243 -fun cappend_parent pt p loc f r b = (* for tests only *)
14.244 - apfst (append_parent p loc f r b) (cut_tree pt (p, Und));
14.245 -
14.246 -fun append_atomic p l f r f' s pt =
14.247 - let
14.248 - val (iss, f) =
14.249 - if existpt p pt andalso Tactic.is_empty_tac (get_obj g_tac pt p)
14.250 - then (*after Take*) ((fst (get_obj g_loc pt p), SOME l), get_obj g_form pt p)
14.251 - else ((NONE, SOME l), f)
14.252 - in
14.253 - insert_pt (PrfObj {cell = NONE, form = f, tac = r, loc = iss, branch = NoBranch,
14.254 - result = f', ostate = s}) pt p
14.255 - end;
14.256 -
14.257 -(* 20.8.02: cappend_* FIXXXXME cut branches below cannot be decided here:
14.258 - detail - generate - cappend: inserted, not appended !!!
14.259 - cut decided in applicable_in !?!
14.260 -*)
14.261 -fun cappend_atomic pt p ist_res f r f' s =
14.262 - if existpt p pt andalso Tactic.is_empty_tac (get_obj g_tac pt p)
14.263 - then (*after Take: transfer Frm and respective istate*)
14.264 - let
14.265 - val (ist_form, f) =
14.266 - (get_loc pt (p,Frm), get_obj g_form pt p)
14.267 - val (pt, cs) = cut_tree pt (p,Frm)
14.268 - val pt = append_atomic p (Istate.e_istate, ContextC.e_ctxt) f r f' s pt
14.269 - val pt = update_loc' pt p (SOME ist_form, SOME ist_res)
14.270 - in (pt, cs) end
14.271 - else apfst (append_atomic p ist_res f r f' s) (cut_tree pt (p,Frm));
14.272 -
14.273 -fun append_result pt p l f s =
14.274 - (appl_obj (repl_result (fst (get_obj g_loc pt p), SOME l) f s) pt p, []);
14.275 -
14.276 -end
14.277 \ No newline at end of file
15.1 --- a/src/Tools/isac/Specify/ctree-basic.sml Fri Oct 25 16:07:15 2019 +0200
15.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
15.3 @@ -1,896 +0,0 @@
15.4 -(* Title: the calctree, which holds a calculation
15.5 - Author: Walther Neuper 1999
15.6 - (c) due to copyright terms
15.7 -*)
15.8 -
15.9 -signature BASIC_CALC_TREE =
15.10 -sig (* vvv--- *.sml require these typs incrementally, with these exception -----------------vvv *)
15.11 - (*===\<Longrightarrow> other ?mstools.sml? =================================================================*)
15.12 - type state
15.13 - type con
15.14 -
15.15 - eqtype posel
15.16 - type pos = posel list
15.17 - val pos2str : int list -> string (* for datatypes.sml *)
15.18 - datatype pos_ = Frm | Met | Pbl | Res | Und
15.19 - val pos_2str : pos_ -> string
15.20 - type pos'
15.21 - val pos'2str : pos' -> string
15.22 - val str2pos_ : string -> pos_ (* for datatypes.sml *)
15.23 - val e_pos' : pos'
15.24 - (* for generate.sml ?!? ca.*)
15.25 - eqtype cellID
15.26 -
15.27 - datatype branch = AndB | CollectB | IntersectB | MapB | NoBranch | OrB | SequenceB | TransitiveB
15.28 - datatype ostate = Complete | Incomplete | Inconsistent
15.29 - datatype ppobj =
15.30 - PblObj of
15.31 - {branch: branch,
15.32 - cell: Celem.lrd option,
15.33 - loc: (Istate.T * Proof.context) option * (Istate.T * Proof.context) option,
15.34 - ostate: ostate,
15.35 - result: Selem.result,
15.36 -
15.37 - fmz: Selem.fmz,
15.38 - origin: Model.ori list * Celem.spec * term,
15.39 - probl: Model.itm list,
15.40 - meth: Model.itm list,
15.41 - spec: Celem.spec,
15.42 - ctxt: Proof.context,
15.43 - env: (Istate.T * Proof.context) option}
15.44 - | PrfObj of
15.45 - {branch: branch,
15.46 - cell: Celem.lrd option,
15.47 - loc: (Istate.T * Proof.context) option * (Istate.T * Proof.context) option,
15.48 - ostate: ostate,
15.49 - result: Selem.result,
15.50 -
15.51 - form: term,
15.52 - tac: Tactic.input}
15.53 -
15.54 - datatype ctree = EmptyPtree | Nd of ppobj * ctree list
15.55 - val e_ctree : ctree (* TODO: replace by EmptyPtree*)
15.56 - val existpt' : pos' -> ctree -> bool (* for interface.sml *)
15.57 - val is_interpos : pos' -> bool (* for interface.sml *)
15.58 - val lev_pred' : ctree -> pos' -> pos' (* for interface.sml *)
15.59 - val ins_chn : ctree list -> ctree -> pos -> ctree (* for solve.sml *)
15.60 - val children : ctree -> ctree list (* for solve.sml *)
15.61 - val get_nd : ctree -> pos -> ctree (* for solve.sml *)
15.62 - val just_created_ : ppobj -> bool (* for mathengine.sml *)
15.63 - val just_created : state -> bool (* for mathengine.sml *)
15.64 - val e_origin : Model.ori list * Celem.spec * term (* for mathengine.sml *)
15.65 -
15.66 - val is_pblobj : ppobj -> bool
15.67 - val is_pblobj' : ctree -> pos -> bool
15.68 - val is_pblnd : ctree -> bool
15.69 -
15.70 - val g_spec : ppobj -> Celem.spec
15.71 - val g_loc : ppobj -> (Istate.T * Proof.context) option * (Istate.T * Proof.context) option
15.72 - val g_form : ppobj -> term
15.73 - val g_pbl : ppobj -> Model.itm list
15.74 - val g_met : ppobj -> Model.itm list
15.75 - val g_metID : ppobj -> Celem.metID
15.76 - val g_result : ppobj -> Selem.result
15.77 - val g_tac : ppobj -> Tactic.input
15.78 - val g_domID : ppobj -> Rule.domID (* for appl.sml TODO: replace by thyID *)
15.79 - val g_env : ppobj -> (Istate.T * Proof.context) option (* for appl.sml *)
15.80 -
15.81 - val g_origin : ppobj -> Model.ori list * Celem.spec * term (* for script.sml *)
15.82 - val get_loc : ctree -> pos' -> Istate.T * Proof.context (* for script.sml *)
15.83 - val get_istate : ctree -> pos' -> Istate.T (* for script.sml *)
15.84 - val get_ctxt : ctree -> pos' -> Proof.context
15.85 - val get_obj : (ppobj -> 'a) -> ctree -> pos -> 'a
15.86 - val get_curr_formula : state -> term
15.87 - val get_assumptions_ : ctree -> pos' -> term list (* for appl.sml *)
15.88 -
15.89 - val is_e_ctxt : Proof.context -> bool (* for appl.sml *)
15.90 - val new_val : term -> Istate.T -> Istate.T
15.91 - (* for calchead.sml *)
15.92 - type cid = cellID list
15.93 - type ocalhd = bool * pos_ * term * Model.itm list * (bool * term) list * Celem.spec
15.94 - datatype ptform = Form of term | ModSpec of ocalhd
15.95 - val get_somespec' : Celem.spec -> Celem.spec -> Celem.spec
15.96 - exception PTREE of string;
15.97 -
15.98 - val par_pbl_det : ctree -> pos -> bool * pos * Rule.rls (* for appl.sml *)
15.99 - val rootthy : ctree -> theory (* for script.sml *)
15.100 -(* ---- made visible ONLY for structure CTaccess : CALC_TREE_ACCESS --------------------------- *)
15.101 - val appl_obj : (ppobj -> ppobj) -> ctree -> pos -> ctree
15.102 - val existpt : pos -> ctree -> bool (* also for tests *)
15.103 - val cut_tree : ctree -> pos * 'a -> ctree * pos' list (* also for tests *)
15.104 - val insert_pt : ppobj -> ctree -> int list -> ctree
15.105 -(* ---- made visible ONLY for structure CTnavi : CALC_TREE_NAVIGATION ------------------------- *)
15.106 - val g_branch : ppobj -> branch
15.107 - val g_form' : ctree -> term
15.108 - val g_ostate : ppobj -> ostate
15.109 - val g_ostate' : ctree -> ostate
15.110 - val g_res : ppobj -> term
15.111 - val g_res' : ctree -> term
15.112 -(*/---- duplicates in CTnavi, reconsider structs -----------------------------------------------
15.113 - val lev_on : CTbasic.pos -> CTbasic.pos (* duplicate in ctree-navi.sml *)
15.114 - val lev_dn : CTbasic.pos -> CTbasic.pos (* duplicate in ctree-navi.sml *)
15.115 - val par_pblobj : CTbasic.ctree -> CTbasic.pos -> CTbasic.pos (* duplicate in ctree-navi.sml *)
15.116 - ---- duplicates in CTnavi, reconsider structs ----------------------------------------------/*)
15.117 -
15.118 -(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
15.119 - val pr_ctree : (pos -> ppobj -> string) -> ctree -> string
15.120 - val pr_short : pos -> ppobj -> string
15.121 - val g_ctxt : ppobj -> Proof.context
15.122 - val g_fmz : ppobj -> Selem.fmz
15.123 - val get_allp : pos' list -> pos * (int list * pos_) -> ctree -> pos' list
15.124 - val get_allps : (pos * pos_) list -> posel list -> ctree list -> pos' list
15.125 - val get_allpos' : pos * posel -> ctree -> pos' list
15.126 - val get_allpos's : pos * posel -> ctree list -> (pos * pos_) list
15.127 - val cut_bottom : pos * posel -> ctree -> (ctree * pos' list) * bool
15.128 - val cut_level : pos' list -> pos -> ctree -> int list * pos_ -> ctree * pos' list
15.129 - val cut_level_'_ : pos' list -> pos -> ctree -> int list * pos_ -> ctree * pos' list
15.130 - val get_trace : ctree -> int list -> int list -> int list list
15.131 - val branch2str : branch -> string
15.132 -( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
15.133 -
15.134 -(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
15.135 - (* NONE *)
15.136 -end
15.137 -
15.138 -(**)
15.139 -structure CTbasic(**): BASIC_CALC_TREE(**) =
15.140 -struct
15.141 -(**)
15.142 -type env = (term * term) list;
15.143 -
15.144 -datatype branch =
15.145 - NoBranch | AndB | OrB
15.146 -| TransitiveB (* FIXXXME.0308: set branch from met in Apply_Method
15.147 - FIXXXME.0402: -"- in Begin_Trans'*)
15.148 -| SequenceB | IntersectB | CollectB | MapB;
15.149 -
15.150 -fun branch2str NoBranch = "NoBranch" (* for tests only *)
15.151 - | branch2str AndB = "AndB"
15.152 - | branch2str OrB = "OrB"
15.153 - | branch2str TransitiveB = "TransitiveB"
15.154 - | branch2str SequenceB = "SequenceB"
15.155 - | branch2str IntersectB = "IntersectB"
15.156 - | branch2str CollectB = "CollectB"
15.157 - | branch2str MapB = "MapB";
15.158 -
15.159 -datatype ostate =
15.160 - Incomplete | Complete | Inconsistent (* WN041020 latter still unused *);
15.161 -fun ostate2str Incomplete = "Incomplete" (* for tests only *)
15.162 - | ostate2str Complete = "Complete"
15.163 - | ostate2str Inconsistent = "Inconsistent";
15.164 -
15.165 -type cellID = int;
15.166 -type cid = cellID list;
15.167 -
15.168 -type posel = int; (* for readability in funs accessing Ctree *)
15.169 -type pos = int list;
15.170 -val pos2str = ints2str';
15.171 -datatype pos_ =
15.172 - Pbl (* PblObj-position: problem-type *)
15.173 -| Met (* PblObj-position: method *)
15.174 -| Frm (* PblObj-position: -> Pbl in ME (not by moveDown !)
15.175 - | PrfObj-position: formula *)
15.176 -| Res (* PblObj | PrfObj-position: result *)
15.177 -| Und; (* undefined*)
15.178 -fun pos_2str Pbl = "Pbl"
15.179 - | pos_2str Met = "Met"
15.180 - | pos_2str Frm = "Frm"
15.181 - | pos_2str Res = "Res"
15.182 - | pos_2str Und = "Und";
15.183 -fun str2pos_ "Pbl" = Pbl
15.184 - | str2pos_ "Met" = Met
15.185 - | str2pos_ "Frm" = Frm
15.186 - | str2pos_ "Res" = Res
15.187 - | str2pos_ "Und" = Und
15.188 - | str2pos_ str = error ("str2pos_: wrong argument = " ^ str)
15.189 -
15.190 -type pos' = pos * pos_;
15.191 -(*WN0312 remembering interator (pos * pos_) for ctree
15.192 - pos : lev_on, lev_dn, lev_up
15.193 - pos_:
15.194 -# generate1 sets pos_ if possible ...?WN0502?NOT...
15.195 -# generate1 does NOT set pos, because certain nodes can be lev_on OR lev_dn
15.196 - exceptions: Begin/End_Trans
15.197 -# thus generate(1) called in
15.198 -.# assy, locate_input_tactic
15.199 -.# begin_end_prog (tac_ -cases); general case:
15.200 - val pos' = case pos' of (p,Res) => (lev_on p',Res) | _ => pos'
15.201 -# WN050220, S(604):
15.202 - generate1...(Rewrite(f,..,res))..(pos, pos_)
15.203 - cappend_atomic.................pos ////// gets f+res always!!!
15.204 - cut_tree....................pos, pos_
15.205 -*)
15.206 -fun pos'2str (p, p_) = pair2str (ints2str' p, pos_2str p_);
15.207 -fun pos's2str ps = (strs2str' o (map pos'2str)) ps; (* for tests only *)
15.208 -val e_pos' = ([], Und);
15.209 -
15.210 -(* ATTENTION: does _not_ recognise Variable.declare_constraints, etc...*)
15.211 -fun is_e_ctxt ctxt = Context.eq_thy (Proof_Context.theory_of ctxt, @{theory "Pure"});
15.212 -
15.213 -type iist = Istate.T option * Istate.T option;
15.214 -(*val e_iist = (e_istate, e_istate); --- sinnlos f"ur NICHT-equality-type*)
15.215 -
15.216 -
15.217 -fun new_val v (Istate.Pstate (env, loc_, topt, _, safe, bool)) =
15.218 - (Istate.Pstate (env, loc_, topt, v, safe, bool))
15.219 - | new_val _ _ = error "new_val: only for Pstate";
15.220 -
15.221 -datatype con = land | lor;
15.222 -
15.223 -(* executed tactics (tac_s) with local environment etc.;
15.224 - used for continuing eval script + for generate *)
15.225 -type ets =
15.226 - (Celem.loc_ *(* of tactic in scr, tactic (weakly) associated with tac_ *)
15.227 - (Tactic.T * (* (for generate) *)
15.228 - env * (* with 'tactic=result' as rule, tactic ev. _not_ ready for 'parallel let' *)
15.229 - env * (* with results of (ready) tacs *)
15.230 - term * (* itr_arg of tactic, for upd. env at Repeat, Try *)
15.231 - term * (* result value of the tac *)
15.232 - Istate.safe))
15.233 - list;
15.234 -
15.235 -fun ets2s (l,(m,eno,env,iar,res,s)) =
15.236 - "\n(" ^ Celem.loc_2str l ^ ",(" ^ Tactic.tac_2str m ^
15.237 - ",\n ens= " ^ Env.subst2str eno ^
15.238 - ",\n env= " ^ Env.subst2str env ^
15.239 - ",\n iar= " ^ Rule.term2str iar ^
15.240 - ",\n res= " ^ Rule.term2str res ^
15.241 - ",\n " ^ Istate.safe2str s ^ "))";
15.242 -fun ets2str (ets: ets) = (strs2str o (map ets2s)) ets; (* for tests only *)
15.243 -
15.244 -type envp =(*9.5.03: unused, delete with field in ctree.PblObj FIXXXME*)
15.245 - (int * term list) list * (* assoc-list: args of met*)
15.246 - (int * Rule.rls) list * (* assoc-list: tacs already done ///15.9.00*)
15.247 - (int * ets) list * (* assoc-list: tacs etc. already done*)
15.248 - (string * pos) list; (* asms * from where*)
15.249 -
15.250 -datatype ppobj = (* TODO: arrange according to signature *)
15.251 - PrfObj of
15.252 - {cell : Celem.lrd option, (* where in form tac has been applied, FIXME.WN0607 rename field *)
15.253 - form : term, (* where tac is applied to *)
15.254 - tac : Tactic.input, (* also in istate *)
15.255 - loc : (Istate.T * (* script interpreter state *)
15.256 - Proof.context) (* context for provers, type inference *)
15.257 - option * (* both for interpreter location on Frm, Pbl, Met *)
15.258 - (Istate.T * (* script interpreter state *)
15.259 - Proof.context) (* context for provers, type inference *)
15.260 - option, (* both for interpreter location on Res *)
15.261 - (*(NONE,NONE) <==> e_istate ! see update_loc, get_loc *)
15.262 - branch: branch, (* only rudimentary *)
15.263 - result: Selem.result, (* result and assumptions *)
15.264 - ostate: ostate} (* Complete <=> result is OK *)
15.265 -| PblObj of
15.266 - {cell : Celem.lrd option, (* unused: meaningful only for some _Prf_Obj *)
15.267 - fmz : Selem.fmz, (* from init:FIXME never use this spec;-drop *)
15.268 - origin: (Model.ori list) *(* representation from fmz+pbt+met
15.269 - for efficiently adding items in probl, meth *)
15.270 - Celem.spec * (* updated by Refine_Tacitly *)
15.271 - term, (* headline of calc-head, as calculated initially(!) *)
15.272 - spec : Celem.spec, (* explicitly input *)
15.273 - probl : Model.itm list, (* itms explicitly input *)
15.274 - meth : Model.itm list, (* itms automatically added to copy of probl *)
15.275 - ctxt : Proof.context, (* WN110513 introduced to avoid [*] [**] *)
15.276 - env : (Istate.T * Proof.context) option, (* istate only for initac in script
15.277 - context for specify phase on this node NO..
15.278 -..NO: this conflicts with init_form/initac: see Apply_Method without init_form *)
15.279 - loc : (Istate.T * Proof.context) option * (Istate.T * (* like PrfObj *)
15.280 - Proof.context) option, (* for spec-phase [*], NO..
15.281 -..NO: raises errors not tracable on WN110513 [**] *)
15.282 - branch: branch, (* like PrfObj *)
15.283 - result: Selem.result, (* like PrfObj *)
15.284 - ostate: ostate}; (* like PrfObj *)
15.285 -
15.286 -(* this tree contains isac's calculations;
15.287 - the tree's structure has been copied from an early version of Theorema(c);
15.288 - it has the disadvantage, that there is no space
15.289 - for the first tactic in a script generating the first formula at (p,Frm);
15.290 - this trouble has been covered by 'init_form' and 'Take' so far,
15.291 - but it is crucial if the first tactic in a script is eg. 'Subproblem';
15.292 - see 'type tac', Apply_Method.
15.293 -*)
15.294 -datatype ctree =
15.295 - EmptyPtree
15.296 -| Nd of ppobj * (ctree list);
15.297 -val e_ctree = EmptyPtree;
15.298 -type state = ctree * pos'
15.299 -
15.300 -fun is_pblobj (PblObj _) = true
15.301 - | is_pblobj _ = false;
15.302 -
15.303 -exception PTREE of string;
15.304 -fun nth _ [] = raise PTREE "nth _ []"
15.305 - | nth 1 (x :: _) = x
15.306 - | nth n (_ :: xs) = nth (n - 1) xs;
15.307 -(*> nth 2 [11,22,33]; -->> val it = 22 : int*)
15.308 -
15.309 -
15.310 -(** convert ctree to a string **)
15.311 -
15.312 -(* convert a pos from list to string *)
15.313 -fun pr_pos ps = (space_implode "." (map string_of_int ps))^". ";
15.314 -(* show hd origin or form only *)
15.315 -fun pr_short p (PblObj _) = pr_pos p ^ " ----- pblobj -----\n" (* for tests only *)
15.316 - | pr_short p (PrfObj {form = form, ...}) = pr_pos p ^ Rule.term2str form ^ "\n";
15.317 -fun pr_ctree f pt = (* for tests only *)
15.318 - let
15.319 - fun pr_pt _ _ EmptyPtree = ""
15.320 - | pr_pt pfn ps (Nd (b, [])) = pfn ps b
15.321 - | pr_pt pfn ps (Nd (b, ts)) = pfn ps b ^ prts pfn ps 1 ts
15.322 - and prts _ _ _ [] = ""
15.323 - | prts pfn ps p (t :: ts) = (pr_pt pfn (ps @ [p]) t)^
15.324 - (prts pfn ps (p + 1) ts)
15.325 - in pr_pt f [] pt end;
15.326 -
15.327 -(** access the branches of ctree **)
15.328 -
15.329 -fun repl [] _ _ = raise PTREE "repl [] _ _"
15.330 - | repl (_ :: ls) 1 e = e :: ls
15.331 - | repl (l :: ls) n e = l :: (repl ls (n-1) e);
15.332 -fun repl_app ls n e =
15.333 - let
15.334 - val lim = 1 + length ls
15.335 - in
15.336 - if n > lim
15.337 - then raise PTREE "repl_app: n > lim"
15.338 - else if n = lim
15.339 - then ls @ [e]
15.340 - else repl ls n e end;
15.341 -
15.342 -(* get from obj at pos by f : ppobj -> 'a *)
15.343 -fun get_obj _ EmptyPtree _ = raise PTREE "get_obj f EmptyPtree"
15.344 - | get_obj f (Nd (b, _)) [] = f b
15.345 - | get_obj f (Nd (_, bs)) (p :: ps) =
15.346 - let
15.347 - val _ = (nth p bs)
15.348 - handle _ => raise PTREE ("get_obj: pos = " ^ ints2str' (p::ps) ^ " does not exist");
15.349 - in
15.350 - (get_obj f (nth p bs) ps)
15.351 - handle _ => raise PTREE ("get_obj: pos = " ^ ints2str' (p::ps) ^ " does not exist")
15.352 - end;
15.353 -fun get_nd EmptyPtree _ = raise PTREE "get_nd EmptyPtree"
15.354 - | get_nd n [] = n
15.355 - | get_nd (Nd (_, nds)) (pos as p :: ps) = (get_nd (nth p nds) ps)
15.356 - handle _ => raise PTREE ("get_nd: not existent pos = " ^ ints2str' pos);
15.357 -
15.358 -(* for use by get_obj *)
15.359 -fun g_form (PrfObj {form = f,...}) = f
15.360 - | g_form (PblObj {origin= (_,_,f),...}) = f;
15.361 -fun g_form' (Nd (PrfObj {form = f, ...}, _)) = f
15.362 - | g_form' (Nd (PblObj {origin= (_, _, f),...}, _)) = f
15.363 - | g_form' _ = error "g_form': uncovered fun def.";
15.364 -(* | g_form _ = raise PTREE "g_form not for PblObj";*)
15.365 -fun g_origin (PblObj {origin = ori, ...}) = ori
15.366 - | g_origin _ = raise PTREE "g_origin not for PrfObj";
15.367 -fun g_fmz (PblObj {fmz = f, ...}) = f (* for tests only *)
15.368 - | g_fmz _ = raise PTREE "g_fmz not for PrfObj";
15.369 -fun g_spec (PblObj {spec = s, ...}) = s
15.370 - | g_spec _ = raise PTREE "g_spec not for PrfObj";
15.371 -fun g_pbl (PblObj {probl = p, ...}) = p
15.372 - | g_pbl _ = raise PTREE "g_pbl not for PrfObj";
15.373 -fun g_met (PblObj {meth = p, ...}) = p
15.374 - | g_met _ = raise PTREE "g_met not for PrfObj";
15.375 -fun g_domID (PblObj {spec = (d, _, _), ...}) = d
15.376 - | g_domID _ = raise PTREE "g_metID not for PrfObj";
15.377 -fun g_metID (PblObj {spec = (_, _, m), ...}) = m
15.378 - | g_metID _ = raise PTREE "g_metID not for PrfObj";
15.379 -fun g_ctxt (PblObj {ctxt, ...}) = ctxt
15.380 - | g_ctxt _ = raise PTREE "g_ctxt not for PrfObj";
15.381 -fun g_env (PblObj {env, ...}) = env
15.382 - | g_env _ = raise PTREE "g_env not for PrfObj";
15.383 -fun g_loc (PblObj {loc = l, ...}) = l
15.384 - | g_loc (PrfObj {loc = l, ...}) = l;
15.385 -fun g_branch (PblObj {branch = b, ...}) = b
15.386 - | g_branch (PrfObj {branch = b, ...}) = b;
15.387 -fun g_tac (PblObj {spec = (_, _, m),...}) = Tactic.Apply_Method m
15.388 - | g_tac (PrfObj {tac = m, ...}) = m;
15.389 -fun g_result (PblObj {result = r, ...}) = r
15.390 - | g_result (PrfObj {result = r, ...}) = r;
15.391 -fun g_res (PblObj {result = (r, _) ,...}) = r
15.392 - | g_res (PrfObj {result = (r, _),...}) = r;
15.393 -fun g_res' (Nd (PblObj {result = (r, _), ...}, _)) = r
15.394 - | g_res' (Nd (PrfObj {result = (r, _),...}, _)) = r
15.395 - | g_res' _ = raise PTREE "g_res': uncovered fun def.";
15.396 -fun g_ostate (PblObj {ostate = r, ...}) = r
15.397 - | g_ostate (PrfObj {ostate = r, ...}) = r;
15.398 -fun g_ostate' (Nd (PblObj {ostate = r, ...}, _)) = r
15.399 - | g_ostate' (Nd (PrfObj {ostate = r, ...}, _)) = r
15.400 - | g_ostate' _ = raise PTREE "g_ostate': uncovered fun def.";
15.401 -
15.402 -(* get the formula preceeding the current position in a calculation *)
15.403 -fun get_curr_formula (pt, (p, p_)) =
15.404 - case p_ of
15.405 - Frm => get_obj g_form pt p
15.406 - | Res => (fst o (get_obj g_result pt)) p
15.407 - | _ => #3 (get_obj g_origin pt p);
15.408 -
15.409 -(* in CalcTree/Subproblem an 'just_created_' model is created;
15.410 - this is filled to 'untouched' by Model/Refine_Problem *)
15.411 -fun just_created_ (PblObj {meth, probl, spec, ...}) =
15.412 - null meth andalso null probl andalso spec = Celem.e_spec
15.413 - | just_created_ _ = raise PTREE "g_ostate': uncovered fun def.";
15.414 -val e_origin = ([], Celem.e_spec, Rule.e_term);
15.415 -
15.416 -fun just_created (pt, (p, _)) =
15.417 - let val ppobj = get_obj I pt p
15.418 - in is_pblobj ppobj andalso just_created_ ppobj end;
15.419 -
15.420 -(* does the pos in the ctree exist ? *)
15.421 -fun existpt pos pt = can (get_obj I pt) pos;
15.422 -(* does the pos' in the ctree exist, ie. extra check for result in the node *)
15.423 -fun existpt' (p, p_) pt =
15.424 - if can (get_obj I pt) p
15.425 - then case p_ of
15.426 - Res => get_obj g_ostate pt p = Complete
15.427 - | _ => true
15.428 - else false;
15.429 -
15.430 -(* is this position appropriate for calculating intermediate steps? *)
15.431 -fun is_interpos (_, Res) = true
15.432 - | is_interpos _ = false;
15.433 -
15.434 -(* get the children of a node in ctree *)
15.435 -fun children (Nd (PblObj _, cn)) = cn
15.436 - | children (Nd (PrfObj _, cn)) = cn
15.437 - | children _ = error "children: uncovered fun def.";
15.438 -
15.439 -(*/--------------- duplicates in ctree-navi.sml: required also here below ---------------\*)
15.440 -fun lev_on [] = raise PTREE "lev_on []"
15.441 - | lev_on pos =
15.442 - let val len = length pos
15.443 - in (drop_last pos) @ [(nth len pos)+1] end;
15.444 -fun lev_up [] = raise PTREE "lev_up []"
15.445 - | lev_up p = (drop_last p):pos;
15.446 -(* find the position of the next parent which is a PblObj in ctree *)
15.447 -fun par_pblobj _ [] = []
15.448 - | par_pblobj pt p =
15.449 - let
15.450 - fun par _ [] = []
15.451 - | par pt p =
15.452 - if is_pblobj (get_obj I pt p)
15.453 - then p
15.454 - else par pt (lev_up p)
15.455 - in par pt (lev_up p) end;
15.456 -(*\--------------- duplicates in ctree-navi.sml: required also here below ---------------/*)
15.457 -
15.458 -(* find the next parent, which is either a PblObj (return true)
15.459 - or a PrfObj with tac = Detail_Set (return false)
15.460 - FIXME.030403: re-organize par_pbl_det after rls' --> rls*)
15.461 -fun par_pbl_det pt [] = (true, [], Rule.Erls)
15.462 - | par_pbl_det pt p =
15.463 - let
15.464 - fun par _ [] = (true, [], Rule.Erls)
15.465 - | par pt p =
15.466 - if is_pblobj (get_obj I pt p)
15.467 - then (true, p, Rule.Erls)
15.468 - else case get_obj g_tac pt p of
15.469 - Tactic.Rewrite_Set rls' => (false, p, assoc_rls rls')
15.470 - | Tactic.Rewrite_Set_Inst (_, rls') => (false, p, assoc_rls rls')
15.471 - | _ => par pt (lev_up p)
15.472 - in par pt (lev_up p) end;
15.473 -
15.474 -(* insert obj b into ctree at pos, ev.overwriting this pos *)
15.475 -fun insert_pt b EmptyPtree [] = Nd (b, [])
15.476 - | insert_pt _ EmptyPtree _ = raise PTREE "insert_pt b Empty _"
15.477 - | insert_pt _ (Nd ( _, _)) [] = raise PTREE "insert_pt b _ []"
15.478 - | insert_pt b (Nd (b', bs)) (p :: []) = Nd (b', repl_app bs p (Nd (b, [])))
15.479 - | insert_pt b (Nd (b', bs)) (p :: ps) = Nd (b', repl_app bs p (insert_pt b (nth p bs) ps));
15.480 -
15.481 -(* insert children to a node without children. compare: fun insert_pt *)
15.482 -fun ins_chn _ EmptyPtree _ = raise PTREE "ins_chn: EmptyPtree"
15.483 - | ins_chn _ (Nd _) [] = raise PTREE "ins_chn: pos = []"
15.484 - | ins_chn ns (Nd (b, bs)) (p :: []) =
15.485 - if p > length bs
15.486 - then raise PTREE "ins_chn: pos not existent"
15.487 - else
15.488 - let
15.489 - val (b', bs') = case nth p bs of
15.490 - Nd (b', bs') => (b', bs')
15.491 - | _ => error "ins_chn: uncovered case nth"
15.492 - in
15.493 - if null bs'
15.494 - then Nd (b, repl_app bs p (Nd (b', ns)))
15.495 - else raise PTREE "ins_chn: pos mustNOT be overwritten"
15.496 - end
15.497 - | ins_chn ns (Nd (b, bs)) (p::ps) = Nd (b, repl_app bs p (ins_chn ns (nth p bs) ps));
15.498 -
15.499 -(* apply f to obj at pos, f: ppobj -> ppobj *)
15.500 -fun appl_to_node f (Nd (b, bs)) = Nd (f b, bs)
15.501 - | appl_to_node _ _ = error "appl_to_node: uncovered fun def.";
15.502 -fun appl_obj _ EmptyPtree [] = EmptyPtree
15.503 - | appl_obj _ EmptyPtree _ = raise PTREE "appl_obj f Empty _"
15.504 - | appl_obj f (Nd (b, bs)) [] = Nd (f b, bs)
15.505 - | appl_obj f (Nd (b, bs)) (p :: []) = Nd (b, repl_app bs p (((appl_to_node f) o (nth p)) bs))
15.506 - | appl_obj f (Nd (b, bs)) (p :: ps) = Nd (b, repl_app bs p (appl_obj f (nth p bs) (ps:pos)));
15.507 -
15.508 -
15.509 -type ocalhd =
15.510 - bool * (* ALL itms+preconds true *)
15.511 - pos_ * (* model belongs to Problem | Method *)
15.512 - term * (* header: Problem... or Cas FIXME.0312: item for marking syntaxerrors *)
15.513 - Model.itm list * (* model: given, find, relate *)
15.514 - ((bool * term) list) *(* model: preconds *)
15.515 - Celem.spec; (* specification *)
15.516 -val e_ocalhd = (false, Und, Rule.e_term, [Model.e_itm], [(false, Rule.e_term)], Celem.e_spec);
15.517 -
15.518 -datatype ptform = Form of term | ModSpec of ocalhd;
15.519 -
15.520 -(* for cut_level; (deprecated) *)
15.521 -fun test_trans (PrfObj {branch, ...}) = true andalso branch = TransitiveB
15.522 - | test_trans (PblObj {branch, ...}) = true andalso branch = TransitiveB;
15.523 -
15.524 -fun is_pblobj' pt p =
15.525 - let val ppobj = get_obj I pt p
15.526 - in is_pblobj ppobj end;
15.527 -
15.528 -fun del_res (PblObj {cell, fmz, origin, spec, probl, meth, ctxt, env, loc= (l1, _), branch, ...}) =
15.529 - PblObj {cell = cell, fmz = fmz, origin = origin, spec = spec, probl = probl, meth = meth,
15.530 - ctxt = ctxt, env = env, loc= (l1, NONE), branch = branch,
15.531 - result = (Rule.e_term, []), ostate = Incomplete}
15.532 - | del_res (PrfObj {cell, form, tac, loc= (l1, _), branch, ...}) =
15.533 - PrfObj {cell = cell, form = form, tac = tac, loc = (l1, NONE), branch = branch,
15.534 - result = (Rule.e_term, []), ostate = Incomplete};
15.535 -
15.536 -
15.537 -fun get_loc EmptyPtree _ = (Istate.e_istate, ContextC.e_ctxt)
15.538 - | get_loc pt (p, Res) =
15.539 - (case get_obj g_loc pt p of
15.540 - (SOME i, NONE) => i
15.541 - | (NONE , NONE) => (Istate.e_istate, ContextC.e_ctxt)
15.542 - | (_ , SOME i) => i)
15.543 - | get_loc pt (p, _) =
15.544 - (case get_obj g_loc pt p of
15.545 - (NONE , SOME i) => i (*13.8.02 just copied from ^^^: too liberal ?*)
15.546 - | (NONE , NONE) => (Istate.e_istate, ContextC.e_ctxt)
15.547 - | (SOME i, _) => i);
15.548 -fun get_istate pt p = get_loc pt p |> #1;
15.549 -fun get_ctxt pt (pos as (p, p_)) =
15.550 - if member op = [Frm, Res] p_
15.551 - then get_loc pt pos |> #2 (*for script interpretation rely on fun get_loc*)
15.552 - else get_obj g_ctxt pt p (*for specify phase take ctx from PblObj*)
15.553 -
15.554 -fun get_assumptions_ pt p = get_ctxt pt p |> ContextC.get_assumptions;
15.555 -
15.556 -fun get_somespec' (dI, pI, mI) (dI', pI', mI') =
15.557 - let
15.558 - val domID = if dI = Rule.e_domID then dI' else dI
15.559 - val pblID = if pI = Celem.e_pblID then pI' else pI
15.560 - val metID = if mI = Celem.e_metID then mI' else mI
15.561 - in (domID, pblID, metID) end;
15.562 -
15.563 -(**.development for extracting an 'interval' from ptree.**)
15.564 -
15.565 -(*WN0510 version stopped in favour of get_interval with !!!move_dn, getFormulaeFromTo
15.566 - actually used (inefficient) version with move_dn: see modspec.sml*)
15.567 -local
15.568 -
15.569 -fun hdp [] = 1 | hdp [0] = 1 | hdp x = hd x;(*start with first*)
15.570 -fun hdq [] = 99999 | hdq [0] = 99999 | hdq x = hd x;(*take until last*)
15.571 -fun tlp [] = [0] | tlp [_] = [0] | tlp x = tl x;
15.572 -fun tlq [] = [99999] | tlq [_] = [99999] | tlq x = tl x;
15.573 -
15.574 -fun getnd i (b,p) q (Nd (po, nds)) =
15.575 - (if i <= 0 then [[b]] else []) @
15.576 - (getnds (i-1) true (b@[hdp p], tlp p) (tlq q)
15.577 - (take_fromto (hdp p) (hdq q) nds))
15.578 -
15.579 -and getnds _ _ _ _ [] = [] (*no children*)
15.580 - | getnds i _ (b,p) q [nd] = (getnd i (b,p) q nd) (*l+r-margin*)
15.581 -
15.582 - | getnds i true (b,p) q [n1, n2] = (*l-margin, r-margin*)
15.583 - (getnd i ( b, p ) [99999] n1) @
15.584 - (getnd ~99999 (lev_on b,[0]) q n2)
15.585 -
15.586 - | getnds i _ (b,p) q [n1, n2] = (*intern, r-margin*)
15.587 - (getnd i ( b,[0]) [99999] n1) @
15.588 - (getnd ~99999 (lev_on b,[0]) q n2)
15.589 -
15.590 - | getnds i true (b,p) q (nd::(nds as _::_)) = (*l-margin, intern*)
15.591 - (getnd i ( b, p ) [99999] nd) @
15.592 - (getnds ~99999 false (lev_on b,[0]) q nds)
15.593 -
15.594 - | getnds i _ (b,p) q (nd::(nds as _::_)) = (*intern, ...*)
15.595 - (getnd i ( b,[0]) [99999] nd) @
15.596 - (getnds ~99999 false (lev_on b,[0]) q nds);
15.597 -in
15.598 -(*get an 'interval from to' from a ptree as 'intervals f t' of respective nodes
15.599 - where 'from' are pos, i.e. a key as int list, 'f' an int (to,t analoguous)
15.600 -(1) the 'f' are given
15.601 -(1a) by 'from' if 'f' = the respective element of 'from' (left margin)
15.602 -(1b) -inifinity, if 'f' > the respective element of 'from' (internal node)
15.603 -(2) the 't' ar given
15.604 -(2a) by 'to' if 't' = the respective element of 'to' (right margin)
15.605 -(2b) inifinity, if 't' < the respective element of 'to (internal node)'
15.606 -the 'f' and 't' are set by hdp,... *)
15.607 -fun get_trace pt p q =
15.608 - (flat o (getnds ((length p) -1) true ([hdp p], tlp p) (tlq q)))
15.609 - (take_fromto (hdp p) (hdq q) (children pt));
15.610 -end;
15.611 -
15.612 -(*extract a formula or model from ctree for itms2itemppc or model2xml*)
15.613 -fun preconds2str bts =
15.614 - (strs2str o (map (Celem.linefeed o pair2str o
15.615 - (apsnd Rule.term2str) o
15.616 - (apfst bool2str)))) bts;
15.617 -fun ocalhd2str (b, p, hdf, itms, prec, spec) = (* for tests only *)
15.618 - "(" ^ bool2str b ^ ", " ^ pos_2str p ^ ", " ^ Rule.term2str hdf ^
15.619 - ", " ^ Model.itms2str_ (Rule.thy2ctxt' "Isac_Knowledge") itms ^
15.620 - ", " ^ preconds2str prec ^ ", \n" ^ Celem.spec2str spec ^ " )";
15.621 -
15.622 -fun is_pblnd (Nd (ppobj, _)) = is_pblobj ppobj
15.623 - | is_pblnd _ = error "is_pblnd: uncovered fun def.";
15.624 -
15.625 -
15.626 -(* determine the previous pos' on the same level
15.627 - WN0502 made for interSteps; _only_ works for branch TransitiveB WN120517 compare lev_back *)
15.628 -fun lev_pred' _ ([], Res) = ([], Pbl)
15.629 - | lev_pred' pt (p, Res) =
15.630 - let val (p', last) = split_last p
15.631 - in
15.632 - if last = 1
15.633 - then if (is_pblobj o (get_obj I pt)) p then (p, Pbl) else (p, Frm)
15.634 - else if get_obj g_res pt (p' @ [last - 1]) = get_obj g_form pt p
15.635 - then (p' @ [last - 1], Res) (* TransitiveB *)
15.636 - else if (is_pblobj o (get_obj I pt)) p then (p,Pbl) else (p, Frm)
15.637 - end
15.638 - | lev_pred' _ _ = error "";
15.639 -
15.640 -
15.641 -(**.insert into ctree and cut branches accordingly.**)
15.642 -
15.643 -(* get all positions of certain intervals on the ctree.
15.644 - OLD VERSION without move_dn; kept for occasional redesign
15.645 - get all pos's to be cut in a ctree
15.646 - below a pos or from a ctree list after i-th element (NO level_up) *)
15.647 -fun get_allpos' (_, _) EmptyPtree = []
15.648 - | get_allpos' (p, 1) (Nd (b, bs)) = (* p is pos of Nd *)
15.649 - if g_ostate b = Incomplete
15.650 - then (p, Frm) :: (get_allpos's (p, 1) bs)
15.651 - else (p, Frm) :: (get_allpos's (p, 1) bs) @ [(p, Res)]
15.652 - | get_allpos' (p, i) (Nd (b, bs)) = (* p is pos of Nd *)
15.653 - if length bs > 0 orelse is_pblobj b
15.654 - then if g_ostate b = Incomplete
15.655 - then [(p,Frm)] @ (get_allpos's (p, 1) bs)
15.656 - else [(p,Frm)] @ (get_allpos's (p, 1) bs) @ [(p, Res)]
15.657 - else if g_ostate b = Incomplete then [] else [(p, Res)]
15.658 -and get_allpos's _ [] = []
15.659 - | get_allpos's (p, i) (pt :: pts) = (* p is pos of parent-Nd *)
15.660 - (get_allpos' (p @ [i], i) pt) @ (get_allpos's (p, i + 1) pts);
15.661 -
15.662 -(*WN050106 like cut_level, but deletes exactly 1 node *)
15.663 -fun cut_level_'_ _ _ EmptyPtree _ =raise PTREE "cut_level_'_ Empty _" (* for tests ONLY *)
15.664 - | cut_level_'_ _ _ (Nd ( _, _)) ([], _) = raise PTREE "cut_level_'_ _ []"
15.665 - | cut_level_'_ cuts P (Nd (b, bs)) (p :: [], p_) =
15.666 - if test_trans b
15.667 - then
15.668 - (Nd (b, drop_nth [] (p:posel, bs)),
15.669 - cuts @ (if p_ = Frm then [(P @ [p], Res)] else []) @
15.670 - (get_allpos's (P, p + 1) (drop_nth [] (p, bs))))
15.671 - else (Nd (b, bs), cuts)
15.672 - | cut_level_'_ cuts P (Nd (b, bs)) ((p :: ps), p_) =
15.673 - let
15.674 - val (bs', cuts') = cut_level_'_ cuts P (nth p bs) (ps, p_)
15.675 - in (Nd (b, repl_app bs p bs'), cuts @ cuts') end;
15.676 -
15.677 -fun cut_level _ _ EmptyPtree _ = raise PTREE "cut_level EmptyPtree _"
15.678 - | cut_level _ _ (Nd ( _, _)) ([],_) = raise PTREE "cut_level _ []"
15.679 - | cut_level cuts P (Nd (b, bs)) (p :: [], p_) =
15.680 - if test_trans b
15.681 - then
15.682 - (Nd (b, take (p:posel, bs)),
15.683 - cuts @
15.684 - (if p_ = Frm andalso (*#*) g_ostate b = Complete then [(P@[p],Res)] else ([]:pos' list)) @
15.685 - (get_allpos's (P, p+1) (takerest (p, bs))))
15.686 - else (Nd (b, bs), cuts)
15.687 - | cut_level cuts P (Nd (b, bs)) ((p :: ps), p_) =
15.688 - let
15.689 - val (bs', cuts') = cut_level cuts P (nth p bs) (ps, p_)
15.690 - in (Nd (b, repl_app bs p bs'), cuts @ cuts') end;
15.691 -
15.692 -(*OLD version before WN050219, overwritten below*)
15.693 -fun cut_tree _ ([], _) = raise PTREE "cut_tree _ ([],_)" (* for test only *)
15.694 - | cut_tree pt (pos as ([_], _)) =
15.695 - let
15.696 - val (pt', cuts) = cut_level [] [] pt pos
15.697 - in
15.698 - (pt', cuts @ (if get_obj g_ostate pt [] = Incomplete then [] else [([], Res)]))
15.699 - end
15.700 - | cut_tree pt (p,p_) =
15.701 - let
15.702 - fun cutfn pt cuts (p, p_) =
15.703 - let
15.704 - val (pt', cuts') = cut_level [] (lev_up p) pt (p,p_)
15.705 - in
15.706 - if length cuts' > 0 andalso length p > 1
15.707 - then cutfn pt' (cuts @ cuts') (lev_up p, Frm(*-->(p,Res)*))
15.708 - else (pt', cuts @ cuts')
15.709 - end
15.710 - val (pt', cuts) = cutfn pt [] (p, p_)
15.711 - in
15.712 - (pt', cuts @ (if get_obj g_ostate pt [] = Incomplete then [] else [([], Res)]))
15.713 - end;
15.714 -
15.715 -local
15.716 -fun move_dn _ (Nd (_, ns)) ([],p_) = (* root problem *)
15.717 - (case p_ of
15.718 - Res => raise PTREE "move_dn: end of calculation"
15.719 - | _ =>
15.720 - if null ns (* go down from Pbl + Met *)
15.721 - then raise PTREE "move_dn: solve problem not started"
15.722 - else ([1], Frm))
15.723 - | move_dn P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate to end of pos *)
15.724 - if p > length ns
15.725 - then raise PTREE "move_dn: pos not existent 2"
15.726 - else move_dn (P @ [p]) (nth p ns) (ps, p_)
15.727 - | move_dn P (Nd (c, ns)) ([p], p_) = (* act on last element of pos *)
15.728 - if p > length ns
15.729 - then raise PTREE "move_dn: pos not existent 3"
15.730 - else
15.731 - (case p_ of
15.732 - Res =>
15.733 - if p = length ns (* last Res on this level: go a level up *)
15.734 - then if g_ostate c = Complete
15.735 - then (P, Res)
15.736 - else raise PTREE (ints2str' P ^ " not complete 1")
15.737 - else (* go to the next Nd on this level, or down into the next Nd *)
15.738 - if is_pblnd (nth (p + 1) ns) then (P@[p + 1], Pbl)
15.739 - else if g_res' (nth p ns) = g_form' (nth (p + 1) ns)
15.740 - then if (null o children o (nth (p + 1))) ns
15.741 - then (* take the Res if Complete *)
15.742 - if g_ostate' (nth (p + 1) ns) = Complete
15.743 - then (P@[p + 1], Res)
15.744 - else raise PTREE (ints2str' (P@[p + 1]) ^ " not complete 2")
15.745 - else (P@[p + 1, 1], Frm) (* go down into the next PrfObj *)
15.746 - else (P@[p + 1], Frm) (* take Frm: exists if the Nd exists *)
15.747 - | Frm => (*go down or to the Res of this Nd*)
15.748 - if (null o children o (nth p)) ns
15.749 - then if g_ostate' (nth p ns) = Complete then (P @ [p], Res)
15.750 - else raise PTREE (ints2str' (P @ [p])^" not complete 3")
15.751 - else (P @ [p, 1], Frm)
15.752 - | _ => (* is Pbl or Met *)
15.753 - if (null o children o (nth p)) ns
15.754 - then raise PTREE "move_dn:solve subproblem not startd"
15.755 - else (P @ [p, 1],
15.756 - if (is_pblnd o hd o children o (nth p)) ns
15.757 - then Pbl else Frm))
15.758 - | move_dn _ _ _ = error "";
15.759 -in
15.760 -(* get all positions in a ctree until ([],Res) or ostate=Incomplete
15.761 -val get_allp = fn :
15.762 - pos' list -> : accumulated, start with []
15.763 - pos -> : the offset for subtrees wrt the root
15.764 - ctree -> : (sub)tree
15.765 - pos' : initialization (the last pos' before ...)
15.766 - -> pos' list : of positions in this (sub) tree (relative to the root)
15.767 -*)
15.768 -fun get_allp cuts (P, pos) pt =
15.769 - (let
15.770 - val nxt = move_dn [] pt pos (*exn if Incomplete reached*)
15.771 - in
15.772 - if nxt <> ([], Res)
15.773 - then get_allp (cuts @ [nxt]) (P, nxt) pt
15.774 - else map (apfst (curry op @ P)) (cuts @ [nxt])
15.775 - end)
15.776 - handle PTREE _ => (map (apfst (curry op@ P)) cuts);
15.777 -end
15.778 -
15.779 -(* the pts are assumed to be on the same level *)
15.780 -fun get_allps cuts _ [] = cuts
15.781 - | get_allps cuts P (pt :: pts) =
15.782 - let
15.783 - val below = get_allp [] (P, ([], Frm)) pt
15.784 - val levfrm =
15.785 - if is_pblnd pt
15.786 - then (P, Pbl) :: below
15.787 - else if last_elem P = 1
15.788 - then (P, Frm) :: below
15.789 - else (*Trans*) below
15.790 - val levres = levfrm @ (if null below then [(P, Res)] else [])
15.791 - in
15.792 - get_allps (cuts @ levres) (lev_on P) pts
15.793 - end;
15.794 -
15.795 -(** these 2 funs decide on how far cut_tree goes **)
15.796 -(* shall the nodes _after_ the pos to be inserted at be deleted?
15.797 - shall cutting be continued on the higher level(s)? the Nd regarded will NOT be changed *)
15.798 -fun test_trans (PrfObj {branch, ...}) = (branch = TransitiveB orelse branch = NoBranch)
15.799 - | test_trans (PblObj {branch, ...}) = (branch = TransitiveB orelse branch = NoBranch);
15.800 -
15.801 -(* cut_bottom new sml603..608
15.802 -cut the level at the bottom of the pos (used by cappend_...)
15.803 -and handle the parent in order to avoid extra case for root
15.804 -fn: ctree -> : the _whole_ ctree for cut_levup
15.805 - pos * posel -> : the pos after split_last
15.806 - ctree -> : the parent of the Nd to be cut
15.807 -return
15.808 - (ctree * : the updated ctree
15.809 - pos' list) * : the pos's cut
15.810 - bool : cutting shall be continued on the higher level(s)
15.811 -*)
15.812 -fun cut_bottom _ (pt' as Nd (b, [])) = ((pt', []), test_trans b)
15.813 - | cut_bottom (P, p) (Nd (b, bs)) =
15.814 - let (*divide level into 3 parts...*)
15.815 - val keep = take (p - 1, bs)
15.816 - val pt' = case nth p bs of
15.817 - pt' as Nd _ => pt'
15.818 - | _ => error "cut_bottom: uncovered case nth p bs"
15.819 - (*^^^^^_here_ will be 'insert_pt'ed by 'append_..'*)
15.820 - val (tail, _) = (takerest (p, bs), if null (takerest (p, bs)) then 0 else p + 1)
15.821 - val (children, cuts) =
15.822 - if test_trans b
15.823 - then
15.824 - (keep, (if is_pblnd pt' then [(P @ [p], Pbl)] else [])
15.825 - @ (get_allp [] (P @ [p], (P, Frm)) pt')
15.826 - @ (get_allps [] (P @ [p + 1]) tail))
15.827 - else (keep @ [(*'insert_pt'ed by 'append_..'*)] @ tail,
15.828 - get_allp [] (P @ [p], (P, Frm)) pt')
15.829 - val (pt'', cuts) =
15.830 - if test_trans b
15.831 - then (Nd (del_res b, children), cuts @ (if g_ostate b = Incomplete then [] else [(P, Res)]))
15.832 - else (Nd (b, children), cuts)
15.833 - in ((pt'', cuts), test_trans b) end
15.834 - | cut_bottom _ _ = error "cut_bottom: uncovered fun def.";
15.835 -
15.836 -
15.837 -(* go all levels from the bottom of 'pos' up to the root,
15.838 - on each level compose the children of a node and accumulate the cut Nds
15.839 -args
15.840 - pos' list -> : for accumulation
15.841 - bool -> : cutting shall be continued on the higher level(s)
15.842 - ctree -> : the whole ctree for 'get_nd pt P' on each level
15.843 - ctree -> : the Nd from the lower level for insertion at path
15.844 - pos * posel -> : pos=path split for convenience
15.845 - ctree -> : Nd the children of are under consideration on this call
15.846 -returns :
15.847 - ctree * pos' list : the updated parent-Nd and the pos's of the Nds cut
15.848 -*)
15.849 -fun cut_levup (cuts:pos' list) clevup pt pt' (P:pos, p:posel) (Nd (b, bs)) =
15.850 - let (*divide level into 3 parts...*)
15.851 - val keep = take (p - 1, bs)
15.852 - (*val pt' comes as argument from below*)
15.853 - val (tail, _) =
15.854 - (takerest (p, bs), if null (takerest (p, bs)) then 0 else p + 1)
15.855 - val (children, cuts') =
15.856 - if clevup
15.857 - then (keep @ [pt'], get_allps [] (P @ [p+1]) tail)
15.858 - else (keep @ [pt'] @ tail, [])
15.859 - val clevup' = if clevup then test_trans b else false
15.860 - (*the first Nd with false stops cutting on all levels above*)
15.861 - val (pt'', cuts') =
15.862 - if clevup'
15.863 - then (Nd (del_res b, children), cuts' @ (if g_ostate b = Incomplete then [] else [(P, Res)]))
15.864 - else (Nd (b, children), cuts')
15.865 - in
15.866 - if null P
15.867 - then (pt'', cuts @ cuts')
15.868 - else
15.869 - let val (P, p) = split_last P
15.870 - in cut_levup (cuts @ cuts') clevup' pt pt'' (P, p) (get_nd pt P) end
15.871 - end
15.872 - | cut_levup _ _ _ _ _ _ = error "cut_levup: uncovered fun def.";
15.873 -
15.874 -(* cut nodes after and below an inserted node in the ctree;
15.875 - the cuts range is limited by the predicate 'fun cutlevup' *)
15.876 -fun cut_tree pt (pos, _) =
15.877 - if not (existpt pos pt)
15.878 - then (pt,[]) (*appending a formula never cuts anything*)
15.879 - else
15.880 - let
15.881 - val (P, p) = split_last pos
15.882 - val ((pt', cuts), clevup) = cut_bottom (P, p) (get_nd pt P)
15.883 - (* pt' is the updated parent of the Nd to cappend_..*)
15.884 - in
15.885 - if null P
15.886 - then (pt', cuts)
15.887 - else
15.888 - let val (P, p) = split_last P
15.889 - in cut_levup cuts clevup pt pt' (P, p) (get_nd pt P) end
15.890 - end;
15.891 -
15.892 -(* get the theory explicitly specified for the rootpbl;
15.893 - thus use this function _after_ finishing specification *)
15.894 -fun rootthy (Nd (PblObj {spec = (thyID, _, _), ...}, _)) = Celem.assoc_thy thyID
15.895 - | rootthy _ = error "rootthy: uncovered fun def.";
15.896 -
15.897 -(**)
15.898 -end;
15.899 -(**)
16.1 --- a/src/Tools/isac/Specify/ctree-navi.sml Fri Oct 25 16:07:15 2019 +0200
16.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
16.3 @@ -1,240 +0,0 @@
16.4 -(* Title: navigation on the calctree
16.5 - Author: Walther Neuper 2017
16.6 - (c) due to copyright terms
16.7 -*)
16.8 -signature CALC_TREE_NAVIGATION =
16.9 -sig
16.10 - val lev_of : CTbasic.pos' -> int
16.11 - val pos_plus : int -> CTbasic.pos' -> CTbasic.pos'
16.12 - val last_onlev : CTbasic.ctree -> CTbasic.pos -> bool
16.13 - val exist_lev_on' : CTbasic.ctree -> CTbasic.pos' -> bool (* for interface.sml *)
16.14 - val is_curr_endof_calc : CTbasic.ctree -> CTbasic.pos' -> bool (* for interface.sml *)
16.15 -
16.16 - val lev_dn_ : CTbasic.pos' -> CTbasic.pos'
16.17 - val lev_up : CTbasic.pos -> CTbasic.pos
16.18 - val lev_back' : CTbasic.pos' -> CTbasic.pos' (* for inform.sml *)
16.19 - val lev_back : CTbasic.pos' -> CTbasic.pos' (* for inform.sml *)
16.20 -
16.21 - val lev_dn : CTbasic.pos -> CTbasic.pos (* duplicate in ctree-basic.sml *)
16.22 - val lev_on : CTbasic.pos -> CTbasic.pos (* duplicate in ctree-basic.sml *)
16.23 - val par_pblobj : CTbasic.ctree -> CTbasic.pos -> CTbasic.pos (* duplicate in ctree-basic.sml *)
16.24 -
16.25 - val lev_on' : CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos' (* for interface.sml *)
16.26 - val move_dn : CTbasic.pos -> CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos'
16.27 - val move_up : CTbasic.pos -> CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos'(* or interface.sml *)
16.28 - val movelevel_dn : CTbasic.pos -> CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos'(*nterface.sml *)
16.29 - val movelevel_up : CTbasic.pos -> CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos'(*nterface.sml *)
16.30 - val movecalchd_up : CTbasic.ctree -> CTbasic.pos' -> CTbasic.pos' (* for interface.sml *)
16.31 -
16.32 -(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
16.33 - (* NONE *)
16.34 -(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
16.35 - (* NONE *)
16.36 -( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
16.37 -
16.38 -(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
16.39 - (* NONE *)
16.40 -end
16.41 -
16.42 -(**)
16.43 -structure CTnavi(**): CALC_TREE_NAVIGATION(**) =
16.44 -struct
16.45 -(**)
16.46 -open CTbasic
16.47 -
16.48 -(* duplicates in ctree-basic.sml *)
16.49 -fun lev_on [] = raise PTREE "lev_on []"
16.50 - | lev_on pos =
16.51 - let val len = length pos
16.52 - in (drop_last pos) @ [(nth len pos)+1] end;
16.53 -fun lev_up [] = raise PTREE "lev_up []"
16.54 - | lev_up p = (drop_last p):pos;
16.55 -
16.56 -(*040216: for inform --> embed_deriv: remains on same level TODO.WN120517 compare lev_pred*)
16.57 -fun lev_back' ([], _) = raise PTREE "lev_back': called by ([],_)"
16.58 - | lev_back' (p, _) =
16.59 - if last_elem p <= 1 then (p, Frm)
16.60 - else ((drop_last p) @ [(nth (length p) p) - 1], Res);
16.61 -fun lev_back ([], p_) = ([], p_)
16.62 - | lev_back (p, _) =
16.63 - if last_elem p <= 1 then (p, Frm)
16.64 - else ((drop_last p) @ [(nth (length p) p) - 1], Res);
16.65 -(* increase pos by n within a level *)
16.66 -fun pos_plus 0 pos = pos
16.67 - | pos_plus n (p, Frm) = pos_plus (n - 1) (p, Res)
16.68 - | pos_plus n (p, _) = pos_plus (n - 1) (lev_on p, Res);
16.69 -
16.70 -fun lev_dn p = p @ [0];
16.71 -fun lev_dn_ (p, _) = (lev_dn p, Res)
16.72 -fun lev_of (p,_) = length p;
16.73 -
16.74 -fun last_onlev pt pos = not (existpt (lev_on pos) pt);
16.75 -
16.76 -(* find the position of the next parent which is a PblObj in ctree *)
16.77 -fun par_pblobj _ [] = []
16.78 - | par_pblobj pt p =
16.79 - let
16.80 - fun par _ [] = []
16.81 - | par pt p =
16.82 - if is_pblobj (get_obj I pt p)
16.83 - then p
16.84 - else par pt (lev_up p)
16.85 - in par pt (lev_up p) end;
16.86 -
16.87 -(* determine the next pos' on the same level *)
16.88 -fun lev_on' _ ([], Pbl) = ([], Res)
16.89 - | lev_on' pt (p, Res) =
16.90 - if get_obj g_res pt p = get_obj g_form pt (lev_on p)(*TransitiveB*)
16.91 - then if existpt' (lev_on p, Res) pt
16.92 - then (lev_on p, Res)
16.93 - else error ("lev_on': (p, Res) -> (p, Res) not existent, p = " ^ ints2str' (lev_on p))
16.94 - else (lev_on p, Frm)
16.95 - | lev_on' pt (p, _) =
16.96 - if existpt' (p, Res) pt
16.97 - then (p, Res)
16.98 - else error ("lev_on': (p, Frm) -> (p, Res) not existent, p = " ^ ints2str' p);
16.99 -
16.100 -fun exist_lev_on' pt p = (lev_on' pt p; true) handle _ => false;
16.101 -
16.102 -(* is the pos' at the last element of a calulation _AND_ can be continued *)
16.103 -fun is_curr_endof_calc _ ([],Res) = false
16.104 - | is_curr_endof_calc pt (pos as (p, _)) =
16.105 - not (exist_lev_on' pt pos) andalso get_obj g_ostate pt (lev_up p) = Incomplete;
16.106 -
16.107 -(* move one step down into existing nodes of ctree; skip Res = Frm.nxt;
16.108 - move_dn at the end of the calc-tree raises PTREE *)
16.109 -fun move_dn _ (Nd (_, ns)) ([],p_) = (* root problem *)
16.110 - (case p_ of
16.111 - Res => raise PTREE "move_dn: end of calculation"
16.112 - | _ =>
16.113 - if null ns (* go down from Pbl + Met *)
16.114 - then raise PTREE "move_dn: solve problem not started"
16.115 - else ([1], Frm))
16.116 - | move_dn P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate to end of pos *)
16.117 - if p > length ns
16.118 - then raise PTREE "move_dn: pos not existent 2"
16.119 - else move_dn (P @ [p]) (nth p ns) (ps, p_)
16.120 - | move_dn P (Nd (c, ns)) ([p], p_) = (* act on last element of pos *)
16.121 - if p > length ns
16.122 - then raise PTREE "move_dn: pos not existent 3"
16.123 - else
16.124 - (case p_ of
16.125 - Res =>
16.126 - if p = length ns (* last Res on this level: go a level up *)
16.127 - then if g_ostate c = Complete
16.128 - then (P, Res)
16.129 - else raise PTREE (ints2str' P ^ " not complete 1")
16.130 - else (* go to the next Nd on this level, or down into the next Nd *)
16.131 - if is_pblnd (nth (p + 1) ns) then (P@[p + 1], Pbl)
16.132 - else if g_res' (nth p ns) = g_form' (nth (p + 1) ns)
16.133 - then if (null o children o (nth (p + 1))) ns
16.134 - then (* take the Res if Complete *)
16.135 - if g_ostate' (nth (p + 1) ns) = Complete
16.136 - then (P@[p + 1], Res)
16.137 - else raise PTREE (ints2str' (P@[p + 1]) ^ " not complete 2")
16.138 - else (P@[p + 1, 1], Frm) (* go down into the next PrfObj *)
16.139 - else (P@[p + 1], Frm) (* take Frm: exists if the Nd exists *)
16.140 - | Frm => (*go down or to the Res of this Nd*)
16.141 - if (null o children o (nth p)) ns
16.142 - then if g_ostate' (nth p ns) = Complete then (P @ [p], Res)
16.143 - else raise PTREE (ints2str' (P @ [p])^" not complete 3")
16.144 - else (P @ [p, 1], Frm)
16.145 - | _ => (* is Pbl or Met *)
16.146 - if (null o children o (nth p)) ns
16.147 - then raise PTREE "move_dn:solve subproblem not startd"
16.148 - else (P @ [p, 1],
16.149 - if (is_pblnd o hd o children o (nth p)) ns
16.150 - then Pbl else Frm))
16.151 - | move_dn _ _ _ = error "";
16.152 -
16.153 -(* go one level down into ctree *)
16.154 -fun movelevel_dn [] (Nd (c, ns)) ([], _) = (* root problem *)
16.155 - if is_pblobj c
16.156 - then if null ns
16.157 - then raise PTREE "solve problem not started"
16.158 - else ([1], if (is_pblnd o hd) ns then Pbl else Frm)
16.159 - else raise PTREE "pos not existent 1"
16.160 - | movelevel_dn P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate towards end of pos *)
16.161 - if p > length ns
16.162 - then raise PTREE "pos not existent 2"
16.163 - else movelevel_dn (P@[p]) (nth p ns) (ps, p_)
16.164 - | movelevel_dn P (Nd (c, ns)) ([p], p_) = (*act on last element of pos*)
16.165 - if p > length ns
16.166 - then raise PTREE "pos not existent 3"
16.167 - else
16.168 - (case p_ of Res =>
16.169 - if p = length ns
16.170 - then raise PTREE "no children"
16.171 - else
16.172 - if g_branch c = TransitiveB
16.173 - then if (null o children o (nth (p+1))) ns
16.174 - then raise PTREE "no children"
16.175 - else (P @ [p+1, 1], if (is_pblnd o hd o children o (nth (p+1))) ns then Pbl else Frm)
16.176 - else if (null o children o (nth p)) ns
16.177 - then raise PTREE "no children"
16.178 - else (P @ [p, 1], if (is_pblnd o hd o children o (nth p)) ns then Pbl else Frm)
16.179 - | _ =>
16.180 - if (null o children o (nth p)) ns
16.181 - then raise PTREE "no children"
16.182 - else (P @ [p, 1], (* go down *)
16.183 - if (is_pblnd o hd o children o (nth p)) ns then Pbl else Frm))
16.184 - | movelevel_dn _ _ _ = error "";
16.185 -
16.186 -(* go to the previous position in ctree; regard TransitiveB *)
16.187 -fun move_up _ (Nd (c, ns)) ([], p_) = (*root problem*)
16.188 - if is_pblobj c
16.189 - then case p_ of Res => if null ns then ([], Pbl) (*Res -> Pbl (not Met)!*)
16.190 - else ([length ns], Res)
16.191 - | _ => raise PTREE "begin of calculation"
16.192 - else raise PTREE "pos not existent"
16.193 - | move_up P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate to end of pos *)
16.194 - if p > length ns
16.195 - then raise PTREE "pos not existent"
16.196 - else move_up (P@[p]) (nth p ns) (ps,p_)
16.197 - | move_up P (Nd (c, ns)) ([p], p_) = (* act on last element of pos *)
16.198 - if p > length ns
16.199 - then raise PTREE "pos not existent"
16.200 - else if is_pblnd (nth p ns)
16.201 - then
16.202 - case p_ of Res =>
16.203 - let val nc = (length o children o (nth p)) ns
16.204 - in
16.205 - if nc = 0
16.206 - then (P @ [p], Pbl) (* Res -> Pbl (not Met) *)
16.207 - else (P @ [p, nc], Res) end (* go down *)
16.208 - | _ => if p = 1 then (P, Pbl) else (P @ [p - 1], Res)
16.209 - else
16.210 - (case p_ of Frm =>
16.211 - if p <> 1
16.212 - then (P, Frm)
16.213 - else if is_pblobj c then (P, Pbl) else (P, Frm)
16.214 - | Res =>
16.215 - let val nc = (length o children o (nth p)) ns
16.216 - in
16.217 - if nc = 0 (* cannot go down *)
16.218 - then if g_branch c = TransitiveB andalso p <> 1
16.219 - then (P @ [p - 1], Res)
16.220 - else (P @ [p], Frm)
16.221 - else (P @ [p, nc], Res) end (* go down *)
16.222 - | _ => error "move_up, NOT is_pblnd: uncovered case pos_")
16.223 - | move_up _ _ _ = error "move_up: uncovered fun def."
16.224 -
16.225 -(* go one level up in ctree; sets the position on Frm *)
16.226 -fun movelevel_up _ _ (([], _)) = raise PTREE "pos not existent" (* root problem *)
16.227 - | movelevel_up P (Nd (_, ns)) (p :: (ps as (_ :: _)), p_) = (* iterate towards end of pos *)
16.228 - if p > length ns
16.229 - then raise PTREE "pos not existent"
16.230 - else movelevel_up (P @ [p]) (nth p ns) (ps, p_)
16.231 - | movelevel_up P (Nd (c, ns)) ([p], _) = (* act on last element of pos *)
16.232 - if p > length ns then raise PTREE "pos not existent"
16.233 - else if is_pblobj c then (P, Pbl) else (P, Frm)
16.234 - | movelevel_up _ _ _ = error "movelevel_up: uncovered fun def."
16.235 -
16.236 -(* go to the next calc-head up in the calc-tree *)
16.237 -fun movecalchd_up pt (p, Res) = (par_pblobj pt p, Pbl)
16.238 - | movecalchd_up pt (p, _) =
16.239 - if is_pblobj (get_obj I pt p)
16.240 - then (p, Pbl)
16.241 - else (par_pblobj pt p, Pbl);
16.242 -
16.243 -end
16.244 \ No newline at end of file
17.1 --- a/src/Tools/isac/Specify/ctree.sml Fri Oct 25 16:07:15 2019 +0200
17.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
17.3 @@ -1,34 +0,0 @@
17.4 -(* Title: the calctree
17.5 - Author: Walther Neuper 161228
17.6 - (c) due to copyright terms
17.7 -*)
17.8 -
17.9 -signature CTREE =
17.10 -sig
17.11 - include BASIC_CALC_TREE
17.12 - include CALC_TREE_NAVIGATION
17.13 - include CALC_TREE_ACCESS
17.14 -end
17.15 -structure Ctree : CTREE =
17.16 -struct
17.17 - open CTbasic
17.18 - open CTnavi
17.19 - open CTaccess
17.20 -end;
17.21 -(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
17.22 - open Ctree;
17.23 -( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
17.24 -
17.25 -(* policy for "open" structures:
17.26 ---------------------------------
17.27 -The above "open Ctree" creates an unclear situation with structures, in particular in test/.
17.28 -This is work in progress, but urges to make policy explicit:
17.29 -
17.30 -(1) All structures are closed with a signature; this prepares for re-arrangement of structures.
17.31 -(2) Some structures are pervasive (e.g. Ctree) such, that an "open" ensures readability locally.
17.32 -(3) test/ is preceeded by "open" for all structures, in order to ease copy&paste from scr/ to test/
17.33 -
17.34 -ad (1) Presently this point is under construction.
17.35 -ad (2) Such local "open" are kept to a minimum (with the goal to reach Isabelle's state).
17.36 -ad (3) See https://intra.ist.tugraz.at/hg/isa/file/2ba35efb07b7/test/Tools/isac/Test_Isac.thy#l70
17.37 -*)
18.1 --- a/src/Tools/isac/Specify/istate.sml Fri Oct 25 16:07:15 2019 +0200
18.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
18.3 @@ -1,146 +0,0 @@
18.4 -(* Title: interpreter-state for Lucas-Interpretation
18.5 - Author: Walther Neuper 190724
18.6 - (c) due to copyright terms
18.7 -*)
18.8 -signature INTERPRETER_STATE =
18.9 -sig
18.10 - datatype safe = Sundef | Safe | Unsafe | Helpless;
18.11 - val safe2str: safe -> string
18.12 -
18.13 - type pstate
18.14 - val e_scrstate: pstate
18.15 - val scrstate2str: Rule.subst * Celem.loc_ * term option * term * safe * bool -> string
18.16 -
18.17 - datatype T = RrlsState of Rule.rrlsstate | Pstate of pstate | Uistate
18.18 - val istate2str: T -> string
18.19 - val istates2str: T option * T option -> string
18.20 - val e_istate: T
18.21 -
18.22 - val get_path: pstate -> Celem.loc_
18.23 - val get_path_up: pstate -> Celem.loc_
18.24 - val get_act: pstate -> term
18.25 - val get_env: pstate -> Env.T
18.26 - val get_act_env: pstate -> (term * Env.T)
18.27 -(*val get_form_env: pstate -> (term option * Env.T)*)
18.28 - val get_subst: pstate -> (Env.T * (term option * term))
18.29 - val get_assoc: pstate -> bool
18.30 -
18.31 - val trans_ass: pstate -> pstate -> pstate
18.32 - val trans_env_act: pstate -> pstate -> pstate
18.33 -
18.34 - val path_down: Celem.loc_ -> pstate -> pstate
18.35 - val path_down_form: (Celem.loc_ * term) -> pstate -> pstate
18.36 - val path_up: pstate -> pstate
18.37 - val path_up_down: Celem.loc_ -> pstate -> pstate
18.38 -
18.39 - val upd_form: term -> pstate -> pstate
18.40 - val upd_env: Env.T -> pstate -> pstate
18.41 - val upd_env': term -> pstate -> pstate
18.42 - val upd_env'': Env.T * (term * term) -> pstate -> pstate
18.43 - val upd_form_env: (term * Env.T) -> pstate -> pstate
18.44 - val upd_act_env: (term * Env.T) -> pstate -> pstate
18.45 - val upd_subst: Env.T -> (term * term) -> pstate -> pstate
18.46 - val upd_subst_true: (term option * term) -> pstate -> pstate
18.47 - val upd_subst_false: (term option * term) -> pstate -> pstate
18.48 -
18.49 -end
18.50 -
18.51 -(**)
18.52 -structure Istate(**): INTERPRETER_STATE(**) =
18.53 -struct
18.54 -(**)
18.55 -
18.56 -datatype safe = Sundef | Safe | Unsafe | Helpless;
18.57 -fun safe2str Sundef = "Sundef"
18.58 - | safe2str Safe = "Safe"
18.59 - | safe2str Unsafe = "Unsafe"
18.60 - | safe2str Helpless = "Helpless";
18.61 -
18.62 -type pstate = (* state for script interpreter *)
18.63 - Env.T(*stack*) (* used to instantiate tac for checking associate
18.64 - 12.03.noticed: e_ not updated during execution ?!? *)
18.65 - * Celem.loc_ (* location of tac in script *)
18.66 - * term option (*id FORMal ARGument of curried functions *)
18.67 - * term (*vl ACTual ARGument (value) for execution of Tactic.T
18.68 - updated also after a derivation by 'new_val' *)
18.69 - * safe (* estimation of how result will be obtained *)
18.70 - * bool; (* true = strongly .., false = weakly associated:
18.71 - only used during ass_dn/up *)
18.72 -val e_scrstate =
18.73 - ([]: Env.T, []:Celem.loc_, SOME Rule.e_term, Rule.e_term, Sundef, false) : pstate
18.74 -fun topt2str NONE = "NONE"
18.75 - | topt2str (SOME t) = "SOME" ^ Rule.term2str t;
18.76 -fun scrstate2str (env, loc_, topt, t, safe, bool) = (* for tests only *)
18.77 - "(" ^ Env.env2str env ^ ", " ^ Celem.loc_2str loc_ ^ ", " ^ topt2str topt ^ ", \n" ^
18.78 - Rule.term2str t ^ ", " ^ safe2str safe ^ ", " ^ bool2str bool ^ ")";
18.79 -
18.80 -(* for handling type T see fun from_pblobj_or_detail', +? *)
18.81 -datatype T = (*interpreter state*)
18.82 - Uistate (*undefined in modspec, in '_deriv'ation*)
18.83 - | Pstate of pstate (*for script interpreter*)
18.84 - | RrlsState of Rule.rrlsstate; (*for reverse rewriting*)
18.85 -val e_istate = (Pstate ([], [], NONE, Rule.e_term, Sundef, false));
18.86 -
18.87 -fun rta2str (r, (t, a)) = "\n(" ^ Rule.rule2str r ^ ",(" ^ Rule.term2str t ^", " ^ Rule.terms2str a ^ "))";
18.88 -fun istate2str Uistate = "Uistate"
18.89 - | istate2str (Pstate (e, l, to, t, s, b)) =
18.90 - "Pstate ("^ Env.subst2str e ^ ",\n " ^
18.91 - Celem.loc_2str l ^ ", " ^ Rule.termopt2str to ^ ",\n " ^
18.92 - Rule.term2str t ^ ", " ^ safe2str s ^ ", " ^ bool2str b ^ ")"
18.93 - | istate2str (RrlsState (t, t1, rss, rtas)) =
18.94 - "RrlsState (" ^ Rule.term2str t ^ ", " ^ Rule.term2str t1 ^ ", " ^
18.95 - (strs2str o (map (strs2str o (map Rule.rule2str)))) rss ^ ", " ^
18.96 - (strs2str o (map rta2str)) rtas ^ ")";
18.97 -fun istates2str (NONE, NONE) = "(#NONE, #NONE)" (* for tests only *)
18.98 - | istates2str (NONE, SOME ist) = "(#NONE,\n#SOME " ^ istate2str ist ^ ")"
18.99 - | istates2str (SOME ist, NONE) = "(#SOME " ^ istate2str ist ^ ",\n #NONE)"
18.100 - | istates2str (SOME i1, SOME i2) = "(#SOME " ^ istate2str i1 ^ ",\n #SOME " ^ istate2str i2 ^ ")";
18.101 -
18.102 -fun get_path (_, path, _, _, _, _) = path
18.103 -fun get_path_up (ist as (_, path, _, _, _, _)) =
18.104 - if length path > 1 then drop_last path else raise ERROR ("get_path_up [] with " ^ scrstate2str ist)
18.105 -fun get_act (_, _, _, act_arg, _, _) = act_arg
18.106 -fun get_env (env, _, _, _, _, _) = env
18.107 -fun get_act_env (env, _, _, act_arg, _, _) = (act_arg, env)
18.108 -(*fun get_form_env (env, _, form_arg, _, _, _) = (form_arg, env)*)
18.109 -fun get_assoc (_, _, _, _, _, ass) = ass
18.110 -fun get_subst (env, _, form_arg, act_arg, _, _) = (env, (form_arg, act_arg))
18.111 -
18.112 -fun trans_ass (_, _, _, _, _, ass) (env, path, form_arg, act_arg, safe, _) =
18.113 - (env, path, form_arg, act_arg, safe, ass)
18.114 -fun trans_env_act (env, _, _, act_arg, _, _) (_, path, form_arg, _, safe, ass) =
18.115 - (env, path, form_arg, act_arg, safe, ass)
18.116 -
18.117 -fun path_down path (env, p, form_arg, act_arg, safe, ass) =
18.118 - (env, p @ path, form_arg, act_arg, safe, ass)
18.119 -fun path_down_form (path, form_arg) (env, p, _, act_arg, safe, ass) =
18.120 - (env, p @ path, SOME form_arg, act_arg, safe, ass)
18.121 -fun path_up (env, path, form_arg, act_arg, safe, ass) =
18.122 - (env, drop_last path, form_arg, act_arg, safe, ass)
18.123 -fun path_up_down path (env, p, form_arg, act_arg, safe, ass) =
18.124 - (env, (drop_last p) @ path, form_arg, act_arg, safe, ass)
18.125 -
18.126 -fun upd_form form (env, path, _, act_arg, safe, ass) =
18.127 - (env, path, SOME form, act_arg, safe, ass)
18.128 -
18.129 -fun upd_env env (_, path, form_arg, act_arg, safe, ass) =
18.130 - (env, path, form_arg, act_arg, safe, ass)
18.131 -fun upd_env' form (env, path, form_arg, act_arg, safe, ass) =
18.132 - (Env.upd_env env (form, act_arg), path, form_arg, act_arg, safe, ass)
18.133 -fun upd_env'' (env, (form, act)) (_, path, _, _, safe, ass) =
18.134 - (Env.upd_env env (form, act), path, SOME form, act, safe, ass)
18.135 -
18.136 -fun upd_form_env (form_arg, env) (_, path, _, act_arg, safe, ass) =
18.137 - (env, path, SOME form_arg, act_arg, safe, ass)
18.138 -fun upd_act_env (act_arg, env) (_, path, form_arg, _, safe, ass) =
18.139 - (env, path, form_arg, act_arg, safe, ass)
18.140 -
18.141 -fun upd_subst env (form_arg, act_arg) (_, path, _, _, safe, ass) =
18.142 - (env, path, SOME form_arg, act_arg, safe, ass)
18.143 -fun upd_subst_true (form_arg, act_arg) (env, path, _, _, safe, _) =
18.144 - (env, path, form_arg, act_arg, safe, true)
18.145 -fun upd_subst_false (form_arg, act_arg) (env, path, _, _, safe, _) =
18.146 - (env, path, form_arg, act_arg, safe, false)
18.147 -
18.148 -end
18.149 -
19.1 --- a/src/Tools/isac/Specify/model.sml Fri Oct 25 16:07:15 2019 +0200
19.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
19.3 @@ -1,470 +0,0 @@
19.4 -(* Title: Model for (sub-)calculations.
19.5 - Various representations: item and ppc for frontend, itm_ and itm for internal functions.
19.6 - The former are related to structure Specify, the latter to structure Chead --
19.7 - -- apt to re-arrangement of structures
19.8 - Author: Walther Neuper 170207
19.9 - (c) due to copyright terms
19.10 -*)
19.11 -
19.12 -signature MODEL =
19.13 -sig
19.14 - type ori
19.15 - val oris2str : ori list -> string
19.16 - val e_ori : ori
19.17 - datatype item
19.18 - = Correct of Rule.cterm' | False of Rule.cterm' | Incompl of Rule.cterm' | Missing of Rule.cterm' | Superfl of string
19.19 - | SyntaxE of string | TypeE of string
19.20 - datatype itm_ = Cor of (term * (term list)) * (term * (term list))
19.21 - | Syn of Rule.cterm' | Typ of Rule.cterm' | Inc of (term * (term list)) * (term * (term list))
19.22 - | Sup of (term * (term list)) | Mis of (term * term) | Par of Rule.cterm'
19.23 - val itm_2str : itm_ -> string
19.24 - val itm_2str_ : Proof.context -> itm_ -> string
19.25 - type itm
19.26 - val itm2str_ : Proof.context -> itm -> string
19.27 - val itms2str_ : Proof.context -> itm list -> string
19.28 - val e_itm : itm
19.29 - type 'a ppc
19.30 - val empty_ppc : item ppc
19.31 - val ppc2str : {Find: string list, Given: string list, Relate: string list, Where: string list,
19.32 - With: string list} -> string
19.33 - val itemppc2str : item ppc -> string
19.34 -
19.35 - type vats
19.36 - val comp_dts : term * term list -> term
19.37 - val comp_dts' : term * term list -> term
19.38 - val comp_dts'' : term * term list -> string
19.39 - val comp_ts : term * term list -> term
19.40 - val split_dts : term -> term * term list
19.41 - val split_dts' : term * term -> term list
19.42 - val pbl_ids' : term -> term list -> term list
19.43 - val mkval' : term list -> term
19.44 -
19.45 - val d_in : itm_ -> term
19.46 - val ts_in : itm_ -> term list
19.47 - val penvval_in : itm_ -> term list
19.48 - val mk_env : itm list -> (term * term) list (* close to Chead.all_dsc_in, Chead.is_error, etc *)
19.49 - val vars_of : itm list -> term list
19.50 - val max_vt : itm list -> int
19.51 -
19.52 -(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
19.53 - type penv
19.54 - val penv2str_ : Proof.context -> penv -> string (* NONE *)
19.55 - type preori
19.56 - val preoris2str : preori list -> string
19.57 -(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
19.58 - (* NONE *)
19.59 -( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
19.60 -
19.61 -(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
19.62 - val untouched : itm list -> bool
19.63 - type envv
19.64 - val upds_envv : Proof.context -> envv -> (vats * term * term * term) list -> envv
19.65 - val item_ppc : string ppc -> item ppc
19.66 - val all_ts_in : itm_ list -> term list
19.67 - val pres2str : (bool * term) list -> string
19.68 -end
19.69 -
19.70 -structure Model(**) : MODEL(**) =
19.71 -struct
19.72 -(*==========================================================================
19.73 -23.3.02 TODO: ideas on redesign of type itm_,type item,type ori,type item ppc
19.74 -(1) kinds of itms:
19.75 - (1.1) untouched: for modeling only dsc displayed(impossible after match_itms)
19.76 - =(presently) Mis (? should be Inc initially, and Mis after match_itms?)
19.77 - (1.2) Syn,Typ,Sup: not related to oris
19.78 - Syn, Typ (presently) should be accepted in appl_add (instead Error')
19.79 - Sup (presently) should be accepted in appl_add (instead Error')
19.80 - _could_ be w.r.t current vat (and then _is_ related to vat
19.81 - Mis should _not_ be made Inc ((presently, by appl_add & match_itms)
19.82 -- dsc in itm_ is timeconsuming -- keep id for respective queries ?
19.83 -- order of items in ppc should be stable w.r.t order of itms
19.84 -
19.85 -- stepwise input of itms --- match_itms (in one go) ..not coordinated
19.86 - - unify code
19.87 - - match_itms / match_itms_oris ..2 versions ?!
19.88 - (fast, for refine / slow, for modeling)
19.89 -
19.90 -- clarify: efficiency <--> simplicity !!!
19.91 - ?: shift dsc itm_ -> itm | discard int in ori,itm | take int instead dsc
19.92 - | take int for perserving order of item ppc in itms
19.93 - | make all(!?) handling of itms stable against reordering(?)
19.94 - | field in ori ?? (not from fmz!) -- meant for efficiency (not doc!???)
19.95 - -"- "#undef" ?= not touched ?= (id,..)
19.96 ------------------------------------------------------------------
19.97 -27.3.02:
19.98 -def: type pbt = (field, (dsc, pid)) *** design considerations ***
19.99 -
19.100 -(1) fmz + pbt -> oris
19.101 -(2) input + oris -> itm
19.102 -(3) match_itms : schnell(?) f"ur refine
19.103 - match_itms_oris : r"uckmeldung f"ur item ppc
19.104 -
19.105 -(1.1) in oris fehlt daher pid: (i,v,f,d,ts,pid)
19.106 ----------- ^^^^^ --- dh. pbt meist als argument zu viel !!!
19.107 -
19.108 -(3.1) abwarten, wie das matchen mehr unterschiedlicher pbt's sich macht;
19.109 - wenn Problem pbt v"ollig neue, dann w"are eigentlich n"otig ????:
19.110 - (a) (_,_,d1,ts,_):ori + pbt -> (i,vt,d2,ts,pid) dh.vt neu ????
19.111 - (b)
19.112 -==========================================================================*)
19.113 -
19.114 -val script_parse = the o (@{theory ProgLang} |> Rule.thy2ctxt |> TermC.parseNEW);
19.115 -val e_listReal = script_parse "[]::(real list)";
19.116 -val e_listBool = script_parse "[]::(bool list)";
19.117 -
19.118 -(* take list-term apart w.r.t. handling elementwise input: @{term "[a, b]"} \<rightarrow> ["[a]","[b]"] *)
19.119 -fun take_apart t =
19.120 - let val elems = TermC.isalist2list t
19.121 - in map ((TermC.list2isalist (type_of (hd elems))) o single) elems end;
19.122 -fun take_apart_inv ts = (* t = (take_apart_inv o take_apart) t *)
19.123 - let val elems = (flat o (map TermC.isalist2list)) ts;
19.124 - in TermC.list2isalist (type_of (hd elems)) elems end;
19.125 -
19.126 -fun is_var (Free _) = true
19.127 - | is_var _ = false;
19.128 -
19.129 -(* special handling for lists. ?WN:14.5.03 ??!? *)
19.130 -fun dest_list (d, ts) =
19.131 - let fun dest t =
19.132 - if Input_Descript.is_list_dsc d andalso not (Input_Descript.is_unl d) andalso not (is_var t) (*..for pbt*)
19.133 - then TermC.isalist2list t
19.134 - else [t]
19.135 - in (flat o (map dest)) ts end;
19.136 -
19.137 -(* revert split_dts only for ts; compare comp_dts *)
19.138 -fun comp_ts (d, ts) =
19.139 - if Input_Descript.is_list_dsc d
19.140 - then if TermC.is_list (hd ts)
19.141 - then if Input_Descript.is_unl d
19.142 - then (hd ts) (* e.g. someList [1,3,2] *)
19.143 - else (take_apart_inv ts) (* [ [a], [b] ] -> [a,b] *)
19.144 - else (hd ts) (* a variable or metavariable for a list *)
19.145 - else (hd ts);
19.146 -fun comp_dts (d, []) =
19.147 - if Input_Descript.is_reall_dsc d
19.148 - then (d $ e_listReal)
19.149 - else if Input_Descript.is_booll_dsc d then (d $ e_listBool) else d
19.150 - | comp_dts (d, ts) = (d $ (comp_ts (d, ts)))
19.151 - handle _ => error ("comp_dts: " ^ Rule.term2str d ^ " $ " ^ Rule.term2str (hd ts));
19.152 -fun comp_dts' (d, []) =
19.153 - if Input_Descript.is_reall_dsc d
19.154 - then (d $ e_listReal)
19.155 - else if Input_Descript.is_booll_dsc d then (d $ e_listBool) else d
19.156 - | comp_dts' (d, ts) = (d $ (comp_ts (d, ts)))
19.157 - handle _ => error ("comp_dts': " ^ Rule.term2str d ^ " $ " ^ Rule.term2str (hd ts));
19.158 -fun comp_dts'' (d, []) =
19.159 - if Input_Descript.is_reall_dsc d
19.160 - then Rule.term2str (d $ e_listReal)
19.161 - else if Input_Descript.is_booll_dsc d
19.162 - then Rule.term2str (d $ e_listBool)
19.163 - else Rule.term2str d
19.164 - | comp_dts'' (d, ts) = Rule.term2str (d $ (comp_ts (d, ts)))
19.165 - handle _ => error ("comp_dts'': " ^ Rule.term2str d ^ " $ " ^ Rule.term2str (hd ts));
19.166 -
19.167 -(* decompose an input into description, terms (ev. elems of lists),
19.168 - and the value for the problem-environment; inv to comp_dts *)
19.169 -fun split_dts (t as d $ arg) =
19.170 - if Input_Descript.is_dsc d
19.171 - then if Input_Descript.is_list_dsc d andalso TermC.is_list arg andalso Input_Descript.is_unl d |> not
19.172 - then (d, take_apart arg)
19.173 - else (d, [arg])
19.174 - else (Rule.e_term, TermC.dest_list' t)
19.175 - | split_dts t =
19.176 - let val t' as (h, _) = strip_comb t;
19.177 - in
19.178 - if Input_Descript.is_dsc h
19.179 - then (h, dest_list t')
19.180 - else (Rule.e_term, TermC.dest_list' t)
19.181 - end;
19.182 -(* version returning ts only *)
19.183 -fun split_dts' (d, arg) =
19.184 - if Input_Descript.is_dsc d
19.185 - then if Input_Descript.is_list_dsc d
19.186 - then if TermC.is_list arg
19.187 - then if Input_Descript.is_unl d
19.188 - then ([arg]) (* e.g. someList [1,3,2] *)
19.189 - else (take_apart arg) (* [a,b] --> SML[ [a], [b] ]SML *)
19.190 - else ([arg]) (* a variable or metavariable for a list *)
19.191 - else ([arg])
19.192 - else (TermC.dest_list' arg)
19.193 -(* WN170204: Warning "redundant"
19.194 - | split_dts' (d, t) = (*either dsc or term; 14.5.03 only copied*)
19.195 - let val (h,argl) = strip_comb t
19.196 - in
19.197 - if (not o is_dsc) h
19.198 - then (dest_list' t)
19.199 - else (dest_list (h,argl))
19.200 - end;*)
19.201 -(* revert split_:
19.202 - WN050903 we do NOT know which is from subtheory, description or term;
19.203 - typecheck thus may lead to TYPE-error 'unknown constant';
19.204 - solution: typecheck with (Thy_Info_get_theory "Isac_Knowledge"); i.e. arg 'thy' superfluous*)
19.205 -(*fun comp_dts thy (d,[]) =
19.206 - Thm.global_cterm_of (*(sign_of o assoc_thy) "Isac_Knowledge"*)
19.207 - (Thy_Info_get_theory "Isac_Knowledge")
19.208 - (*comp_dts:FIXXME stay with term for efficiency !!!*)
19.209 - (if is_reall_dsc d then (d $ e_listReal)
19.210 - else if is_booll_dsc d then (d $ e_listBool)
19.211 - else d)
19.212 - | comp_dts (d,ts) =
19.213 - (Thm.global_cterm_of (*(sign_of o assoc_thy) "Isac_Knowledge"*)
19.214 - (Thy_Info_get_theory "Isac_Knowledge")
19.215 - (*comp_dts:FIXXME stay with term for efficiency !!*)
19.216 - (d $ (comp_ts (d, ts)))
19.217 - handle _ => error ("comp_dts: "^(term2str d)^
19.218 - " $ "^(term2str (hd ts))));*)
19.219 -
19.220 -(* 27.8.01: problem-environment
19.221 -WN.6.5.03: FIXXME reconsider if penv is worth the effort --
19.222 - -- just rerun a whole expl with num/var may show the same ?!
19.223 -WN.9.5.03: penv-concept stalled, immediately generate script env !
19.224 - but [#0, epsilon] only outcommented for eventual reconsideration *)
19.225 -type penv = (* problem-environment *)
19.226 - (term (* err_ *)
19.227 - * (term list) (* [#0, epsilon] 9.5.03 outcommented *)
19.228 - ) list;
19.229 -fun pen2str ctxt (t, ts) =
19.230 - pair2str (Rule.term_to_string' ctxt t, (strs2str' o map (Rule.term_to_string' ctxt)) ts);
19.231 -fun penv2str_ thy penv = (strs2str' o (map (pen2str thy))) penv;
19.232 -
19.233 -(* get the constant value from a penv *)
19.234 -fun getval (id, values) =
19.235 - case values of
19.236 - [] => error ("penv_value: no values in '" ^ Rule.term2str id)
19.237 - | [v] => (id, v)
19.238 - | (v1 :: v2 :: _) => (case v1 of
19.239 - Const ("Program.Arbfix",_) => (id, v2)
19.240 - | _ => (id, v1));
19.241 -
19.242 -(* 9.5.03: still unused, but left for eventual future development *)
19.243 -type envv = (int * penv) list; (* over variants *)
19.244 -
19.245 -(* 14.9.01: not used after putting penv-values into itm_
19.246 - make the result of split_* a value of problem-environment *)
19.247 -fun mkval _(*dsc*) [] = error "mkval called with []"
19.248 - | mkval _ [t] = t
19.249 - | mkval _ ts = TermC.list2isalist ((type_of o hd) ts) ts;
19.250 -fun mkval' x = mkval Rule.e_term x;
19.251 -
19.252 -(* the internal representation of a models' item
19.253 - 4.9.01: not consistent:
19.254 - after Init_Proof 'Inc', but after copy_probl 'Mis' - for same situation
19.255 - (involves 'is_error');
19.256 - bool in itm really necessary ???*)
19.257 -datatype itm_ =
19.258 - Cor of (term * (* description *)
19.259 - (term list)) * (* for list: elem-wise input *)
19.260 - (term * (term list)) (* elem of penv ---- penv delayed to future *)
19.261 -| Syn of Rule.cterm'
19.262 -| Typ of Rule.cterm'
19.263 -| Inc of (term * (term list)) * (term * (term list)) (*lists,
19.264 - + init_pbl WN.11.03 FIXXME: empty penv .. bad; init_pbl should return Mis !!! *)
19.265 -| Sup of (term * (term list)) (* user-input not found in pbt(+?oris?11.03)*)
19.266 -| Mis of (term * term) (* after re-specification pbt-item not found in pbl: only dsc, pid_*)
19.267 -| Par of Rule.cterm'; (* internal state from fun parsitm *)
19.268 -
19.269 -type vats = int list; (* variants in formalizations *)
19.270 -
19.271 -(* data-type for working on pbl/met-ppc:
19.272 - in pbl initially holds descriptions (only) for user guidance *)
19.273 -type itm =
19.274 - int * (* id =0 .. untouched - descript (only) from init
19.275 - seems to correspond to ori (fun insert_ppc) <> maintain order in item ppc? *)
19.276 - vats * (* variants - copy from ori *)
19.277 - bool * (* input on this item is not/complete *)
19.278 - string * (* #Given | #Find | #Relate *)
19.279 - itm_; (* *)
19.280 -val e_itm = (0, [], false, "e_itm", Syn "e_itm");
19.281 -
19.282 -(* in CalcTree/Subproblem an 'untouched' model is created
19.283 - FIXME.WN.9.03 model should be filled to 'untouched' by Model/Refine_Problem*)
19.284 -fun untouched itms = foldl and_ (true , map ((curry op = 0) o (#1 : itm -> int)) itms);
19.285 -
19.286 -(* find most frequent variant v in itms *)
19.287 -fun vts_in itms = (distinct o flat o (map #2)) (itms:itm list);
19.288 -
19.289 -fun cnt itms v = (v, (length o (filter (curry op = v)) o flat o (map #2)) itms);
19.290 -fun vts_cnt vts itms = map (cnt itms) vts;
19.291 -fun max2 [] = error "max2 of []"
19.292 - | max2 (y :: ys) =
19.293 - let
19.294 - fun mx (a,x) [] = (a,x)
19.295 - | mx (a, x) ((b,y) :: ys) = if x < y then mx (b, y) ys else mx (a, x) ys;
19.296 - in mx y ys end;
19.297 -
19.298 -(* find the variant with most items already input *)
19.299 -fun max_vt itms =
19.300 - let val vts = (vts_cnt (vts_in itms)) itms;
19.301 - in if vts = [] then 0 else (fst o max2) vts end;
19.302 -
19.303 -(* TODO ev. make more efficient by avoiding flat *)
19.304 -fun mk_e (Cor (_, iv)) = [getval iv]
19.305 - | mk_e (Syn _) = []
19.306 - | mk_e (Typ _) = []
19.307 - | mk_e (Inc (_, iv)) = [getval iv]
19.308 - | mk_e (Sup _) = []
19.309 - | mk_e (Mis _) = []
19.310 - | mk_e _ = error "mk_e: uncovered case in fun.def.";
19.311 -fun mk_en vt (_, vts, _, _, itm_) = if member op = vts vt then mk_e itm_ else [];
19.312 -
19.313 -(* extract the environment from an item list; takes the variant with most items *)
19.314 -fun mk_env itms =
19.315 - let val vt = max_vt itms
19.316 - in (flat o (map (mk_en vt))) itms end;
19.317 -
19.318 -(* example as provided by an author, complete w.r.t. pbt specified
19.319 - not touched by any user action *)
19.320 -type ori =
19.321 - (int * (* id: 10.3.00ff impl. only <>0 .. touched
19.322 - 21.3.02: insert_ppc needs it ! ?:purpose maintain order in item ppc ??? *)
19.323 - vats * (* variants 21.3.02: related to pbt..discard ? *)
19.324 - string * (* #Given | #Find | #Relate 21.3.02: discard ? *)
19.325 - term * (* description *)
19.326 - term list (* isalist2list t | [t] *)
19.327 - );
19.328 -val e_ori = (0, [], "", Rule.e_term, [Rule.e_term]) : ori;
19.329 -
19.330 -fun ori2str (i, vs, fi, t, ts) =
19.331 - "(" ^ string_of_int i ^ ", " ^ (strs2str o (map string_of_int)) vs ^ ", " ^ fi ^ "," ^
19.332 - Rule.term2str t ^ ", " ^ (strs2str o (map Rule.term2str)) ts ^ ")";
19.333 -val oris2str = strs2str' o (map (Celem.linefeed o ori2str));
19.334 -
19.335 -(* an or without leading integer *)
19.336 -type preori = (vats * string * term * term list);
19.337 -fun preori2str (vs, fi, t, ts) =
19.338 - "(" ^ (strs2str o (map string_of_int)) vs ^ ", " ^ fi ^ ", " ^
19.339 - Rule.term2str t ^ ", " ^ (strs2str o (map Rule.term2str)) ts ^ ")";
19.340 -val preoris2str = (strs2str' o (map (Celem.linefeed o preori2str)));
19.341 -
19.342 -(* 9.5.03 penv postponed: pbl_ids' *)
19.343 -fun pbl_ids' d vs = [comp_ts (d, vs)];
19.344 -
19.345 -(* 14.9.01: not used after putting values for penv into itm_
19.346 - WN.5.5.03: used in upd .. upd_envv *)
19.347 -fun upd_penv ctxt penv dsc (id, vl) =
19.348 -(tracing"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
19.349 - tracing"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
19.350 - tracing"### upd_penv used !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
19.351 - overwrite (penv, (id, Input_Descript.pbl_ids ctxt dsc vl))
19.352 -);
19.353 -
19.354 -(* WN.9.5.03: not reconsidered; looks strange !!!*)
19.355 -fun upd thy envv dsc (id, vl) i =
19.356 - let val penv = case assoc (envv, i) of
19.357 - SOME e => e
19.358 - | NONE => [];
19.359 - val penv' = upd_penv thy penv dsc (id, vl);
19.360 - in (i, penv') end;
19.361 -
19.362 -(* 14.9.01: not used after putting pre-penv into itm_*)
19.363 -fun upd_envv thy envv vats dsc id vl =
19.364 - let val vats = if length vats = 0
19.365 - then (*unknown id to _all_ variants*)
19.366 - if length envv = 0 then [1]
19.367 - else (intsto o length) envv
19.368 - else vats
19.369 - fun isin vats (i, _) = member op = vats i;
19.370 - val envs_notin_vat = filter_out (isin vats) envv;
19.371 - in (map (upd thy envv dsc (id, vl)) vats) @ envs_notin_vat end;
19.372 -
19.373 -(* update envv by folding from a list of arguments *)
19.374 -fun upds_envv _ envv [] = envv
19.375 - | upds_envv thy envv ((vs, dsc, id, vl) :: ps) =
19.376 - upds_envv thy (upd_envv thy envv vs dsc id vl) ps;
19.377 -
19.378 -(* for _output_ of the items of a Model *)
19.379 -datatype item =
19.380 - Correct of Rule.cterm' (* labels a correct formula (type cterm') *)
19.381 - | SyntaxE of string (**)
19.382 - | TypeE of string (**)
19.383 - | False of Rule.cterm' (* WN050618 notexistent in itm_: only used in Where *)
19.384 - | Incompl of Rule.cterm' (**)
19.385 - | Superfl of string (**)
19.386 - | Missing of Rule.cterm';
19.387 -fun item2str (Correct s) ="Correct " ^ s
19.388 - | item2str (SyntaxE s) ="SyntaxE " ^ s
19.389 - | item2str (TypeE s) ="TypeE " ^ s
19.390 - | item2str (False s) ="False " ^ s
19.391 - | item2str (Incompl s) ="Incompl " ^ s
19.392 - | item2str (Superfl s) ="Superfl " ^ s
19.393 - | item2str (Missing s) ="Missing " ^ s;
19.394 -(*make string for error-msgs*)
19.395 -fun itm_2str_ ctxt (Cor ((d, ts), penv)) =
19.396 - "Cor " ^ Rule.term_to_string' ctxt (comp_dts (d, ts)) ^ " ," ^ pen2str ctxt penv
19.397 - | itm_2str_ _ (Syn c) = "Syn " ^ c
19.398 - | itm_2str_ _ (Typ c) = "Typ " ^ c
19.399 - | itm_2str_ ctxt (Inc ((d, ts), penv)) =
19.400 - "Inc " ^ Rule.term_to_string' ctxt (comp_dts (d, ts)) ^ " ," ^ pen2str ctxt penv
19.401 - | itm_2str_ ctxt (Sup (d, ts)) =
19.402 - "Sup " ^ Rule.term_to_string' ctxt (comp_dts (d, ts))
19.403 - | itm_2str_ ctxt (Mis (d, pid)) =
19.404 - "Mis "^ Rule.term_to_string' ctxt d ^ " " ^ Rule.term_to_string' ctxt pid
19.405 - | itm_2str_ _ (Par s) = "Trm "^s;
19.406 -fun itm_2str t = itm_2str_ (Rule.thy2ctxt' "Isac_Knowledge") t;
19.407 -fun itm2str_ ctxt ((i, is, b, s, itm_):itm) =
19.408 - "(" ^ string_of_int i ^ " ," ^ ints2str' is ^ " ," ^ bool2str b ^ " ," ^
19.409 - s ^ " ," ^ itm_2str_ ctxt itm_ ^ ")";
19.410 -fun itms2str_ ctxt itms = strs2str' (map (Celem.linefeed o (itm2str_ ctxt)) itms);
19.411 -fun init_item str = SyntaxE str;
19.412 -
19.413 -type 'a ppc =
19.414 - {Given : 'a list, Where: 'a list, Find : 'a list, With : 'a list, Relate: 'a list};
19.415 -fun ppc2str {Given = Given, Where = Where, Find = Find, With = With, Relate = Relate}=
19.416 - "{Given =" ^ strs2str Given ^ ",Where=" ^ strs2str Where ^ ",Find =" ^ strs2str Find ^
19.417 - ",With =" ^ strs2str With ^ ",Relate=" ^ strs2str Relate ^ "}";
19.418 -
19.419 -fun item_ppc {Given = gi, Where= wh, Find = fi, With = wi, Relate= re} =
19.420 - {Given = map init_item gi, Where= map init_item wh, Find = map init_item fi,
19.421 - With = map init_item wi, Relate= map init_item re};
19.422 -fun itemppc2str ({Given=Given,Where=Where,
19.423 - Find=Find,With=With,Relate=Relate}:item ppc)=
19.424 - ("{Given =" ^ ((strs2str' o (map item2str)) Given ) ^
19.425 - ",Where=" ^ ((strs2str' o (map item2str)) Where) ^
19.426 - ",Find =" ^ ((strs2str' o (map item2str)) Find ) ^
19.427 - ",With =" ^ ((strs2str' o (map item2str)) With ) ^
19.428 - ",Relate=" ^ ((strs2str' o (map item2str)) Relate) ^ "}");
19.429 -
19.430 -val empty_ppc = {Given = [], Where= [], Find = [], With = [], Relate= []};
19.431 -
19.432 -fun ts_in (Cor ((_, ts), _)) = ts
19.433 - | ts_in (Syn _) = []
19.434 - | ts_in (Typ _) = []
19.435 - | ts_in (Inc ((_, ts), _)) = ts
19.436 - | ts_in (Sup (_, ts)) = ts
19.437 - | ts_in (Mis _) = []
19.438 - | ts_in _ = error "ts_in: uncovered case in fun.def.";
19.439 -(*WN050629 unused*)
19.440 -fun all_ts_in itm_s = (flat o (map ts_in)) itm_s;
19.441 -val unique = (Thm.term_of o the o (TermC.parse @{theory "Real"} )) "UnIqE_tErM";
19.442 -fun d_in (Cor ((d ,_), _)) = d
19.443 - | d_in (Syn c) = (tracing ("*** d_in: Syn ("^c^")"); unique)
19.444 - | d_in (Typ c) = (tracing ("*** d_in: Typ ("^c^")"); unique)
19.445 - | d_in (Inc ((d, _), _)) = d
19.446 - | d_in (Sup (d, _)) = d
19.447 - | d_in (Mis (d, _)) = d
19.448 - | d_in _ = error "d_in: uncovered case in fun.def.";
19.449 -
19.450 -fun dts2str (d, ts) = pair2str (Rule.term2str d, Rule.terms2str ts);
19.451 -fun penvval_in (Cor ((d, _), (_, ts))) = [comp_ts (d,ts)]
19.452 - | penvval_in (Syn (c)) = (tracing("*** penvval_in: Syn ("^c^")"); [])
19.453 - | penvval_in (Typ (c)) = (tracing("*** penvval_in: Typ ("^c^")"); [])
19.454 - | penvval_in (Inc (_, (_, ts))) = ts
19.455 - | penvval_in (Sup dts) = (tracing ("*** penvval_in: Sup "^(dts2str dts)); [])
19.456 - | penvval_in (Mis (d, t)) = (tracing ("*** penvval_in: Mis " ^
19.457 - pair2str(Rule.term2str d, Rule.term2str t)); [])
19.458 - | penvval_in _ = error "penvval_in: uncovered case in fun.def.";
19.459 -
19.460 -(* check a predicate labelled with indication of incomplete substitution;
19.461 - rls -> (* for eval_true *)
19.462 - bool * (* have _all_ variables(Free) from the model-pattern
19.463 - been substituted by a value from the pattern's environment ?*)
19.464 - term -> (* the precondition *)
19.465 - bool * (* has the precondition evaluated to true *)
19.466 - term (* the precondition (for map) *)
19.467 -*)
19.468 -fun pre2str (b, t) = pair2str(bool2str b, Rule.term2str t);
19.469 -fun pres2str pres = strs2str' (map (Celem.linefeed o pre2str) pres);
19.470 -
19.471 -fun vars_of itms = itms |> mk_env |> map snd
19.472 -
19.473 -end;
19.474 \ No newline at end of file
20.1 --- a/src/Tools/isac/Specify/mstools.sml Fri Oct 25 16:07:15 2019 +0200
20.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
20.3 @@ -1,98 +0,0 @@
20.4 -(* Title: tools for 'modeling' und 'specifying' to be used in
20.5 - modspec.sml. The types are separated into this file,
20.6 - because some of them are stored in the calc-tree, and thus are required
20.7 - _before_ ctree.sml.
20.8 - TODO: allocate elements of Selem and of Stool appropriately
20.9 - Author: Walther Neuper, Mathias Lehnfeld
20.10 - (c) due to copyright terms
20.11 -*)
20.12 -
20.13 -signature SPECIFY_TOOL =
20.14 -sig
20.15 - val check_preconds : 'a -> Rule.rls -> term list -> Model.itm list -> (bool * term) list
20.16 - val check_preconds' : Rule.rls -> term list -> Model.itm list -> 'a -> (bool * term) list
20.17 -
20.18 - datatype match_ = Match_ of Celem.pblID * (Model.itm list * (bool * term) list) | NoMatch_
20.19 - val refined_ : match_ list -> match_ option
20.20 - datatype match = Matches of Celem.pblID * Model.item Model.ppc | NoMatch of Celem.pblID * Model.item Model.ppc
20.21 - val matchs2str : match list -> string
20.22 - val common_subthy : theory * theory -> theory
20.23 -(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
20.24 - val pres2str : (bool * term) list -> string
20.25 - val refined : match list -> Celem.pblID
20.26 -(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
20.27 - (*NONE*)
20.28 -( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
20.29 -
20.30 -(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
20.31 - val pblID_of_match : match -> Celem.pblID
20.32 - val refined_IDitms : match list -> match option
20.33 -end
20.34 -
20.35 -structure Stool(**) : SPECIFY_TOOL(**) =
20.36 -struct
20.37 -
20.38 -datatype match =
20.39 - Matches of Celem.pblID * Model.item Model.ppc
20.40 -| NoMatch of Celem.pblID * Model.item Model.ppc;
20.41 -fun match2str (Matches (pI, ppc)) = "Matches (" ^ strs2str pI ^ ", " ^ Model.itemppc2str ppc ^ ")"
20.42 - | match2str (NoMatch (pI, ppc)) = "NoMatch (" ^ strs2str pI ^ ", " ^ Model.itemppc2str ppc ^ ")";
20.43 -fun matchs2str ms = (strs2str o (map match2str)) ms;
20.44 -fun pblID_of_match (Matches (pI, _)) = pI
20.45 - | pblID_of_match (NoMatch (pI, _)) = pI;
20.46 -
20.47 -(* 10.03 for Refine_Problem *)
20.48 -datatype match_ =
20.49 - Match_ of Celem.pblID * (( Model.itm list) * ((bool * term) list))
20.50 -| NoMatch_;
20.51 -
20.52 -(* the refined pbt is the last_element Matches in the list *)
20.53 -fun is_matches (Matches _) = true
20.54 - | is_matches _ = false;
20.55 -fun matches_pblID (Matches (pI, _)) = pI
20.56 - | matches_pblID _ = error "matches_pblID: uncovered case in fun.def.";
20.57 -fun refined ms = ((matches_pblID o the o (find_first is_matches) o rev) ms)
20.58 - handle _ => [];
20.59 -fun refined_IDitms ms = ((find_first is_matches) o rev) ms;
20.60 -
20.61 -(* the refined pbt is the last_element Matches in the list, for Refine_Problem, tryrefine *)
20.62 -fun is_matches_ (Match_ _) = true
20.63 - | is_matches_ _ = false;
20.64 -fun refined_ ms = ((find_first is_matches_) o rev) ms;
20.65 -
20.66 -(* check a predicate labelled with indication of incomplete substitution;
20.67 - rls -> (* for eval_true *)
20.68 - bool * (* have _all_ variables(Free) from the model-pattern
20.69 - been substituted by a value from the pattern's environment ?*)
20.70 - term -> (* the precondition *)
20.71 - bool * (* has the precondition evaluated to true *)
20.72 - term (* the precondition (for map) *)
20.73 -*)
20.74 -fun evalprecond _ (false, pre) =
20.75 - (*NOT ALL Free's have been substituted, eg. because of incomplete model*)
20.76 - (false, pre)
20.77 - | evalprecond prls (true, pre) =
20.78 - if Rewrite.eval_true (Celem.assoc_thy "Isac_Knowledge") (* for Pattern.match *)
20.79 - [pre] prls (* pre parsed, prls.thy *)
20.80 - then (true , pre)
20.81 - else (false , pre);
20.82 -
20.83 -fun pre2str (b, t) = pair2str (bool2str b, Rule.term2str t);
20.84 -fun pres2str pres = strs2str' (map (Celem.linefeed o pre2str) pres);
20.85 -
20.86 -(* check preconditions, return true if all true *)
20.87 -fun check_preconds' _ [] _ _ = [] (* empty preconditions are true *)
20.88 - | check_preconds' prls pres pbl _ (* FIXME.WN0308 mvat re-introduce *) =
20.89 - let
20.90 - val env = Model.mk_env pbl;
20.91 - val pres' = map (TermC.subst_atomic_all env) pres;
20.92 - in map (evalprecond prls) pres' end;
20.93 -fun check_preconds _(*thy*) prls pres pbl = check_preconds' prls pres pbl (Model.max_vt pbl);
20.94 -
20.95 -
20.96 -fun common_subthy (thy1, thy2) =
20.97 - if Context.subthy (thy1, thy2) then thy2
20.98 - else if Context.subthy (thy2, thy1) then thy1
20.99 - else Celem.assoc_thy "Isac_Knowledge"
20.100 -
20.101 -end;
21.1 --- a/src/Tools/isac/Specify/specification-elems.sml Fri Oct 25 16:07:15 2019 +0200
21.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
21.3 @@ -1,112 +0,0 @@
21.4 -(* Title: Specify-phase: specifying and modeling a problem or a subproblem. The
21.5 - most important types are declared in mstools.sml.
21.6 - TODO: allocate elements of Selem and of Stool appropriately
21.7 - Author: Walther Neuper 991122, Mathias Lehnfeld
21.8 - (c) due to copyright terms
21.9 -*)
21.10 -signature SPECIFY_ELEMENT =
21.11 -sig
21.12 - type fmz
21.13 - type fmz_
21.14 - type result
21.15 - val res2str : term * term list -> string
21.16 - type subs (* substitution as seen by learner. rename stubst_user ["(''bdv'', x)"]*)
21.17 - type sube (* = subs. delete ! = stubst_user *)
21.18 - type subte (* _sub_stitution as _t_erms of _e_qualities: revise ! [bdv = x] *)
21.19 - type subst' (* substitution in isac-programs; rename subst_prog [(bdv, x)] *)
21.20 -(*type subst for rewriting, in Rule (+?Isabelle); rename subst_rew [(bools, x)] *)
21.21 - (* TODO use these types in functions below and elsewhere; rename below according to types *)
21.22 - val subst'_to_sube : subst' -> Rule.cterm' list (* e.g. rename to subst_user_of_prog *)
21.23 - val subst_to_subst' : Rule.subst -> subst'
21.24 - val subst'_to_subst : subst' -> (term * term) list
21.25 - val sube2str : Rule.cterm' list -> string
21.26 - val sube2subst : theory -> Rule.cterm' list -> (term * term) list
21.27 - val sube2subte : Rule.cterm' list -> term list
21.28 - val subs2subst : theory -> Rule.cterm' list -> (term * term) list
21.29 - val subst2sube : (term * term) list -> Rule.cterm' list (* for datatypes.sml *)
21.30 - val subst2subs : (term * term) list -> Rule.cterm' list
21.31 - val subst2subs' : (term * term) list -> (string * string) list
21.32 - val subte2sube : term list -> Rule.cterm' list
21.33 -
21.34 -(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
21.35 - val e_fmz : fmz_ * Celem.spec (* for datatypes.sml *)
21.36 - val e_sube : Rule.cterm' list
21.37 - val e_subs : string list
21.38 - val subte2subst : term list -> (term * term) list
21.39 -(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
21.40 - (* NONE *)
21.41 -( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
21.42 -
21.43 -(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
21.44 -(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
21.45 - (* NONE *)
21.46 -end
21.47 -
21.48 -structure Selem(**): SPECIFY_ELEMENT(**) =
21.49 -struct
21.50 -
21.51 -fun subst2str s =
21.52 - (strs2str o
21.53 - (map (
21.54 - Celem.linefeed o pair2str o (apsnd Rule.term2str) o (apfst Rule.term2str)))) s;
21.55 -type fmz_ = Rule.cterm' list;
21.56 -(* a formalization of an example contains data
21.57 - sufficient for mechanically finding the solution for the example.
21.58 - FIXME.WN051014: dont store fmz = (_,spec) in the PblObj, this is done in origin *)
21.59 -type fmz = fmz_ * Celem.spec;
21.60 -val e_fmz = ([], Celem.e_spec);
21.61 -
21.62 -type result = term * term list
21.63 -fun res2str (t, ts) = pair2str (Rule.term2str t, Rule.terms2str ts); (* for tests only *)
21.64 -
21.65 -type subs = Rule.cterm' list; (* substitution as seen by learner in tactics, in programs, etc.
21.66 - questionable design. rename to stubst_user *)
21.67 -val e_subs = ["(''bdv'', x)"]; (* for tests only *)
21.68 -
21.69 -(* argument type of tac Rewrite_Inst *)
21.70 -type sube = Rule.cterm' list; (* = subs. delete *)
21.71 -val e_sube = []: Rule.cterm' list; (* for tests only *)
21.72 -fun sube2str s = strs2str s;
21.73 -
21.74 -type subte = term list; (* _sub_stitution as _t_erms of _e_qualities: revise ! *)
21.75 -
21.76 -type subst' = term; (* substitution in isac-programs. rename to subst_prog
21.77 - is "(char list * term) list", where term is Free ("xxx", _)
21.78 - e.g. @{term "[(''bdv_1'', x::real), (''bdv_2'', y::real), (''bdv_3'', z::real)]"} *)
21.79 -fun subst'_to_sube sub = (sub
21.80 - |> HOLogic.dest_list
21.81 - |> map HOLogic.dest_prod
21.82 - |> map (fn (e1, e2) => (HOLogic.dest_string e1, Rule.term2str e2))
21.83 - |> map (fn (e1, e2) => "(''" ^ e1 ^ "'', " ^ e2 ^ ")"): Rule.cterm' list)
21.84 - handle TERM _ => raise TERM ("subst'_to_sube: wrong argument ", [sub])
21.85 -fun subst_to_subst' subst = subst
21.86 - |> map (apfst TermC.free2str)
21.87 - |> map (apfst HOLogic.mk_string)
21.88 - |> map HOLogic.mk_prod
21.89 - |> HOLogic.mk_list (HOLogic.mk_prodT (HOLogic.stringT, HOLogic.realT (*FIXME: 'a*)))
21.90 -fun subst'_to_subst t = (t
21.91 - |> HOLogic.dest_list
21.92 - |> map HOLogic.dest_prod
21.93 - |> map (apfst HOLogic.dest_string))
21.94 - |> map (apfst (fn e1 => (TermC.mk_Free (e1, HOLogic.realT))))
21.95 - handle TERM _ => raise TERM ("subst'_to_subst: wrong argument ", [t])
21.96 -val subte2sube = map Rule.term2str;
21.97 -fun subst2subs subst_rew = (subst_rew
21.98 - |> map (apsnd Rule.term2str)
21.99 - |> map (apfst Rule.term2str)
21.100 - |> map (apfst (enclose "''" "''")))
21.101 - |> map pair2str
21.102 - handle TERM _ => raise TERM ("subst2subs: wrong argument " ^ subst2str subst_rew, [])
21.103 -fun subst2sube subst = map Rule.term2str (map HOLogic.mk_eq subst)
21.104 -val subst2subs' = map ((apfst Rule.term2str) o (apsnd Rule.term2str));
21.105 -fun subs2subst thy subs = (subs
21.106 - |> map (TermC.parse_patt thy(*FIXME use context, get type of snd (e.g. x,y,z), copy to fst*))
21.107 - |> map TermC.isapair2pair
21.108 - |> map (apfst HOLogic.dest_string)
21.109 - |> map (apfst (fn str => (TermC.mk_Free (str, HOLogic.realT)))))
21.110 - handle TERM _ => raise TERM ("subs2subst: wrong argument " ^ strs2str' subs, [])
21.111 -fun sube2subst thy s = map (TermC.dest_equals o (TermC.parse_patt thy)) s;
21.112 -val sube2subte = map TermC.str2term;
21.113 -val subte2subst = map HOLogic.dest_eq;
21.114 -
21.115 -end
22.1 --- a/src/Tools/isac/Specify/tactic.sml Fri Oct 25 16:07:15 2019 +0200
22.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
22.3 @@ -1,448 +0,0 @@
22.4 -(* Title: Tactics; tac_ for interaction with frontend, input for internal use.
22.5 - Author: Walther Neuper 170121
22.6 - (c) due to copyright terms
22.7 -
22.8 -regular expression for search:
22.9 -
22.10 -Add_Find|Add_Given|Add_Relation|Apply_Assumption|Apply_Method|Begin_Sequ|Begin_Trans|Split_And|Split_Or|Split_Intersect|Conclude_And|Conclude_Or|Collect_Trues|End_Sequ|End_Trans|End_Ruleset|End_Subproblem|End_Intersect|End_Proof|CAScmd|Calculate|Check_Postcond|Check_elementwise|Del_Find|Del_Given|Del_Relation|Derive|Detail_Set|Detail_Set_Inst|End_Detail|Empty_Tac|Free_Solve|Init_Proof|Model_Problem Or_to_List|Refine_Problem|Refine_Tacitly| Rewrite|Rewrite_Asm|Rewrite_Inst|Rewrite_Set|Rewrite_Set_Inst|Specify_Method|Specify_Problem|Specify_Theory|Subproblem|Substitute|Tac|Take|Take_Inst
22.11 -
22.12 -*)
22.13 -signature TACTIC =
22.14 -sig
22.15 - datatype T =
22.16 - Add_Find' of Rule.cterm' * Model.itm list | Add_Given' of Rule.cterm' * Model.itm list
22.17 - | Add_Relation' of Rule.cterm' * Model.itm list
22.18 - | Apply_Assumption' of term list * term
22.19 - | Apply_Method' of Celem.metID * term option * Istate.T * Proof.context
22.20 -
22.21 - | Begin_Sequ' | Begin_Trans' of term
22.22 - | Split_And' of term | Split_Or' of term | Split_Intersect' of term
22.23 - | Conclude_And' of term | Conclude_Or' of term | Collect_Trues' of term
22.24 - | End_Sequ' | End_Trans' of Selem.result
22.25 - | End_Ruleset' of term | End_Subproblem' of term | End_Intersect' of term | End_Proof''
22.26 -
22.27 - | CAScmd' of term
22.28 - | Calculate' of Rule.theory' * string * term * (term * Celem.thm')
22.29 - | Check_Postcond' of Celem.pblID * Selem.result
22.30 - | Check_elementwise' of term * Rule.cterm' * Selem.result
22.31 - | Del_Find' of Rule.cterm' | Del_Given' of Rule.cterm' | Del_Relation' of Rule.cterm'
22.32 -
22.33 - | Derive' of Rule.rls
22.34 - | Detail_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
22.35 - | Detail_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
22.36 - | End_Detail' of Selem.result
22.37 -
22.38 - | Empty_Tac_
22.39 - | Free_Solve'
22.40 -
22.41 - | Init_Proof' of Rule.cterm' list * Celem.spec
22.42 - | Model_Problem' of Celem.pblID * Model.itm list * Model.itm list
22.43 - | Or_to_List' of term * term
22.44 - | Refine_Problem' of Celem.pblID * (Model.itm list * (bool * term) list)
22.45 - | Refine_Tacitly' of Celem.pblID * Celem.pblID * Rule.domID * Celem.metID * Model.itm list
22.46 -
22.47 - | Rewrite' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
22.48 - | Rewrite_Asm' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
22.49 - | Rewrite_Inst' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Rule.subst * Celem.thm'' * term * Selem.result
22.50 - | Rewrite_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
22.51 - | Rewrite_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
22.52 -
22.53 - | Specify_Method' of Celem.metID * Model.ori list * Model.itm list
22.54 - | Specify_Problem' of Celem.pblID * (bool * (Model.itm list * (bool * term) list))
22.55 - | Specify_Theory' of Rule.domID
22.56 - | Subproblem' of Celem.spec * Model.ori list * term * Selem.fmz_ * Proof.context * term
22.57 - | Substitute' of Rule.rew_ord_ * Rule.rls * Selem.subte * term * term
22.58 - | Tac_ of theory * string * string * string
22.59 - | Take' of term | Take_Inst' of term
22.60 - val tac_2str : T -> string
22.61 -
22.62 - datatype input =
22.63 - Add_Find of Rule.cterm' | Add_Given of Rule.cterm' | Add_Relation of Rule.cterm'
22.64 - | Apply_Assumption of Rule.cterm' list
22.65 - | Apply_Method of Celem.metID
22.66 - (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
22.67 - | Begin_Sequ | Begin_Trans
22.68 - | Split_And | Split_Or | Split_Intersect
22.69 - | Conclude_And | Conclude_Or | Collect_Trues
22.70 - | End_Sequ | End_Trans
22.71 - | End_Ruleset | End_Subproblem | End_Intersect | End_Proof'
22.72 - (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
22.73 - | CAScmd of Rule.cterm'
22.74 - | Calculate of string
22.75 - | Check_Postcond of Celem.pblID
22.76 - | Check_elementwise of Rule.cterm'
22.77 - | Del_Find of Rule.cterm' | Del_Given of Rule.cterm' | Del_Relation of Rule.cterm'
22.78 -
22.79 - | Derive of Rule.rls'
22.80 - | Detail_Set of Rule.rls'
22.81 - | Detail_Set_Inst of Selem.subs * Rule.rls'
22.82 - | End_Detail
22.83 -
22.84 - | Empty_Tac
22.85 - | Free_Solve
22.86 -
22.87 - | Init_Proof of Rule.cterm' list * Celem.spec
22.88 - | Model_Problem
22.89 - | Or_to_List
22.90 - | Refine_Problem of Celem.pblID
22.91 - | Refine_Tacitly of Celem.pblID
22.92 -
22.93 - | Rewrite of Celem.thm''
22.94 - | Rewrite_Asm of Celem.thm''
22.95 - | Rewrite_Inst of Selem.subs * Celem.thm''
22.96 - | Rewrite_Set of Rule.rls'
22.97 - | Rewrite_Set_Inst of Selem.subs * Rule.rls'
22.98 -
22.99 - | Specify_Method of Celem.metID
22.100 - | Specify_Problem of Celem.pblID
22.101 - | Specify_Theory of Rule.domID
22.102 - | Subproblem of Rule.domID * Celem.pblID
22.103 -
22.104 - | Substitute of Selem.sube
22.105 - | Tac of string
22.106 - | Take of Rule.cterm' | Take_Inst of Rule.cterm'
22.107 - val tac2str : input -> string
22.108 -
22.109 - val eq_tac : input * input -> bool (* for script.sml *)
22.110 - val is_empty_tac : input -> bool (* also for tests *)
22.111 - val is_rewtac : input -> bool (* for interface.sml *)
22.112 - val is_rewset : input -> bool (* for mathengine.sml *)
22.113 - val rls_of : input -> Rule.rls' (* for solve.sml *)
22.114 - val tac2IDstr : input -> string
22.115 - val rule2tac : theory -> (term * term) list -> Rule.rule -> input (* for rewtools.sml *)
22.116 -(* ---- for tests only: shifted from below to remove the Warning "unused" at fun.def. --------- *)
22.117 - (* NONE *)
22.118 -(*/-------------------------------------------------------- ! aktivate for Test_Isac BEGIN ---\* )
22.119 - (* NONE *)
22.120 -( *\--- ! aktivate for Test_Isac END ----------------------------------------------------------/*)
22.121 -
22.122 -(*----- unused code, kept as hints to design ideas ---------------------------------------------*)
22.123 - (* NONE *)
22.124 -end
22.125 -
22.126 -structure Tactic(**): TACTIC(**) =
22.127 -struct
22.128 -
22.129 -(* tactics for user at front-end.
22.130 - input propagates the construction of the calc-tree;
22.131 - there are
22.132 - (a) 'specsteps' for the specify-phase, and others for the solve-phase
22.133 - (b) those of the solve-phase are 'initac's and others;
22.134 - initacs start with a formula different from the preceding formula.
22.135 - see 'type tac_' for the internal representation of tactics
22.136 -*)
22.137 -datatype input =
22.138 - Add_Find of Rule.cterm' | Add_Given of Rule.cterm' | Add_Relation of Rule.cterm'
22.139 - | Apply_Assumption of Rule.cterm' list
22.140 - | Apply_Method of Celem.metID
22.141 - (* creates an "istate" in PblObj.env; in case of "init_form"
22.142 - creates a formula at ((lev_on o lev_dn) p, Frm) and in this "ppobj.loc"
22.143 - a "SOME istate" at fst of "loc".
22.144 - As each step (in the solve-phase) has a resulting formula (at the front-end)
22.145 - Apply_Method also does the 1st step in the script (an "initac") if there is no "init_form" *)
22.146 - (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
22.147 - | Begin_Sequ | Begin_Trans
22.148 - | Split_And | Split_Or | Split_Intersect
22.149 - | Conclude_And | Conclude_Or | Collect_Trues
22.150 - | End_Sequ | End_Trans
22.151 - | End_Ruleset | End_Subproblem (* WN0509 drop *) | End_Intersect | End_Proof'
22.152 - (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
22.153 - | CAScmd of Rule.cterm'
22.154 - | Calculate of string
22.155 - | Check_Postcond of Celem.pblID
22.156 - | Check_elementwise of Rule.cterm'
22.157 - | Del_Find of Rule.cterm' | Del_Given of Rule.cterm' | Del_Relation of Rule.cterm'
22.158 -
22.159 - | Derive of Rule.rls' (* WN0509 drop *)
22.160 - | Detail_Set of Rule.rls' (* WN0509 drop *)
22.161 - | Detail_Set_Inst of Selem.subs * Rule.rls' (* WN0509 drop *)
22.162 - | End_Detail (* WN0509 drop *)
22.163 -
22.164 - | Empty_Tac
22.165 - | Free_Solve
22.166 -
22.167 - | Init_Proof of Rule.cterm' list * Celem.spec
22.168 - | Model_Problem
22.169 - | Or_to_List
22.170 - | Refine_Problem of Celem.pblID
22.171 - | Refine_Tacitly of Celem.pblID
22.172 -
22.173 - (* rewrite-tactics can transport a (thmID, thm) to and (!) from the java-front-end
22.174 - because there all the thms are present with both (thmID, thm)
22.175 - (where user-views can show both or only one of (thmID, thm)),
22.176 - and thm is created from ThmID by assoc_thm'' when entering isabisac *)
22.177 - | Rewrite of Celem.thm''
22.178 - | Rewrite_Asm of Celem.thm''
22.179 - | Rewrite_Inst of Selem.subs * Celem.thm''
22.180 - | Rewrite_Set of Rule.rls'
22.181 - | Rewrite_Set_Inst of Selem.subs * Rule.rls'
22.182 -
22.183 - | Specify_Method of Celem.metID
22.184 - | Specify_Problem of Celem.pblID
22.185 - | Specify_Theory of Rule.domID
22.186 - | Subproblem of Rule.domID * Celem.pblID (* WN0509 drop *)
22.187 -
22.188 - | Substitute of Selem.sube
22.189 - | Tac of string (* WN0509 drop *)
22.190 - | Take of Rule.cterm' | Take_Inst of Rule.cterm'
22.191 -
22.192 -fun tac2str ma = case ma of
22.193 - Init_Proof (ppc, spec) =>
22.194 - "Init_Proof "^(pair2str (strs2str ppc, Celem.spec2str spec))
22.195 - | Model_Problem => "Model_Problem "
22.196 - | Refine_Tacitly pblID => "Refine_Tacitly " ^ strs2str pblID
22.197 - | Refine_Problem pblID => "Refine_Problem " ^ strs2str pblID
22.198 - | Add_Given cterm' => "Add_Given " ^ cterm'
22.199 - | Del_Given cterm' => "Del_Given " ^ cterm'
22.200 - | Add_Find cterm' => "Add_Find " ^ cterm'
22.201 - | Del_Find cterm' => "Del_Find " ^ cterm'
22.202 - | Add_Relation cterm' => "Add_Relation " ^ cterm'
22.203 - | Del_Relation cterm' => "Del_Relation " ^ cterm'
22.204 -
22.205 - | Specify_Theory domID => "Specify_Theory " ^ quote domID
22.206 - | Specify_Problem pblID => "Specify_Problem " ^ strs2str pblID
22.207 - | Specify_Method metID => "Specify_Method " ^ strs2str metID
22.208 - | Apply_Method metID => "Apply_Method " ^ strs2str metID
22.209 - | Check_Postcond pblID => "Check_Postcond " ^ strs2str pblID
22.210 - | Free_Solve => "Free_Solve"
22.211 -
22.212 - | Rewrite_Inst (subs, (id, thm)) =>
22.213 - "Rewrite_Inst " ^ (pair2str (subs2str subs, spair2str (id, thm |> Thm.prop_of |> Rule.term2str)))
22.214 - | Rewrite (id, thm) => "Rewrite " ^ spair2str (id, thm |> Thm.prop_of |> Rule.term2str)
22.215 - | Rewrite_Asm (id, thm) => "Rewrite_Asm " ^ spair2str (id, thm |> Thm.prop_of |> Rule.term2str)
22.216 - | Rewrite_Set_Inst (subs, rls) =>
22.217 - "Rewrite_Set_Inst " ^ pair2str (subs2str subs, quote rls)
22.218 - | Rewrite_Set rls => "Rewrite_Set " ^ quote rls
22.219 - | Detail_Set rls => "Detail_Set " ^ quote rls
22.220 - | Detail_Set_Inst (subs, rls) => "Detail_Set_Inst " ^ pair2str (subs2str subs, quote rls)
22.221 - | End_Detail => "End_Detail"
22.222 - | Derive rls' => "Derive " ^ rls'
22.223 - | Calculate op_ => "Calculate " ^ op_
22.224 - | Substitute sube => "Substitute " ^ Selem.sube2str sube
22.225 - | Apply_Assumption ct's => "Apply_Assumption " ^ strs2str ct's
22.226 -
22.227 - | Take cterm' => "Take " ^ quote cterm'
22.228 - | Take_Inst cterm' => "Take_Inst " ^ quote cterm'
22.229 - | Subproblem (domID, pblID) => "Subproblem " ^ pair2str (domID, strs2str pblID)
22.230 - | End_Subproblem => "End_Subproblem"
22.231 - | CAScmd cterm' => "CAScmd " ^ quote cterm'
22.232 -
22.233 - | Check_elementwise cterm'=> "Check_elementwise " ^ quote cterm'
22.234 - | Or_to_List => "Or_to_List "
22.235 - | Collect_Trues => "Collect_Trues"
22.236 -
22.237 - | Empty_Tac => "Empty_Tac"
22.238 - | Tac string => "Tac " ^ string
22.239 - | End_Proof' => "input End_Proof'"
22.240 - | _ => "tac2str not impl. for ?!";
22.241 -
22.242 -fun is_empty_tac input = case input of Empty_Tac => true | _ => false
22.243 -
22.244 -fun eq_tac (Rewrite (id1, _), Rewrite (id2, _)) = id1 = id2
22.245 - | eq_tac (Rewrite_Inst (_, (id1, _)), Rewrite_Inst (_, (id2, _))) = id1 = id2
22.246 - | eq_tac (Rewrite_Set id1, Rewrite_Set id2) = id1 = id2
22.247 - | eq_tac (Rewrite_Set_Inst (_, id1), Rewrite_Set_Inst (_, id2)) = id1 = id2
22.248 - | eq_tac (Calculate id1, Calculate id2) = id1 = id2
22.249 - | eq_tac _ = false
22.250 -
22.251 -fun is_rewset (Rewrite_Set_Inst _) = true
22.252 - | is_rewset (Rewrite_Set _) = true
22.253 - | is_rewset _ = false;
22.254 -fun is_rewtac (Rewrite _) = true
22.255 - | is_rewtac (Rewrite_Inst _) = true
22.256 - | is_rewtac (Rewrite_Asm _) = true
22.257 - | is_rewtac input = is_rewset input;
22.258 -
22.259 -fun tac2IDstr ma = case ma of
22.260 - Model_Problem => "Model_Problem"
22.261 - | Refine_Tacitly _ => "Refine_Tacitly"
22.262 - | Refine_Problem _ => "Refine_Problem"
22.263 - | Add_Given _ => "Add_Given"
22.264 - | Del_Given _ => "Del_Given"
22.265 - | Add_Find _ => "Add_Find"
22.266 - | Del_Find _ => "Del_Find"
22.267 - | Add_Relation _ => "Add_Relation"
22.268 - | Del_Relation _ => "Del_Relation"
22.269 -
22.270 - | Specify_Theory _ => "Specify_Theory"
22.271 - | Specify_Problem _ => "Specify_Problem"
22.272 - | Specify_Method _ => "Specify_Method"
22.273 - | Apply_Method _ => "Apply_Method"
22.274 - | Check_Postcond _ => "Check_Postcond"
22.275 - | Free_Solve => "Free_Solve"
22.276 -
22.277 - | Rewrite_Inst _ => "Rewrite_Inst"
22.278 - | Rewrite _ => "Rewrite"
22.279 - | Rewrite_Asm _ => "Rewrite_Asm"
22.280 - | Rewrite_Set_Inst _ => "Rewrite_Set_Inst"
22.281 - | Rewrite_Set _ => "Rewrite_Set"
22.282 - | Detail_Set _ => "Detail_Set"
22.283 - | Detail_Set_Inst _ => "Detail_Set_Inst"
22.284 - | Derive _ => "Derive "
22.285 - | Calculate _ => "Calculate "
22.286 - | Substitute _ => "Substitute"
22.287 - | Apply_Assumption _ => "Apply_Assumption"
22.288 -
22.289 - | Take _ => "Take"
22.290 - | Take_Inst _ => "Take_Inst"
22.291 - | Subproblem _ => "Subproblem"
22.292 - | End_Subproblem => "End_Subproblem"
22.293 - | CAScmd _ => "CAScmd"
22.294 -
22.295 - | Check_elementwise _ => "Check_elementwise"
22.296 - | Or_to_List => "Or_to_List "
22.297 - | Collect_Trues => "Collect_Trues"
22.298 -
22.299 - | Empty_Tac => "Empty_Tac"
22.300 - | Tac _ => "Tac "
22.301 - | End_Proof' => "End_Proof'"
22.302 - | _ => "tac2str not impl. for ?!";
22.303 -
22.304 -fun rls_of (Rewrite_Set_Inst (_, rls)) = rls
22.305 - | rls_of (Rewrite_Set rls) = rls
22.306 - | rls_of input = error ("rls_of: called with input \"" ^ tac2IDstr input ^ "\"");
22.307 -
22.308 -fun rule2tac thy _ (Rule.Calc (opID, _)) = Calculate (assoc_calc thy opID)
22.309 - | rule2tac _ [] (Rule.Thm thm'') = Rewrite thm''
22.310 - | rule2tac _ subst (Rule.Thm thm'') =
22.311 - Rewrite_Inst (Selem.subst2subs subst, thm'')
22.312 - | rule2tac _ [] (Rule.Rls_ rls) = Rewrite_Set (Rule.id_rls rls)
22.313 - | rule2tac _ subst (Rule.Rls_ rls) =
22.314 - Rewrite_Set_Inst (Selem.subst2subs subst, (Rule.id_rls rls))
22.315 - | rule2tac _ _ rule =
22.316 - error ("rule2tac: called with \"" ^ Rule.rule2str rule ^ "\"");
22.317 -
22.318 -(* tactics for for internal use, compare "input" for user at the front-end.
22.319 - tac_ contains results from check in 'fun applicable_in'.
22.320 - This is useful for costly results, e.g. from rewriting;
22.321 - however, these results might be changed by Scripts like
22.322 - " eq = (Rewrite_Set ''ansatz_rls'' False) eql;" ^
22.323 - " eq = (Rewrite_Set equival_trans False) eq;" ^
22.324 - TODO.WN120106 ANALOGOUSLY TO Substitute':
22.325 - So tac_ contains the term t the result was calculated from
22.326 - in order to compare t with t' possibly changed by "Expr "
22.327 - and re-calculate result if t<>t'
22.328 - TODO.WN161219: replace *every* cterm' by term
22.329 -*)
22.330 - datatype T =
22.331 - Add_Find' of Rule.cterm' * Model.itm list | Add_Given' of Rule.cterm' * Model.itm list
22.332 - | Add_Relation' of Rule.cterm' * Model.itm list
22.333 - | Apply_Assumption' of term list * term
22.334 - | Apply_Method' of Celem.metID * term option * Istate.T * Proof.context
22.335 - (*/--- TODO: re-design ? -----------------------------------------------------------------\*)
22.336 - | Begin_Sequ' | Begin_Trans' of term
22.337 - | Split_And' of term | Split_Or' of term | Split_Intersect' of term
22.338 - | Conclude_And' of term | Conclude_Or' of term | Collect_Trues' of term
22.339 - | End_Sequ' | End_Trans' of Selem.result
22.340 - | End_Ruleset' of term | End_Subproblem' of term | End_Intersect' of term | End_Proof''
22.341 - (*\--- TODO: re-design ? -----------------------------------------------------------------/*)
22.342 - | CAScmd' of term
22.343 - | Calculate' of Rule.theory' * string * term * (term * Celem.thm')
22.344 - | Check_Postcond' of Celem.pblID *
22.345 - Selem.result (* returnvalue of script in solve *)
22.346 - | Check_elementwise' of (*special case:*)
22.347 - term * (* (1) the current formula: [x=1,x=...] *)
22.348 - string * (* (2) the pred from Check_elementwise *)
22.349 - Selem.result (* (3) composed from (1) and (2): {x. pred} *)
22.350 - | Del_Find' of Rule.cterm' | Del_Given' of Rule.cterm' | Del_Relation' of Rule.cterm'
22.351 -
22.352 - | Derive' of Rule.rls
22.353 - | Detail_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
22.354 - | Detail_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
22.355 - | End_Detail' of Selem.result
22.356 -
22.357 - | Empty_Tac_
22.358 - | Free_Solve'
22.359 -
22.360 - | Init_Proof' of Rule.cterm' list * Celem.spec
22.361 - | Model_Problem' of Celem.pblID *
22.362 - Model.itm list * (* the 'untouched' pbl *)
22.363 - Model.itm list (* the casually completed met *)
22.364 - | Or_to_List' of term * term
22.365 - | Refine_Problem' of Celem.pblID * (Model.itm list * (bool * term) list)
22.366 - | Refine_Tacitly' of
22.367 - Celem.pblID * (* input*)
22.368 - Celem.pblID * (* the refined from applicable_in *)
22.369 - Rule.domID * (* from new pbt?! filled in specify *)
22.370 - Celem.metID * (* from new pbt?! filled in specify *)
22.371 - Model.itm list (* drop ! 9.03: remains [] for Model_Problem recognizing its activation *)
22.372 - | Rewrite' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
22.373 - | Rewrite_Asm' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Celem.thm'' * term * Selem.result
22.374 - | Rewrite_Inst' of Rule.theory' * Rule.rew_ord' * Rule.rls * bool * Rule.subst * Celem.thm'' * term * Selem.result
22.375 - | Rewrite_Set' of Rule.theory' * bool * Rule.rls * term * Selem.result
22.376 - | Rewrite_Set_Inst' of Rule.theory' * bool * Rule.subst * Rule.rls * term * Selem.result
22.377 -
22.378 - | Specify_Method' of Celem.metID * Model.ori list * Model.itm list
22.379 - | Specify_Problem' of Celem.pblID *
22.380 - (bool * (* matches *)
22.381 - (Model.itm list * (* ppc *)
22.382 - (bool * term) list)) (* preconditions *)
22.383 - | Specify_Theory' of Rule.domID
22.384 - | Subproblem' of
22.385 - Celem.spec *
22.386 - (Model.ori list) * (* filled in associate Subproblem' *)
22.387 - term * (* filled -"-, headline of calc-head *)
22.388 - Selem.fmz_ *
22.389 - Proof.context * (* DEPRECATED shifted into loc for all ppobj *)
22.390 - term (* Subproblem (thyID, pbl) OR cascmd *)
22.391 - | Substitute' of
22.392 - Rule.rew_ord_ * (* for re-calculation *)
22.393 - Rule.rls * (* for re-calculation *)
22.394 - Selem.subte * (* the 'substitution': terms of type bool *)
22.395 - term * (* to be substituted into *)
22.396 - term (* resulting from the substitution *)
22.397 - | Tac_ of theory * string * string * string
22.398 - | Take' of term | Take_Inst' of term
22.399 -
22.400 -fun tac_2str ma = case ma of
22.401 - Init_Proof' (ppc, spec) => "Init_Proof' " ^ pair2str (strs2str ppc, Celem.spec2str spec)
22.402 - | Model_Problem' (pblID, _, _) => "Model_Problem' " ^ strs2str pblID
22.403 - | Refine_Tacitly'(p, prefin, domID, metID, _) => "Refine_Tacitly' (" ^ strs2str p ^ ", " ^
22.404 - strs2str prefin ^ ", " ^ domID ^ ", " ^ strs2str metID ^ ", pbl-itms)"
22.405 - | Refine_Problem' _ => "Refine_Problem' (" ^ (*matchs2str ms*)"..." ^ ")"
22.406 - | Add_Given' _ => "Add_Given' "(*^cterm'*)
22.407 - | Del_Given' _ => "Del_Given' "(*^cterm'*)
22.408 - | Add_Find' _ => "Add_Find' "(*^cterm'*)
22.409 - | Del_Find' _ => "Del_Find' "(*^cterm'*)
22.410 - | Add_Relation' _ => "Add_Relation' "(*^cterm'*)
22.411 - | Del_Relation' _ => "Del_Relation' "(*^cterm'*)
22.412 -
22.413 - | Specify_Theory' domID => "Specify_Theory' " ^ quote domID
22.414 - | Specify_Problem' (pI, (ok, _)) => "Specify_Problem' " ^
22.415 - spair2str (strs2str pI, spair2str (bool2str ok, spair2str ("itms2str_ itms", "items2str pre")))
22.416 - | Specify_Method' (pI, oris, _) => "Specify_Method' (" ^
22.417 - Celem.metID2str pI ^ ", " ^ Model.oris2str oris ^ ", )"
22.418 -
22.419 - | Apply_Method' (metID, _, _, _) => "Apply_Method' " ^ strs2str metID
22.420 - | Check_Postcond' (pblID, (scval, asm)) => "Check_Postcond' " ^
22.421 - (spair2str (strs2str pblID, spair2str (Rule.term2str scval, Rule.terms2str asm)))
22.422 -
22.423 - | Free_Solve' => "Free_Solve'"
22.424 -
22.425 - | Rewrite_Inst' (*subs,thm'*) _ => "Rewrite_Inst' "(*^(pair2str (subs2str subs, spair2str thm'))*)
22.426 - | Rewrite' _(*thm'*) => "Rewrite' "(*^(spair2str thm')*)
22.427 - | Rewrite_Asm' _(*thm'*) => "Rewrite_Asm' "(*^(spair2str thm')*)
22.428 - | Rewrite_Set_Inst' _(*subs,thm'*) => "Rewrite_Set_Inst' "(*^(pair2str (subs2str subs, quote rls))*)
22.429 - | Rewrite_Set' (thy', pasm, rls', f, (f', asm)) => "Rewrite_Set' (" ^ thy' ^ "," ^ bool2str pasm ^
22.430 - "," ^ Rule.id_rls rls' ^ "," ^ Rule.term2str f ^ ",(" ^ Rule.term2str f' ^ "," ^ Rule.terms2str asm ^ "))"
22.431 - | End_Detail' _ => "End_Detail' xxx"
22.432 - | Detail_Set' _ => "Detail_Set' xxx"
22.433 - | Detail_Set_Inst' _ => "Detail_Set_Inst' xxx"
22.434 -
22.435 - | Derive' rls => "Derive' " ^ Rule.id_rls rls
22.436 - | Calculate' _ => "Calculate' "
22.437 - | Substitute' _ => "Substitute' "(*^(subs2str subs)*)
22.438 - | Apply_Assumption' _(* ct's*) => "Apply_Assumption' "(*^(strs2str ct's)*)
22.439 -
22.440 - | Take' _(*cterm'*) => "Take' "(*^(quote cterm' )*)
22.441 - | Take_Inst' _(*cterm'*) => "Take_Inst' "(*^(quote cterm' )*)
22.442 - | Subproblem' _(*(spec, oris, _, _, _, pbl_form)*) =>
22.443 - "Subproblem' "(*^(pair2str (domID, strs2str ,))*)
22.444 - | End_Subproblem' _ => "End_Subproblem'"
22.445 - | CAScmd' _(*cterm'*) => "CAScmd' "(*^(quote cterm')*)
22.446 -
22.447 - | Empty_Tac_ => "Empty_Tac_"
22.448 - | Tac_ (_, form, id, result) => "Tac_ (thy," ^ form ^ "," ^ id ^ "," ^ result ^ ")"
22.449 - | _ => "tac_2str not impl. for arg";
22.450 -
22.451 -end
23.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
23.2 +++ b/test/Tools/isac/MathEngBasic/ctree-navi.sml Sat Oct 26 13:03:16 2019 +0200
23.3 @@ -0,0 +1,301 @@
23.4 +(* Title: tests for Interpret/mstools.sml
23.5 + Author: Walther Neuper 100930, Mathias Lehnfeld
23.6 + (c) copyright due to lincense terms.
23.7 +*)
23.8 +"-----------------------------------------------------------------------------------------------";
23.9 +"table of contents -----------------------------------------------------------------------------";
23.10 +"-----------------------------------------------------------------------------------------------";
23.11 +"----------- go through Model_Problem until nxt_tac --------------------------------------------";
23.12 +"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
23.13 +"----------- type penv -------------------------------------------------------------------------";
23.14 +"----------- fun untouched ---------------------------------------------------------------------";
23.15 +"----------- fun pbl_ids -----------------------------------------------------------------------";
23.16 +"----------- fun upd_penv ----------------------------------------------------------------------";
23.17 +"----------- fun upd ---------------------------------------------------------------------------";
23.18 +"----------- fun upds_envv ---------------------------------------------------------------------";
23.19 +"----------- fun common_subthy -----------------------------------------------------------------";
23.20 +"--------------------------------------------------------";
23.21 +"--------------------------------------------------------";
23.22 +"--------------------------------------------------------";
23.23 +"--------------------------------------------------------";
23.24 +
23.25 +
23.26 +"----------- go through Model_Problem until nxt_tac --------------------------------------------";
23.27 +"----------- go through Model_Problem until nxt_tac --------------------------------------------";
23.28 +"----------- go through Model_Problem until nxt_tac --------------------------------------------";
23.29 +(*FIXME.WN110511 delete this test? (goes through "Model_Problem until nxt_tac)*)
23.30 +val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
23.31 +val (dI',pI',mI') =
23.32 + ("Test", ["sqroot-test","univariate","equation","test"],
23.33 + ["Test","squ-equ-test-subpbl1"]);
23.34 +(*========== inhibit exn AK110725 ================================================
23.35 +(* ERROR: same as above, see lines 120- 123 *)
23.36 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
23.37 +========== inhibit exn AK110725 ================================================*)
23.38 +
23.39 +(*========== inhibit exn AK110725 ================================================
23.40 +(* ERROR: p, nxt, pt not declared due to above error *)
23.41 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.42 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.43 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.44 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.45 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.46 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.47 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.48 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.49 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
23.50 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Subproblem",*)
23.51 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Model_Problem",*)
23.52 +"~~~~~ fun me, args:"; val (_,tac) = nxt;
23.53 +val (pt, p) = case locatetac tac (pt,p) of
23.54 + ("ok", (_, _, ptp)) => ptp | _ => error "script.sml locatetac";
23.55 +"~~~~~ fun step, args:"; val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'), []))
23.56 +val pIopt = get_pblID (pt,ip);
23.57 +tacis; (*= []*)
23.58 +pIopt; (*= SOME ["sqroot-test", "univariate", ...]*)
23.59 +member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (*= true*)
23.60 +"~~~~~ fun nxt_specify_, args:"; val (ptp as (pt, pos as (p,p_))) = (pt, ip);
23.61 +val pblobj as (PblObj{meth,origin=origin as (oris,(dI',pI',mI'),_),
23.62 + probl,spec=(dI,pI,mI),...}) = get_obj I pt p;
23.63 +just_created_ pblobj (*by Subproblem*) andalso origin <> e_origin; (*false=oldNB*)
23.64 +val cpI = if pI = e_pblID then pI' else pI;
23.65 + val cmI = if mI = e_metID then mI' else mI;
23.66 + val {ppc, prls, where_, ...} = get_pbt cpI;
23.67 + val pre = check_preconds "thy 100820" prls where_ probl;
23.68 + val pb = foldl and_ (true, map fst pre);
23.69 +val (_,tac) = nxt_spec p_ pb oris (dI',pI',mI') (probl, meth)
23.70 + (ppc, (#ppc o get_met) cmI) (dI, pI, mI); (*tac = Add_Given "equality (-1 + x = 0)"*)
23.71 +"~~~~~ fun nxt_specif, args:"; val (Add_Given ct, ptp) = (tac, ptp);
23.72 +"~~~~~ fun nxt_specif_additem, args:"; val (sel, ct, ptp as (pt, (p, Pbl))) = ("#Given", ct, ptp);
23.73 +val (PblObj{meth=met,origin=(oris,(dI',pI',_),_),
23.74 + probl=pbl,spec=(dI,pI,_),...}) = get_obj I pt p;
23.75 +val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
23.76 +val cpI = if pI = e_pblID then pI' else pI;
23.77 +val ctxt = get_ctxt pt (p, Pbl);
23.78 +"~~~~~ fun appl_add, args:"; val (ctxt, sel, oris, ppc, pbt, str) = (ctxt, sel, oris, pbl, ((#ppc o get_pbt) cpI), ct);
23.79 +val SOME t = parseNEW ctxt str;
23.80 +is_known ctxt sel oris t;
23.81 +"~~~~~ fun is_known, args:"; val (ctxt, sel, ori, t) = (ctxt, sel, oris, t);
23.82 +val _ = tracing ("RM is_known: t=" ^ term2str t);
23.83 +val ots = (distinct o flat o (map #5)) (ori:ori list);
23.84 +val oids = ((map (fst o dest_Free)) o distinct o flat o (map vars)) ots;
23.85 +val (d, ts) = split_dts t;
23.86 +"~~~~~ fun split_dts, args:"; val (t as d $ arg) = t;
23.87 +(*if is_dsc d then () else error "TODO";*)
23.88 +if is_dsc d then () else error "TODO";
23.89 +"----- these were the errors (call hierarchy from bottom up)";
23.90 +appl_add ctxt sel oris pbl ((#ppc o get_pbt) cpI) ct;(*WAS
23.91 +Err "[error] appl_add: is_known: identifiers [equality] not in example"*)
23.92 +nxt_specif_additem "#Given" ct ptp;(*WAS
23.93 +Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
23.94 +nxt_specif tac ptp;(*WAS
23.95 +Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
23.96 +nxt_specify_ (pt,ip); (*WAS
23.97 +Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
23.98 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; WAS
23.99 +Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
23.100 +========== inhibit exn AK110725 ================================================*)
23.101 +
23.102 +"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
23.103 +"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
23.104 +"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
23.105 +(*val t = str2term "maximum A";
23.106 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.107 +val it = "maximum A" : cterm
23.108 +> val t = str2term "fixedValues [r=Arbfix]";
23.109 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.110 +"fixedValues [r = Arbfix]"
23.111 +> val t = str2term "valuesFor [a]";
23.112 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.113 +"valuesFor [a]"
23.114 +> val t = str2term "valuesFor [a,b]";
23.115 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.116 +"valuesFor [a, b]"
23.117 +> val t = str2term "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]";
23.118 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.119 +relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]"
23.120 +> val t = str2term "boundVariable a";
23.121 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.122 +"boundVariable a"
23.123 +> val t = str2term "interval {x::real. 0 <= x & x <= 2*r}";
23.124 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.125 +"interval {x. 0 <= x & x <= 2 * r}"
23.126 +
23.127 +> val t = str2term "equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))";
23.128 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.129 +"equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))"
23.130 +> val t = str2term "solveFor x";
23.131 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.132 +"solveFor x"
23.133 +> val t = str2term "errorBound (eps=0)";
23.134 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.135 +"errorBound (eps = 0)"
23.136 +> val t = str2term "solutions L";
23.137 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
23.138 +"solutions L"
23.139 +
23.140 +before 6.5.03:
23.141 +> val t = (Thm.term_of o the o (parse thy)) "testdscforlist [#1]";
23.142 +> val (d,ts) = split_dts t;
23.143 +> comp_dts thy (d,ts);
23.144 +val it = "testdscforlist [#1]" : cterm
23.145 +
23.146 +> val t = (Thm.term_of o the o (parse thy)) "(A::real)";
23.147 +> val (d,ts) = split_dts t;
23.148 +val d = Const ("empty","empty") : term
23.149 +val ts = [Free ("A","RealDef.real")] : term list
23.150 +> val t = (Thm.term_of o the o (parse thy)) "[R=(R::real)]";
23.151 +> val (d,ts) = split_dts t;
23.152 +val d = Const ("empty","empty") : term
23.153 +val ts = [Const # $ Free # $ Free (#,#)] : term list
23.154 +> val t = (Thm.term_of o the o (parse thy)) "[#1,#2]";
23.155 +> val (d,ts) = split_dts t;
23.156 +val ts = [Free ("#1","'a"),Free ("#2","'a")] : NOT WANTED
23.157 +*)
23.158 +"----------- type penv -------------------------------------------------------------------------";
23.159 +"----------- type penv -------------------------------------------------------------------------";
23.160 +"----------- type penv -------------------------------------------------------------------------";
23.161 +(*
23.162 + val e_ = (Thm.term_of o the o (parse thy)) "e_::bool";
23.163 + val ev = (Thm.term_of o the o (parse thy)) "#4 + #3 * x^^^#2 = #0";
23.164 + val v_ = (Thm.term_of o the o (parse thy)) "v_";
23.165 + val vv = (Thm.term_of o the o (parse thy)) "x";
23.166 + val r_ = (Thm.term_of o the o (parse thy)) "err_::bool";
23.167 + val rv1 = (Thm.term_of o the o (parse thy)) "#0";
23.168 + val rv2 = (Thm.term_of o the o (parse thy)) "eps";
23.169 +
23.170 + val penv = [(e_,[ev]),(v_,[vv]),(r_,[rv2,rv2])]:penv;
23.171 + map getval penv;
23.172 +[(Free ("e_","bool"),
23.173 + Const (#,#) $ (# $ # $ (# $ #)) $ Free ("#0","RealDef.real")),
23.174 + (Free ("v_","RealDef.real"),Free ("x","RealDef.real")),
23.175 + (Free ("err_","bool"),Free ("#0","RealDef.real"))] : (term * term) list
23.176 +*)
23.177 +"----------- fun untouched ---------------------------------------------------------------------";
23.178 +"----------- fun untouched ---------------------------------------------------------------------";
23.179 +"----------- fun untouched ---------------------------------------------------------------------";
23.180 +(*> untouched [];
23.181 +val it = true : bool
23.182 +> untouched [e_itm];
23.183 +val it = true : bool
23.184 +> untouched [e_itm, (1,[],false,"e_itm",Syn "e_itm")];
23.185 +val it = false : bool*)
23.186 +"----------- fun pbl_ids -----------------------------------------------------------------------";
23.187 +"----------- fun pbl_ids -----------------------------------------------------------------------";
23.188 +"----------- fun pbl_ids -----------------------------------------------------------------------";
23.189 +(*
23.190 +val t as t1 $ t2 = str2term "antiDerivativeName M_b";
23.191 +pbl_ids ctxt t1 t2;
23.192 +
23.193 + val t = (Thm.term_of o the o (parse thy)) "fixedValues [r=Arbfix]";
23.194 + val (d,argl) = strip_comb t;
23.195 + is_dsc d; (*see split_dts*)
23.196 + dest_list (d,argl);
23.197 + val (_ $ v) = t;
23.198 + is_list v;
23.199 + pbl_ids ctxt d v;
23.200 +[Const ("List.list.Cons","[bool, bool List.list] => bool List.list") $
23.201 + (Const # $ Free # $ Const (#,#)) $ Const ("List.list.Nil","bool List..
23.202 +
23.203 + val (dsc,vl) = (split_dts o Thm.term_of o the o (parse thy)) "solveFor x";
23.204 +val dsc = Const ("Input_Descript.solveFor","RealDef.real => Tools.una") : term
23.205 +val vl = Free ("x","RealDef.real") : term
23.206 +
23.207 + val (dsc,id) = (split_did o Thm.term_of o the o (parse thy)) "solveFor v_";
23.208 + pbl_ids ctxt dsc vl;
23.209 +val it = [Free ("x","RealDef.real")] : term list
23.210 +
23.211 + val (dsc,vl) = (split_dts o Thm.term_of o the o(parse thy))
23.212 + "errorBound (eps=#0)";
23.213 + val (dsc,id) = (split_did o Thm.term_of o the o(parse thy)) "errorBound err_";
23.214 + pbl_ids ctxt dsc vl;
23.215 +val it = [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")] : term list *)
23.216 +"----------- fun upd_penv ----------------------------------------------------------------------";
23.217 +"----------- fun upd_penv ----------------------------------------------------------------------";
23.218 +"----------- fun upd_penv ----------------------------------------------------------------------";
23.219 +(*
23.220 + val penv = [];
23.221 + val (dsc,vl) = (split_did o Thm.term_of o the o (parse thy)) "solveFor x";
23.222 + val (dsc,id) = (split_did o Thm.term_of o the o (parse thy)) "solveFor v_";
23.223 + val penv = upd_penv thy penv dsc (id, vl);
23.224 +[(Free ("v_","RealDef.real"),
23.225 + [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")])]
23.226 +: (term * term list) list
23.227 +
23.228 + val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"errorBound (eps=#0)";
23.229 + val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"errorBound err_";
23.230 + upd_penv thy penv dsc (id, vl);
23.231 +[(Free ("v_","RealDef.real"),
23.232 + [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")]),
23.233 + (Free ("err_","bool"),
23.234 + [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")])]
23.235 +: (term * term list) list ^.........!!!!
23.236 +*)
23.237 +"----------- fun upd ---------------------------------------------------------------------------";
23.238 +"----------- fun upd ---------------------------------------------------------------------------";
23.239 +"----------- fun upd ---------------------------------------------------------------------------";
23.240 +(*
23.241 + val i = 2;
23.242 + val envv = [(1,[]:penv),(2,[]:penv),(3,[]:penv)]:envv;
23.243 + val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"boundVariable b";
23.244 + val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"boundVariable v_";
23.245 + upd thy envv dsc (id, vl) i;
23.246 +val it = (2,[(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")])])
23.247 + : int * (term * term list) list*)
23.248 +"----------- fun upds_envv ---------------------------------------------------------------------";
23.249 +"----------- fun upds_envv ---------------------------------------------------------------------";
23.250 +"----------- fun upds_envv ---------------------------------------------------------------------";
23.251 +(* eval test-maximum.sml until Specify_Method ...
23.252 + val PblObj{probl=(_,pbl),origin=(_,(_,_,mI),_),...} = get_obj I pt [];
23.253 + val met = (#ppc o get_met) mI;
23.254 +
23.255 + val envv = [];
23.256 + val eargs = flat eargs;
23.257 + val (vs, dsc, id, vl) = hd eargs;
23.258 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
23.259 +
23.260 + val (vs, dsc, id, vl) = hd (tl eargs);
23.261 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
23.262 +
23.263 + val (vs, dsc, id, vl) = hd (tl (tl eargs));
23.264 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
23.265 +
23.266 + val (vs, dsc, id, vl) = hd (tl (tl (tl eargs)));
23.267 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
23.268 +[(1,
23.269 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
23.270 + (Free ("m_","bool"),[Free (#,#)]),
23.271 + (Free ("vs_","bool List.list"),[# $ # $ Const #]),
23.272 + (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
23.273 + (2,
23.274 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
23.275 + (Free ("m_","bool"),[Free (#,#)]),
23.276 + (Free ("vs_","bool List.list"),[# $ # $ Const #]),
23.277 + (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
23.278 + (3,
23.279 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
23.280 + (Free ("m_","bool"),[Free (#,#)]),
23.281 + (Free ("vs_","bool List.list"),[# $ # $ Const #])])] : envv *)
23.282 +
23.283 +"----------- fun common_subthy -----------------------------------------------------------------";
23.284 +"----------- fun common_subthy -----------------------------------------------------------------";
23.285 +"----------- fun common_subthy -----------------------------------------------------------------";
23.286 +val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory Inverse_Z_Transform});
23.287 +if Context.theory_name (common_subthy (thy1, thy2)) = "Inverse_Z_Transform"
23.288 +then () else error "common_subthy 1";
23.289 +
23.290 +val (thy1, thy2) = (@{theory Inverse_Z_Transform}, @{theory Partial_Fractions});(* Isac.Inverse_Z_Transform *)
23.291 +if Context.theory_name (common_subthy (thy1, thy2)) = "Inverse_Z_Transform"
23.292 +then () else error "common_subthy 2";
23.293 +
23.294 +val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory PolyEq});
23.295 +if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 3";
23.296 +
23.297 +val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory Isac_Knowledge});
23.298 +if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 4";
23.299 +
23.300 +val (thy1, thy2) = (@{theory PolyEq}, @{theory Partial_Fractions});
23.301 +if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 5";
23.302 +
23.303 +val (thy1, thy2) = (@{theory Isac_Knowledge}, @{theory Partial_Fractions});
23.304 +if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 6";
24.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
24.2 +++ b/test/Tools/isac/MathEngBasic/ctree.sml Sat Oct 26 13:03:16 2019 +0200
24.3 @@ -0,0 +1,1370 @@
24.4 +(* tests for sml/ME/ctree.sml
24.5 + authors: Walther Neuper 060113
24.6 + (c) due to copyright terms
24.7 +
24.8 +use"../smltest/ME/ctree.sml";
24.9 +use"ctree.sml";
24.10 +*)
24.11 +
24.12 +"-----------------------------------------------------------------";
24.13 +"table of contents -----------------------------------------------";
24.14 +"-----------------------------------------------------------------";
24.15 +"-----------------------------------------------------------------";
24.16 +"-------------- fun get_ctxt -------------------------------------";
24.17 +"-------------- fun update_ctxt, fun g_ctxt ----------------------";
24.18 +"-------------- check positions in miniscript --------------------";
24.19 +"-------------- get_allpos' (from ctree above)--------------------";
24.20 +"-------------- cut_level (from ctree above)----------------------";
24.21 +"-------------- cut_tree (from ctree above)-----------------------";
24.22 +"=====new ctree 1a miniscript with mini-subpbl ===================";
24.23 +"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
24.24 +"=====new ctree 2 miniscript with mini-subpbl ====================";
24.25 +"-------------- cut_tree (intermedi.ctree: 3rd level)-------------";
24.26 +"-------------- cappend (from ctree above)------------------------";
24.27 +"-------------- cappend minisubpbl -------------------------------";
24.28 +"=====new ctree 3 ================================================";
24.29 +"-------------- move_dn ------------------------------------------";
24.30 +"-------------- move_dn: Frm -> Res ------------------------------";
24.31 +"-------------- move_up ------------------------------------------";
24.32 +"------ move into detail -----------------------------------------";
24.33 +"=====new ctree 3a ===============================================";
24.34 +"-------------- move_dn in Incomplete ctree ----------------------";
24.35 +"=====new ctree 4: crooked by cut_level_'_ =======================";
24.36 +(*############## development stopped 0501 ########################*)
24.37 +(******************************************************************)
24.38 +(* val SAVE_get_trace = get_trace; *)
24.39 +(******************************************************************)
24.40 +"-------------- get_interval from ctree: incremental development--";
24.41 +(******************************************************************)
24.42 +(* val get_trace = SAVE_get_trace; *)
24.43 +(******************************************************************)
24.44 +(*############## development stopped 0501 ########################*)
24.45 +"=====new ctree 4 ratequation ====================================";
24.46 +"-------------- pt_extract form, tac, asm<>[] --------------------";
24.47 +"=====new ctree 5 minisubpbl =====================================";
24.48 +"-------------- pt_extract form, tac, asm ------------------------";
24.49 +"=====new ctree 6 minisubpbl intersteps ==========================";
24.50 +"-------------- get_allpos' new ----------------------------------";
24.51 +"-------------- cut_tree new (from ctree above)-------------------";
24.52 +"-------------- repl_app------------------------------------------";
24.53 +"-----------------------------------------------------------------";
24.54 +"-----------------------------------------------------------------";
24.55 +"-----------------------------------------------------------------";
24.56 +
24.57 +
24.58 +"-------------- fun get_ctxt -------------------------------------";
24.59 +"-------------- fun get_ctxt -------------------------------------";
24.60 +"-------------- fun get_ctxt -------------------------------------";
24.61 +val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
24.62 +val (dI',pI',mI') =
24.63 + ("Test", ["sqroot-test","univariate","equation","test"],
24.64 + ["Test","squ-equ-test-subpbl1"]);
24.65 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
24.66 +(get_ctxt pt p)
24.67 + handle _ => error "--- fun get_ctxt not even some ctxt found in PblObj";
24.68 +val (p,_,f,nxt,_,pt) = me nxt p [] pt;
24.69 +(get_ctxt pt p)
24.70 + handle _ => error "--- fun get_ctxt not even some ctxt found in PrfObj";
24.71 +
24.72 +"-------------- fun update_ctxt, fun g_ctxt ----------------------";
24.73 +"-------------- fun update_ctxt, fun g_ctxt ----------------------";
24.74 +"-------------- fun update_ctxt, fun g_ctxt ----------------------";
24.75 +val pt = EmptyPtree;
24.76 +val pt = append_problem [] (e_istate, e_ctxt) e_fmz ([(*oris*)], e_spec, e_term) pt;
24.77 +val ctxt = get_obj g_ctxt pt [];
24.78 +if is_e_ctxt ctxt then () else error "--- fun update_ctxt, fun g_ctxt: append_problem changed";
24.79 +val pt = update_ctxt pt [] (Proof_Context.init_global @{theory "Isac_Knowledge"});
24.80 +if (get_obj g_ctxt pt [] |> Proof_Context.theory_of |> Context.theory_name) = "Isac_Knowledge"
24.81 +then () else error "--- fun update_ctxt, fun g_ctxt changed";
24.82 +
24.83 +"-------------- check positions in miniscript --------------------";
24.84 +"-------------- check positions in miniscript --------------------";
24.85 +"-------------- check positions in miniscript --------------------";
24.86 +val fmz = ["equality (x+1=(2::real))",
24.87 + "solveFor x","solutions L"];
24.88 +val (dI',pI',mI') =
24.89 + ("Test",["sqroot-test","univariate","equation","test"],
24.90 + ["Test","squ-equ-test-subpbl1"]);
24.91 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
24.92 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.93 +(* nxt = Add_Given "equality (x + 1 = 2)"
24.94 + (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
24.95 + *)
24.96 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.97 +(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
24.98 + *)
24.99 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.100 +(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
24.101 + *)
24.102 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.103 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.104 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.105 +"ctree.sml-------------- get_allpos' new ------------------------\"";
24.106 +val (PP, pp) = split_last [1];
24.107 +val ((pt', cuts), clevup) = cut_bottom (PP, pp) (get_nd pt PP);
24.108 +
24.109 +val cuts = get_allp [] ([], ([],Frm)) pt;
24.110 +val cuts2 = get_allps [] [1] (children pt);
24.111 +"ctree.sml-------------- cut_tree new (from ctree above)----------";
24.112 +val (pt', cuts) = cut_tree pt ([1],Frm);
24.113 +"ctree.sml-------------- cappend on complete ctree from above ----";
24.114 +val (pt', cuts) = cappend_form pt [1] (e_istate, e_ctxt) (str2term "Inform[1]");
24.115 +"----------------------------------------------------------------/";
24.116 +
24.117 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_form: pos =[1]*);
24.118 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[1]*);
24.119 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[2]*);
24.120 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_problem: pos =[3]*);
24.121 +
24.122 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.123 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.124 +(*val nxt = ("Add_Given", Add_Given "equality (-1 + x = 0)").....*)
24.125 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.126 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.127 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.128 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.129 +(*val nxt = ("Apply_Method", Apply_Method ["Test", "solve_linear"])*)
24.130 +
24.131 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_form: pos =[3,1]*);
24.132 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[3,1]*);
24.133 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[3,2]*);
24.134 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*.append_result: pos =[3]*);
24.135 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[4]*);
24.136 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*.append_result: pos =[]*);
24.137 +val FormKF res = f;
24.138 +if res = "[x = 1]"
24.139 +then case nxt of ("End_Proof'", End_Proof') => ()
24.140 + | _ => error "new behaviour in test: miniscript with mini-subpbl 1"
24.141 +else error "new behaviour in test: miniscript with mini-subpbl 2"
24.142 +
24.143 + show_pt pt;
24.144 +
24.145 +"-------------- get_allpos' (from ctree above)--------------------";
24.146 +"-------------- get_allpos' (from ctree above)--------------------";
24.147 +"-------------- get_allpos' (from ctree above)--------------------";
24.148 +if get_allpos' ([], 1) pt =
24.149 + [([], Frm),
24.150 + ([1], Frm),
24.151 + ([1], Res),
24.152 + ([2], Res),
24.153 + ([3], Frm),
24.154 + ([3, 1], Frm),
24.155 + ([3, 1], Res),
24.156 + ([3, 2], Res),
24.157 + ([3], Res),
24.158 + ([4], Res),
24.159 + ([], Res)]
24.160 +then () else error "ctree.sml: diff:behav. in get_allpos' 1";
24.161 +
24.162 +if get_allpos's ([], 1) (children pt) =
24.163 + [([1], Frm),
24.164 + ([1], Res),
24.165 + ([2], Res),
24.166 + ([3], Frm),
24.167 + ([3, 1], Frm),
24.168 + ([3, 1], Res),
24.169 + ([3, 2], Res),
24.170 + ([3], Res),
24.171 + ([4], Res)]
24.172 +then () else error "ctree.sml: diff:behav. in get_allpos' 2";
24.173 +
24.174 +if get_allpos's ([], 2) (takerest (1, children pt)) =
24.175 + [([2], Res),
24.176 + ([3], Frm),
24.177 + ([3, 1], Frm),
24.178 + ([3, 1], Res),
24.179 + ([3, 2], Res),
24.180 + ([3], Res),
24.181 + ([4], Res)]
24.182 +then () else error "ctree.sml: diff:behav. in get_allpos' 3";
24.183 +
24.184 +if get_allpos's ([], 3) (takerest (2, children pt)) =
24.185 + [([3], Frm),
24.186 + ([3, 1], Frm),
24.187 + ([3, 1], Res),
24.188 + ([3, 2], Res),
24.189 + ([3], Res),
24.190 + ([4], Res)]
24.191 +then () else error "ctree.sml: diff:behav. in get_allpos' 4";
24.192 +
24.193 +if get_allpos's ([3], 1) (children (nth 3 (children pt))) =
24.194 + [([3, 1], Frm),
24.195 + ([3, 1], Res),
24.196 + ([3, 2], Res)]
24.197 +then () else error "ctree.sml: diff:behav. in get_allpos' 5";
24.198 +
24.199 +if get_allpos' ([3], 1) (nth 3 (children pt)) =
24.200 + [([3], Frm),
24.201 + ([3, 1], Frm),
24.202 + ([3, 1], Res),
24.203 + ([3, 2], Res),
24.204 + ([3], Res)]
24.205 +then () else error "ctree.sml: diff:behav. in get_allpos' 6";
24.206 +
24.207 +
24.208 +
24.209 +
24.210 +
24.211 +
24.212 +"-------------- cut_level (from ctree above)----------------------";
24.213 +"-------------- cut_level (from ctree above)----------------------";
24.214 +"-------------- cut_level (from ctree above)----------------------";
24.215 +show_pt pt;
24.216 +show_pt pt';
24.217 +(*default_print_depth 99*) cuts; (*default_print_depth 3*)
24.218 +
24.219 +(*if cuts = [([2], Res),
24.220 + ([3], Frm),
24.221 + ([3, 1], Frm),
24.222 + ([3, 1], Res),
24.223 + ([3, 2], Res),
24.224 + ([3], Res),
24.225 + ([4], Res)]
24.226 +then () else error "ctree.sml: diff:behav. in cut_level 1a";
24.227 +val (res,asm) = get_obj g_result pt' [2];
24.228 +if res = e_term andalso asm = [] then () else
24.229 +error "ctree.sml: diff:behav. in cut_level 1aa" WN050219*);
24.230 +if not (existpt [2] pt') then () else
24.231 +error "ctree.sml: diff:behav. in cut_level 1aa2" (*WN050220*);
24.232 +
24.233 +val (res,asm) = get_obj g_result pt' [];
24.234 +
24.235 +(*============ inhibit exn AK110726 ==============================================
24.236 +if term2str res = "[x = 1]" (*WN050219 e_term in cut_tree!!!*) then () else
24.237 +error "ctree.sml: diff:behav. in cut_level 1ab";
24.238 +============ inhibit exn AK110726 ==============================================*)
24.239 +(*============ inhibit exn AK110726 ==============================================
24.240 +if map fst3 (get_interval ([],Frm) ([],Res) 9999 pt') =
24.241 + [([], Frm),
24.242 + ([1], Frm),
24.243 + ([1], Res),
24.244 + ([2], Res),(*, e_term in cut_tree!!!*)
24.245 + ([], Res)] then () else
24.246 +error "ctree.sml: diff:behav. in cut_level 1b";
24.247 +============ inhibit exn AK110726 ==============================================*)
24.248 +
24.249 +val (pt',cuts) = cut_level [] [] pt ([2],Res);
24.250 +if cuts = [([3], Frm),
24.251 + ([3, 1], Frm),
24.252 + ([3, 1], Res),
24.253 + ([3, 2], Res),
24.254 + ([3], Res),
24.255 + ([4], Res)]
24.256 +then () else error "ctree.sml: diff:behav. in cut_level 2a";
24.257 +
24.258 +if pr_ctree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n"
24.259 +then () else error "ctree.sml: diff:behav. in cut_level 2b";
24.260 +
24.261 +val (pt',cuts) = cut_level [] [3] pt ([3,1],Frm);
24.262 +if cuts = [([3, 1], Res), ([3, 2], Res)]
24.263 +then () else error "ctree.sml: diff:behav. in cut_level 3a";
24.264 +if pr_ctree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n3. ----- pblobj -----\n3.1. -1 + x = 0\n4. [x = 1]\n"
24.265 +then () else error "ctree.sml: diff:behav. in cut_level 3b";
24.266 +
24.267 +val (pt',cuts) = cut_level [] [3] pt ([3,1],Res);
24.268 +if cuts = [([3, 2], Res)]
24.269 +then () else error "ctree.sml: diff:behav. in cut_level 4a";
24.270 +if pr_ctree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n3. ----- pblobj -----\n3.1. -1 + x = 0\n4. [x = 1]\n"
24.271 +then () else error "ctree.sml: diff:behav. in cut_level 4b";
24.272 +
24.273 +
24.274 +"-------------- cut_tree (from ctree above)-----------------------";
24.275 +"-------------- cut_tree (from ctree above)-----------------------";
24.276 +"-------------- cut_tree (from ctree above)-----------------------";
24.277 +val (pt', cuts) = cut_tree pt ([2],Frm);(*not created by move_dn -- not on WS*)
24.278 +
24.279 +(*============ inhibit exn AK110726 ==============================================
24.280 +if cuts = [([2], Res),
24.281 + ([3], Frm),
24.282 + ([3, 1], Frm),
24.283 + ([3, 1], Res),
24.284 + ([3, 2], Res),
24.285 + ([3], Res),
24.286 + ([4], Res),
24.287 + ([], Res)]
24.288 +then () else error "ctree.sml: diff:behav. in cut_tree 1a";
24.289 +
24.290 +val (res,asm) = get_obj g_result pt' [2];
24.291 +============ inhibit exn AK110726 ==============================================*)
24.292 +
24.293 +if res = e_term (*WN050219 done by cut_level*) then () else
24.294 +error "ctree.sml: diff:behav. in cut_tree 1aa";
24.295 +
24.296 +(*============ inhibit exn AK110726 ==============================================
24.297 +val form = get_obj g_form pt' [2];
24.298 +if term2str form = "x + 1 + -1 * 2 = 0" (*remained !!!*) then () else
24.299 +error "ctree.sml: diff:behav. in cut_tree 1ab";
24.300 +============ inhibit exn AK110726 ==============================================*)
24.301 +(* AK110727 Debuging
24.302 + (* get_obj g_form pt' [2];
24.303 + (* ERROR: exception PTREE "get_obj: pos = [2] does not exist"
24.304 + raised (line 908 /src/Tools/isac/Interpret/ctree.sml")*)*)
24.305 +"~~~~~ fun get_obj, args:"; val (f, (Nd (b, bs)) ,(p::ps)) = (g_form, pt', [2]);*)
24.306 +
24.307 +val (res,asm) = get_obj g_result pt' [];
24.308 +if res = e_term (*WN050219 done by cut_tree*) then () else
24.309 +error "ctree.sml: diff:behav. in cut_tree 1ac";
24.310 +
24.311 +if map fst3 (get_interval ([],Frm) ([],Res) 9999 pt') =
24.312 + [([], Frm),
24.313 + ([1], Frm),
24.314 + ([1], Res)] then () else
24.315 +error "ctree.sml: diff:behav. in cut_tree 1ad";
24.316 +
24.317 +val (pt', cuts) = cut_tree pt ([2],Res);
24.318 +(*============ inhibit exn AK110726 ==============================================
24.319 +if cuts = [([3], Frm),
24.320 + ([3, 1], Frm),
24.321 + ([3, 1], Res),
24.322 + ([3, 2], Res),
24.323 + ([3], Res),
24.324 + ([4], Res),
24.325 + ([], Res)]
24.326 +then () else error "ctree.sml: diff:behav. in cut_tree 2";
24.327 +============ inhibit exn AK110726 ==============================================*)
24.328 +
24.329 +val (pt', cuts) = cut_tree pt ([3,1],Frm);
24.330 +(*============ inhibit exn AK110726 ==============================================
24.331 +if cuts = [([3, 1], Res),
24.332 + ([3, 2], Res),
24.333 + ([3], Res),
24.334 + ([4], Res),
24.335 + ([], Res)]
24.336 +then () else error "ctree.sml: diff:behav. in cut_tree 3";
24.337 +============ inhibit exn AK110726 ==============================================*)
24.338 +
24.339 +val (pt', cuts) = cut_tree pt ([3,1],Res);
24.340 +if cuts = [([3, 2], Res),
24.341 + ([3], Res),
24.342 + ([4], Res),
24.343 + ([], Res)]
24.344 +then () else error "ctree.sml: diff:behav. in cut_tree 4";
24.345 +
24.346 +"=====new ctree 1a miniscript with mini-subpbl ===================";
24.347 +"=====new ctree 1a miniscript with mini-subpbl ===================";
24.348 +"=====new ctree 1a miniscript with mini-subpbl ===================";
24.349 +val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
24.350 +val (dI',pI',mI') =
24.351 + ("Test",["sqroot-test","univariate","equation","test"],
24.352 + ["Test","squ-equ-test-subpbl1"]);
24.353 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
24.354 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.355 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.356 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.357 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.358 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.359 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.360 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.361 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.362 +show_pt pt;
24.363 +
24.364 +"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
24.365 +"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
24.366 +"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
24.367 +
24.368 +val (pt',cuts) = cut_level [] [3] pt ([1],Frm);(*([1],Frm) is stored*)
24.369 +if cuts = [](*([1],Res) is not yet stored (Nd.ostate=Incomplete)*)
24.370 +then () else error "ctree.sml: diff:behav. in cut_tree 4a";
24.371 +
24.372 +val (pt', cuts) = cut_tree pt ([1],Frm);
24.373 +if cuts = []
24.374 +then () else error "ctree.sml: diff:behav. in cut_tree 4a";
24.375 +
24.376 +(*WN050219
24.377 +val pos as ([p],_) = ([1],Frm);
24.378 +val pt as Nd (b,_) = pt;
24.379 +
24.380 +
24.381 +show_pt pt;
24.382 +show_pt pt';
24.383 +(*default_print_depth 99;*)cuts;(*default_print_depth 3;*)
24.384 +(*default_print_depth 99;*)map fst3 (get_interval ([],Frm) ([],Res) 9999 pt');(*default_print_depth 3;*)
24.385 +####################################################################*)
24.386 +
24.387 +
24.388 +
24.389 +"=====new ctree 2 miniscript with mini-subpbl ====================";
24.390 +"=====new ctree 2 miniscript with mini-subpbl ====================";
24.391 +"=====new ctree 2 miniscript with mini-subpbl ====================";
24.392 +reset_states ();
24.393 + CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
24.394 + ("Test", ["sqroot-test","univariate","equation","test"],
24.395 + ["Test","squ-equ-test-subpbl1"]))];
24.396 + Iterator 1; moveActiveRoot 1;
24.397 + autoCalculate 1 CompleteCalc;
24.398 +
24.399 + interSteps 1 ([3,2],Res);
24.400 +
24.401 + val ((pt,_),_) = get_calc 1;
24.402 + show_pt pt;
24.403 +
24.404 +if (term2str o fst) (get_obj g_result pt [3,2,1]) = "x = 0 + 1" then ()
24.405 +else error "mini-subpbl interSteps broken";
24.406 +
24.407 +"-------------- cut_tree (intermedi.ctree: 3rd level)-------------";
24.408 +"-------------- cut_tree (intermedi.ctree: 3rd level)-------------";
24.409 +"-------------- cut_tree (intermedi.ctree: 3rd level)-------------";
24.410 +(*WN050225 intermed. outcommented
24.411 + val (pt', cuts) = cut_tree pt ([3,2,1],Frm);
24.412 + if cuts = [([3, 2, 1], Res),
24.413 + ([3, 2, 2], Res),
24.414 + ([3, 2], Res),
24.415 + ([3], Res),
24.416 + ([4], Res)]
24.417 + then () else error "ctree.sml: diff:behav. in cut_tree 3rd level 1";
24.418 +
24.419 + val (pt', cuts) = cut_tree pt ([3,2,1],Res);
24.420 + if cuts = [([3, 2, 2], Res),
24.421 + ([3, 2], Res),
24.422 + ([3], Res),
24.423 + ([4], Res)]
24.424 + then () else error "ctree.sml: diff:behav. in cut_tree 3rd level 2";
24.425 +
24.426 +
24.427 +"-------------- cappend (from ctree above)------------------------";
24.428 +"-------------- cappend (from ctree above)------------------------";
24.429 +"-------------- cappend (from ctree above)------------------------";
24.430 +val (pt',cuts) = cappend_form pt [3,2,1] e_istate (str2term "newnew");
24.431 +if cuts = [([3, 2, 1], Res),
24.432 + ([3, 2, 2], Res),
24.433 + ([3, 2], Res),
24.434 + ([3], Res),
24.435 + ([4], Res),
24.436 + ([], Res)]
24.437 +then () else error "ctree.sml: diff:behav. in cappend_form";
24.438 +if term2str (get_obj g_form pt' [3,2,1]) = "newnew" andalso
24.439 + get_obj g_tac pt' [3,2,1] = Empty_Tac andalso
24.440 + term2str (fst (get_obj g_result pt' [3,2,1])) = "??.empty"
24.441 + then () else error "ctree.sml: diff:behav. in cappend 1";
24.442 +
24.443 +val (pt',cuts) = cappend_atomic pt [3,2,1] e_istate (str2term "newform")
24.444 + (Tac "test") (str2term "newresult",[]) Complete;
24.445 +if cuts = [([3, 2, 1], Res), (*?????????????*)
24.446 + ([3, 2, 2], Res),
24.447 + ([3, 2], Res),
24.448 + ([3], Res),
24.449 + ([4], Res),
24.450 + ([], Res)]
24.451 +then () else error "ctree.sml: diff:behav. in cappend_atomic";
24.452 +
24.453 +
24.454 +
24.455 +"-------------- cappend minisubpbl -------------------------------";
24.456 +"-------------- cappend minisubpbl -------------------------------";
24.457 +"-------------- cappend minisubpbl -------------------------------";
24.458 +"=====new ctree 1 miniscript with mini-subpbl ====================";
24.459 +val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
24.460 +val (dI',pI',mI') =
24.461 + ("Test",["sqroot-test","univariate","equation","test"],
24.462 + ["Test","squ-equ-test-subpbl1"]);
24.463 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
24.464 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.465 +(* nxt = Add_Given "equality (x + 1 = 2)"
24.466 + (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
24.467 + *)
24.468 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.469 +(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
24.470 + *)
24.471 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.472 +(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
24.473 + *)
24.474 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.475 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.476 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
24.477 +(*###cappend_form: pos =[1] ... while calculating nxt, which pt is dropped
24.478 +val nxt = ("Apply_Method", Apply_Method ["Test", "squ-equ-test-subpbl1"])*)
24.479 +
24.480 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[1]*);
24.481 +val p = ([1], Frm);
24.482 +val (pt,cuts) = cappend_form pt (fst p) e_istate (str2term "x + 1 = 2");
24.483 +val form = get_obj g_form pt (fst p);
24.484 +val (res,_) = get_obj g_result pt (fst p);
24.485 +if term2str form = "x + 1 = 2" andalso res = e_term then () else
24.486 +error "ctree.sml, diff.behav. cappend minisubpbl ([1],Frm)";
24.487 +if not (existpt ((lev_on o fst) p) pt) then () else
24.488 +error "ctree.sml, diff.behav. cappend minisubpbl ([1],Frm) nxt";
24.489 +
24.490 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[1]*);
24.491 +val p = ([1], Res);
24.492 +val (pt,cuts) =
24.493 + cappend_atomic pt (fst p) e_istate (str2term "x + 1 = 2")
24.494 + Empty_Tac (str2term "x + 1 + -1 * 2 = 0",[]) Incomplete;
24.495 +val form = get_obj g_form pt (fst p);
24.496 +val (res,_) = get_obj g_result pt (fst p);
24.497 +if term2str form = "x + 1 = 2" andalso term2str res = "x + 1 + -1 * 2 = 0"
24.498 +then () else error "ctree.sml, diff.behav. cappend minisubpbl ([1],Res)";
24.499 +if not (existpt ((lev_on o fst) p) pt) then () else
24.500 +error "ctree.sml, diff.behav. cappend minisubpbl ([1],Res) nxt";
24.501 +
24.502 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[2]*);
24.503 +val p = ([2], Res);
24.504 +val (pt,cuts) =
24.505 + cappend_atomic pt (fst p) e_istate (str2term "x + 1 + -1 * 2 = 0")
24.506 + Empty_Tac (str2term "-1 + x = 0",[]) Incomplete;
24.507 +val form = get_obj g_form pt (fst p);
24.508 +val (res,_) = get_obj g_result pt (fst p);
24.509 +if term2str form = "x + 1 + -1 * 2 = 0" andalso term2str res = "-1 + x = 0"
24.510 +then () else error "ctree.sml, diff.behav. cappend minisubpbl ([2],Res)";
24.511 +if not (existpt ((lev_on o fst) p) pt) then () else
24.512 +error "ctree.sml, diff.behav. cappend minisubpbl ([2],Res) nxt";
24.513 +
24.514 +
24.515 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(**)cappend_problem: pos =[3]*)
24.516 +val p = ([3], Pbl);
24.517 +val (pt,cuts) = cappend_problem pt (fst p) e_istate e_fmz ([],e_spec,e_term);
24.518 +if is_pblobj (get_obj I pt (fst p)) then () else
24.519 +error "ctree.sml, diff.behav. cappend minisubpbl ([3],Pbl)";
24.520 +if not (existpt ((lev_on o fst) p) pt) then () else
24.521 +error "ctree.sml, diff.behav. cappend minisubpbl ([3],Pbl) nxt";
24.522 +
24.523 +(* ...complete calchead skipped...*)
24.524 +
24.525 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[3,1]*);
24.526 +val p = ([3, 1], Frm);
24.527 +val (pt,cuts) = cappend_form pt (fst p) e_istate (str2term "-1 + x = 0");
24.528 +val form = get_obj g_form pt (fst p);
24.529 +val (res,_) = get_obj g_result pt (fst p);
24.530 +if term2str form = "-1 + x = 0" andalso res = e_term then () else
24.531 +error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Frm)";
24.532 +if not (existpt ((lev_on o fst) p) pt) then () else
24.533 +error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Frm) nxt";
24.534 +
24.535 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(**)cappend_atomic: pos =[3,1]*)
24.536 +val p = ([3, 1], Res);
24.537 +val (pt,cuts) =
24.538 + cappend_atomic pt (fst p) e_istate (str2term "-1 + x = 0")
24.539 + Empty_Tac (str2term "x = 0 + -1 * -1",[]) Incomplete;
24.540 +val form = get_obj g_form pt (fst p);
24.541 +val (res,_) = get_obj g_result pt (fst p);
24.542 +if term2str form = "-1 + x = 0" andalso term2str res = "x = 0 + -1 * -1" then()
24.543 +else error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Res)";
24.544 +if not (existpt ((lev_on o fst) p) pt) then () else
24.545 +error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Res) nxt";
24.546 +
24.547 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[3,1]*);
24.548 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[3,1]*);
24.549 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[3,2]*);
24.550 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**).append_result: pos =[3]*);
24.551 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[4]*);
24.552 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**).append_result: pos =[]*);
24.553 +
24.554 +WN050225 intermed. outcommented---*)
24.555 +
24.556 +"=====new ctree 3 ================================================";
24.557 +"=====new ctree 3 ================================================";
24.558 +"=====new ctree 3 ================================================";
24.559 +
24.560 +reset_states ();
24.561 + CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
24.562 + ("Test", ["sqroot-test","univariate","equation","test"],
24.563 + ["Test","squ-equ-test-subpbl1"]))];
24.564 + Iterator 1; moveActiveRoot 1;
24.565 + autoCalculate 1 CompleteCalc;
24.566 +
24.567 + val ((pt,_),_) = get_calc 1;
24.568 + show_pt pt;
24.569 +
24.570 +"-------------- move_dn ------------------------------------------";
24.571 +"-------------- move_dn ------------------------------------------";
24.572 +"-------------- move_dn ------------------------------------------";
24.573 + val p = move_dn [] pt ([],Pbl) (*-> ([1],Frm)*);
24.574 + val p = move_dn [] pt p (*-> ([1],Res)*);
24.575 + val p = move_dn [] pt p (*-> ([2],Res)*);
24.576 + val p = move_dn [] pt p (*-> ([3],Pbl)*);
24.577 + val p = move_dn [] pt p (*-> ([3,1],Frm)*);
24.578 + val p = move_dn [] pt p (*-> ([3,1],Res)*);
24.579 + val p = move_dn [] pt p (*-> ([3,2],Res)*);
24.580 + val p = move_dn [] pt p (*-> ([3],Res)*);
24.581 +(* term2str (get_obj g_res pt [3]);
24.582 + term2str (get_obj g_form pt [4]);
24.583 + *)
24.584 + val p = move_dn [] pt p (*-> ([4],Res)*);
24.585 + val p = move_dn [] pt p (*-> ([],Res)*);
24.586 +(*
24.587 + val p = (move_dn [] pt p) handle e => print_exn_G e;
24.588 + Exception PTREE end of calculation*)
24.589 +
24.590 +if p=([],Res) then () else error "ctree.sml: diff:behav. in move_dn";
24.591 +
24.592 +"-------------- move_dn: Frm -> Res ------------------------------";
24.593 +"-------------- move_dn: Frm -> Res ------------------------------";
24.594 +"-------------- move_dn: Frm -> Res ------------------------------";
24.595 + reset_states ();
24.596 + CalcTree (*start of calculation, return No.1*)
24.597 + [(["equality (1+-1*2+x=(0::real))", "solveFor x","solutions L"],
24.598 + ("Test",
24.599 + ["LINEAR","univariate","equation","test"],
24.600 + ["Test","solve_linear"]))];
24.601 + Iterator 1; moveActiveRoot 1;
24.602 + autoCalculate 1 CompleteCalcHead;
24.603 + autoCalculate 1 (Step 1);
24.604 + refFormula 1 (get_pos 1 1);
24.605 +
24.606 + moveActiveRoot 1;
24.607 + moveActiveDown 1;
24.608 + if get_pos 1 1 = ([1], Frm) then ()
24.609 + else error "ctree.sml: diff.behav. in move_dn: Frm -> Res (1)";
24.610 + moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
24.611 +
24.612 + autoCalculate 1 (Step 1);
24.613 + refFormula 1 (get_pos 1 1);
24.614 +
24.615 + moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
24.616 + if get_pos 1 1 = ([1], Res) then ()
24.617 + else error "ctree.sml: diff.behav. in move_dn: Frm -> Res (1)";
24.618 + moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
24.619 +
24.620 +
24.621 +"-------------- move_up ------------------------------------------";
24.622 +"-------------- move_up ------------------------------------------";
24.623 +"-------------- move_up ------------------------------------------";
24.624 + val p = move_up [] pt ([],Res); (*-> ([4],Res)*)
24.625 + val p = move_up [] pt p; (*-> ([3],Res)*)
24.626 + val p = move_up [] pt p; (*-> ([3,2],Res)*)
24.627 + val p = move_up [] pt p; (*-> ([3,1],Res)*)
24.628 + val p = move_up [] pt p; (*-> ([3,1],Frm)*)
24.629 + val p = move_up [] pt p; (*-> ([3],Pbl)*)
24.630 + val p = move_up [] pt p; (*-> ([2],Res)*)
24.631 + val p = move_up [] pt p; (*-> ([1],Res)*)
24.632 + val p = move_up [] pt p; (*-> ([1],Frm)*)
24.633 + val p = move_up [] pt p; (*-> ([],Pbl)*)
24.634 +(*val p = (move_up [] pt p) handle e => print_exn_G e;
24.635 + Exception PTREE begin of calculation*)
24.636 +
24.637 +if p=([],Pbl) then () else error "ctree.sml: diff.behav. in move_up";
24.638 +
24.639 +"------ move into detail -----------------------------------------";
24.640 +"------ move into detail -----------------------------------------";
24.641 +"------ move into detail -----------------------------------------";
24.642 + reset_states ();
24.643 + CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
24.644 + ("Test", ["sqroot-test","univariate","equation","test"],
24.645 + ["Test","squ-equ-test-subpbl1"]))];
24.646 + Iterator 1; moveActiveRoot 1;
24.647 + autoCalculate 1 CompleteCalc;
24.648 + moveActiveRoot 1;
24.649 + moveActiveDown 1;
24.650 + moveActiveDown 1;
24.651 + moveActiveDown 1;
24.652 + refFormula 1 (get_pos 1 1) (* 2 Res, <ISA> -1 + x = 0 </ISA> *);
24.653 +
24.654 + interSteps 1 ([2],Res);
24.655 +
24.656 + val ((pt,_),_) = get_calc 1; show_pt pt;
24.657 + val p = get_pos 1 1;
24.658 +
24.659 + val p = move_up [] pt p; (*([2, 6], Res)*);
24.660 + val p = movelevel_up [] pt p;(*([2], Frm)*);
24.661 + val p = move_dn [] pt p; (*([2, 1], Frm)*);
24.662 + val p = move_dn [] pt p; (*([2, 1], Res)*);
24.663 + val p = move_dn [] pt p; (*([2, 2], Res)*);
24.664 + val p = move_dn [] pt p; (*([2, 3], Res)*);
24.665 + val p = move_dn [] pt p; (*([2, 4], Res)*);
24.666 + val p = move_dn [] pt p; (*([2, 5], Res)*);
24.667 + val p = move_dn [] pt p; (*([2, 6], Res)*);
24.668 + if p = ([2, 6], Res) then()
24.669 + else error "ctree.sml: diff.behav. in move into detail";
24.670 +
24.671 +"=====new ctree 3a ===============================================";
24.672 +"=====new ctree 3a ===============================================";
24.673 +"=====new ctree 3a ===============================================";
24.674 + reset_states ();
24.675 + CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
24.676 + ("Test", ["sqroot-test","univariate","equation","test"],
24.677 + ["Test","squ-equ-test-subpbl1"]))];
24.678 + Iterator 1; moveActiveRoot 1;
24.679 + autoCalculate 1 CompleteCalcHead;
24.680 + autoCalculate 1 (Step 1);
24.681 + autoCalculate 1 (Step 1);
24.682 + autoCalculate 1 (Step 1);
24.683 + val ((pt,_),_) = get_calc 1;
24.684 + val p = move_dn [] pt ([],Pbl) (*-> ([1], Frm)*);
24.685 + val p = move_dn [] pt ([1], Frm) (*-> ([1], Res)*);
24.686 + val p = move_dn [] pt ([1], Res) (*-> ([2], Res)*);
24.687 + (*val p = move_dn [] pt ([2], Res) ->Exception- PTREE "[] not complete"*);
24.688 +
24.689 + moveDown 1 ([],Pbl) (*-> ([1], Frm)*);
24.690 + moveDown 1 ([1],Frm) (*-> ([1],Res)*);
24.691 + moveDown 1 ([1],Res) (*-> ([2],Res)*);
24.692 + moveDown 1 ([2],Res) (*-> pos does not exist*);
24.693 +(*
24.694 + get_obj g_ostate pt [1];
24.695 + show_pt pt;
24.696 +*)
24.697 +
24.698 +"-------------- move_dn in Incomplete ctree ----------------------";
24.699 +"-------------- move_dn in Incomplete ctree ----------------------";
24.700 +"-------------- move_dn in Incomplete ctree ----------------------";
24.701 +
24.702 +
24.703 +
24.704 +"=====new ctree 4: crooked by cut_level_'_ =======================";
24.705 +"=====new ctree 4: crooked by cut_level_'_ =======================";
24.706 +"=====new ctree 4: crooked by cut_level_'_ =======================";
24.707 +reset_states ();
24.708 +CalcTree
24.709 +[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
24.710 + "solveFor x","solutions L"],
24.711 + ("RatEq",["univariate","equation"],["no_met"]))];
24.712 +Iterator 1; moveActiveRoot 1;
24.713 +autoCalculate 1 CompleteCalc;
24.714 +
24.715 +getTactic 1 ([1],Res);(*Rewrite_Set RatEq_simplify*)
24.716 +getTactic 1 ([2],Res);(*Rewrite_Set norm_Rational*)
24.717 +getTactic 1 ([3],Res);(*Rewrite_Set RatEq_eliminate*)
24.718 +getTactic 1 ([4,1],Res);(*Rewrite all_left*)
24.719 +getTactic 1 ([4,2],Res);(*Rewrite_Set expand_binoms*)
24.720 +getTactic 1 ([4,3],Res);(*Rewrite_Set_Inst make_ratpoly_in*)
24.721 +
24.722 +moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
24.723 +moveActiveFormula 1 ([2],Res)(**ME_Isa: 'expand' not known*);
24.724 +moveActiveFormula 1 ([3],Res)(*3.1.*);
24.725 +moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
24.726 +moveActiveFormula 1 ([4,3],Res)(**one_scr_arg: called by Program Stepwise t_=*);
24.727 +
24.728 +moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
24.729 +interSteps 1 ([1],Res)(*..is activeFormula !?!*);
24.730 +
24.731 +getTactic 1 ([1,1],Res);(*Rewrite real_diff_minus*)
24.732 +getTactic 1 ([1,2],Res);(*Rewrite real_diff_minus*)
24.733 +getTactic 1 ([1,3],Res);(*Rewrite real_diff_minus*)
24.734 +getTactic 1 ([1,4],Res);(*Rewrite real_rat_mult_1*)
24.735 +
24.736 +moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
24.737 +interSteps 1 ([4,2],Res)(*..is activeFormula !?!*);
24.738 +val ((pt,_),_) = get_calc 1;
24.739 +writeln(pr_ctree pr_short pt);
24.740 +(*delete [4,1] in order to make pos [4],[4,4] for pblobjs differen [4],[4,3]:
24.741 + ###########################################################################*)
24.742 +val (pt, ppp) = cut_level_'_ [] [] pt ([4,1],Frm);
24.743 +writeln(pr_ctree pr_short pt);
24.744 +
24.745 +
24.746 +
24.747 +
24.748 +
24.749 +"-------------- get_interval from ctree: incremental development--";
24.750 +"-------------- get_interval from ctree: incremental development--";
24.751 +"-------------- get_interval from ctree: incremental development--";
24.752 +"--- level 1: get pos from start b to end p ----------------------";
24.753 +"--- level 1: get pos from start b to end p ----------------------";
24.754 +"--- level 1: get pos from start b to end p ----------------------";
24.755 +(******************************************************************)
24.756 +(**) val SAVE_get_trace = get_trace; (**)
24.757 +(******************************************************************)
24.758 +(*'getnds' below is structured as such:*)
24.759 +fun www _ [x] = "l+r-margin"
24.760 + | www true [x1,x2] = "l-margin, r-margin"
24.761 + | www _ [x1,x2] = "intern, r-margin"
24.762 + | www true (x::(xs as _::_)) = "l-margin " ^ www false xs
24.763 + | www _ (x::(xs as _::_)) = "intern " ^ www false xs;
24.764 +www true [1,2,3,4,5];
24.765 +(*val it = "from intern intern intern to" : string*)
24.766 +www true [1,2];
24.767 +(*val it = "from to" : string*)
24.768 +www true [1];
24.769 +(*val it = "from+to" : string*)
24.770 +
24.771 +local
24.772 +(*specific values of hd of pos p,q for simple handling take_fromto,
24.773 + from-pos p, to-pos q: take_fromto (hdp p) (hdq q) (children pt) ...
24.774 + ... can be used even for positions _below_ p or q*)
24.775 +fun hdp [] = 1 | hdp [0] = 1 | hdp x = hd x;(*start with first*)
24.776 +fun hdq [] = 99999 | hdq [0] = 99999 | hdq x = hd x;(*take until last*)
24.777 +(*analoguous for tl*)
24.778 +fun tlp [] = [0] | tlp [_] = [0] | tlp x = tl x;
24.779 +fun tlq [] = [99999] | tlq [_] = [99999] | tlq x = tl x;
24.780 +
24.781 +(*see modspec.sml#pt_form
24.782 +fun pt_form (PrfObj {form,...}) = term2str form
24.783 + | pt_form (PblObj {probl,spec,origin=(_,spec',_),...}) =
24.784 + let val (dI, pI, _) = get_somespec' spec spec'
24.785 + val {cas,...} = get_pbt pI
24.786 + in case cas of
24.787 + NONE => term2str (pblterm dI pI)
24.788 + | SOME t => term2str (subst_atomic (mk_env probl) t)
24.789 + end;
24.790 +*)
24.791 +(*.get an 'interval' from ctree down to a certain level
24.792 + by 'take_fromto children' of the nodes with specific 'from' and 'to';
24.793 + 'i > 0' suppresses output during recursive descent towards 'from'
24.794 + b: the 'from' incremented to the actual pos
24.795 + p,q: specific 'from','to' for simple use of 'take_fromto'*)
24.796 +fun getnd i (b,p) q (Nd (po, nds)) =
24.797 + (if i <= 0 then [(*[(b, pt_form po)]*) (**)[b](**)] else [])
24.798 +
24.799 + @ (writeln("getnd : b="^(ints2str' b)^", p="^
24.800 + (ints2str' p)^", q="^(ints2str' q));
24.801 +
24.802 + getnds (i-1) true (b@[hdp p], tlp p) (tlq q)
24.803 + (take_fromto (hdp p) (hdq q) nds))
24.804 +
24.805 +and getnds _ _ _ _ [] = [] (*no children*)
24.806 + | getnds i _ (b,p) q [nd] = (getnd i (b,p) q nd) (*l+r-margin*)
24.807 + | getnds i true (b,p) q [n1, n2] = (*l-margin, r-margin*)
24.808 + (writeln("getnds3: b="^ ints2str' b ^", p="^ ints2str' p ^
24.809 + ", q="^ ints2str' q);
24.810 + (getnd i ( b, p ) [99999] n1) @
24.811 + (getnd ~99999 (lev_on b,[0]) q n2))
24.812 + | getnds i _ (b,p) q [n1, n2] = (*intern, r-margin*)
24.813 + (writeln("getnds4: b="^ ints2str' b ^", p="^ ints2str' p ^
24.814 + ", q="^ ints2str' q);
24.815 + (getnd i ( b,[0]) [99999] n1) @
24.816 + (getnd ~99999 (lev_on b,[0]) q n2))
24.817 + | getnds i true (b,p) q (nd::(nds as _::_)) = (*l-margin, intern*)
24.818 + (writeln("getnds5: b="^ ints2str' b ^", p="^ ints2str' p ^
24.819 + ", q="^ ints2str' q);
24.820 + (getnd i ( b, p ) [99999] nd) @
24.821 + (getnds ~99999 false (lev_on b,[0]) q nds))
24.822 + | getnds i _ (b,p) q (nd::(nds as _::_)) = (*intern, ...*)
24.823 + (getnd i ( b,[0]) [99999] nd) @
24.824 + (getnds ~99999 false (lev_on b,[0]) q nds);
24.825 +in
24.826 +(*get an 'interval from to' from a ctree as 'intervals f t' of respective nodes
24.827 + where 'from' are pos, i.e. a key as int list, 'f' an int (to,t analoguous)
24.828 +(1) the 'f' are given
24.829 +(1a) by 'from' if 'f' = the respective element of 'from' (left margin)
24.830 +(1b) -inifinity, if 'f' > the respective element of 'from' (internal node)
24.831 +(2) the 't' ar given
24.832 +(2a) by 'to' if 't' = the respective element of 'to' (right margin)
24.833 +(2b) inifinity, if 't' < the respective element of 'to (internal node)'
24.834 +the 'f' and 't' are set by hdp,... *)
24.835 +fun get_trace pt p q =
24.836 + (flat o (getnds ((length p) -1) true ([hdp p], tlp p) (tlq q)))
24.837 + (take_fromto (hdp p) (hdq q) (children pt));
24.838 +end;
24.839 +
24.840 +writeln(pr_ctree pr_short pt);
24.841 +
24.842 +case get_trace pt [1,3] [4,1,1] of
24.843 + [[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1]] => ()
24.844 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1a";
24.845 +case get_trace pt [2] [4,3,2] of
24.846 + [[2],[3],[4],[4,1],[4,1,1],[4,2],[4,3],[4,3,1],[4,3,2]] => ()
24.847 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1b";
24.848 +case get_trace pt [1,4] [4,3,1] of
24.849 + [[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],[4,3],[4,3,1]] => ()
24.850 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1c";
24.851 +
24.852 +
24.853 +(*========== inhibit exn AK110719 ==============================================
24.854 +case get_trace pt [4,2] [5] of
24.855 + (*[([4,2],_),([4,3],_),([4,4],_),([4,4,1],_),([4,4,2],_),([4,4,3],_),
24.856 + ([4,4,4],_),([4,4,5],_),([5],_)] => () ..with pt_form*)
24.857 + [[4,2],[4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5],[5]]=>()
24.858 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1d";
24.859 +========== inhibit exn AK110719 ==============================================*)
24.860 +
24.861 +case get_trace pt [] [4,4,2] of
24.862 + [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],
24.863 + [4,3],[4,3,1],[4,3,2]] => ()
24.864 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1e";
24.865 +
24.866 +(*========== inhibit exn AK110719 ==============================================
24.867 +case get_trace pt [] [] of
24.868 + [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],
24.869 + [4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5],[5]] => ()
24.870 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1f";
24.871 +case get_trace pt [4,3] [4,3] of
24.872 + [[4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5]] => ()
24.873 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1g";
24.874 +========== inhibit exn AK110719 ==============================================*)
24.875 +
24.876 +"--- level 2: get pos' from start b to end p ---------------------";
24.877 +"--- level 2: get pos' from start b to end p ---------------------";
24.878 +"--- level 2: get pos' from start b to end p ---------------------";
24.879 +(*idea: pos_ is _ONLY_ relevant exactly at (endpoint of) from, to
24.880 + development stopped in favour of move_dn, see get_interval
24.881 + actually used (inefficient) version with move_dn: see modspec.sml
24.882 +*)
24.883 +(*
24.884 +case get_trace pt ([1,4],Res) ([4,4,1],Frm) of
24.885 + [[2],[3],[4],[4,1],[4,2],[4,2,1],[4,3],[4,4],[4,4,1]] => ()
24.886 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1b";
24.887 +case get_trace pt ([],Pbl) ([],Res) of
24.888 + [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,2],[4,2,1],[4,3],
24.889 + [4,4],[4,4,1],[4,4,2],[4,4,3],[4,4,4],[4,4,5],[5]] => ()
24.890 + | _ => error "diff.behav.in ctree.sml: get_interval lev 1e";
24.891 +*)
24.892 +
24.893 +(******************************************************************)
24.894 +(**) val get_trace = SAVE_get_trace; (**)
24.895 +(******************************************************************)
24.896 +
24.897 +
24.898 +"=====new ctree 4 ratequation ====================================";
24.899 +"=====new ctree 4 ratequation ====================================";
24.900 +"=====new ctree 4 ratequation ====================================";
24.901 +reset_states ();
24.902 +CalcTree
24.903 +[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
24.904 + "solveFor x","solutions L"],
24.905 + ("RatEq",["univariate","equation"],["no_met"]))];
24.906 +Iterator 1; moveActiveRoot 1;
24.907 +autoCalculate 1 CompleteCalc;
24.908 +val ((pt,_),_) = get_calc 1;
24.909 +val p = get_pos 1 1;
24.910 +val (Form f, tac, asms) = pt_extract (pt, p);
24.911 +(*============ inhibit exn WN120316 ==============================================
24.912 +if term2str f = "[x = 6 / 5]" andalso p = ([], Res) then ()
24.913 + else error "after ===new ctree 4 ratequation ===";
24.914 +(*WN120317.TODO dropped rateq*)
24.915 +============ inhibit exn WN120316 ==============================================*)
24.916 +if p = ([], Res) andalso term2str f = "[]" (*see WN120317.TODO dropped rateq*)
24.917 +andalso asms = [] (*STRANGE!, compare test --- x / (x ^ 2 - 6 * x + 9) - 1 / (x ^ 2 ...*)
24.918 +then () else error "after ===new ctree 4 ratequation ===";
24.919 +
24.920 +
24.921 +"-------------- pt_extract form, tac, asm<>[] --------------------";
24.922 +"-------------- pt_extract form, tac, asm<>[] --------------------";
24.923 +"-------------- pt_extract form, tac, asm<>[] --------------------";
24.924 +val (Form form, SOME tac, asm) = pt_extract (pt, ([3], Res));
24.925 +case (term2str form, tac, terms2strs asm) of
24.926 + ("(3 + -1 * x + x ^^^ 2) * x = 1 * (9 * x + -6 * x ^^^ 2 + x ^^^ 3)",
24.927 + Subproblem
24.928 + ("PolyEq",
24.929 + ["normalise", "polynomial", "univariate", "equation"]),
24.930 + ["9 * x + -6 * x ^^^ 2 + x ^^^ 3 \<noteq> 0"]) => ()
24.931 + | _ => error "diff.behav.in ctree.sml: pt_extract asm<>[]";
24.932 +(*WN060717 unintentionally changed some rls/ord while
24.933 + completing knowl. for thes2file...
24.934 +
24.935 + case (term2str form, tac, terms2strs asm) of
24.936 + ((*"(3 + (-1 * x + x ^^^ 2)) * x = 1 * (9 * x + (x ^^^ 3 + -6 * x ^^^ 2))",
24.937 + *)Subproblem
24.938 + ("PolyEq",
24.939 + ["normalise", "polynomial", "univariate", "equation"]),
24.940 + ["9 * x + (x ^^^ 3 + -6 * x ^^^ 2) ~= 0"]) => ()
24.941 + | _ => error "diff.behav.in ctree.sml: pt_extract asm<>[]";
24.942 +
24.943 +.... but it became even better*)
24.944 +
24.945 +
24.946 +
24.947 +"=====new ctree 5 minisubpbl =====================================";
24.948 +"=====new ctree 5 minisubpbl =====================================";
24.949 +"=====new ctree 5 minisubpbl =====================================";
24.950 +reset_states ();
24.951 +CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
24.952 + ("Test", ["sqroot-test","univariate","equation","test"],
24.953 + ["Test","squ-equ-test-subpbl1"]))];
24.954 +Iterator 1; moveActiveRoot 1;
24.955 +autoCalculate 1 CompleteCalc;
24.956 +val ((pt,_),_) = get_calc 1;
24.957 +show_pt pt;
24.958 +
24.959 +"-------------- pt_extract form, tac, asm ------------------------";
24.960 +"-------------- pt_extract form, tac, asm ------------------------";
24.961 +"-------------- pt_extract form, tac, asm ------------------------";
24.962 +val (ModSpec (_,_,form,_,_,_), SOME tac, asm) = pt_extract (pt, ([], Frm));
24.963 +case (term2str form, tac, terms2strs asm) of
24.964 + ("solve (x + 1 = 2, x)",
24.965 + Apply_Method ["Test", "squ-equ-test-subpbl1"],
24.966 + []) => ()
24.967 + | _ => error "diff.behav.in ctree.sml: pt_extract ([], Pbl)";
24.968 +
24.969 +val (Form form, SOME tac, asm) = pt_extract (pt, ([1], Frm));
24.970 +case (term2str form, tac, terms2strs asm) of
24.971 + ("x + 1 = 2", Rewrite_Set "norm_equation", []) => ()
24.972 + | _ => error "diff.behav.in ctree.sml: pt_extract ([1], Frm)";
24.973 +
24.974 +val (Form form, SOME tac, asm) = pt_extract (pt, ([1], Res));
24.975 +case (term2str form, tac, terms2strs asm) of
24.976 + ("x + 1 + -1 * 2 = 0", Rewrite_Set "Test_simplify", []) => ()
24.977 + | _ => error "diff.behav.in ctree.sml: pt_extract ([1], Res)";
24.978 +
24.979 +val (Form form, SOME tac, asm) = pt_extract (pt, ([2], Res));
24.980 +case (term2str form, tac, terms2strs asm) of
24.981 + ("-1 + x = 0",
24.982 + Subproblem ("Test", ["LINEAR", "univariate", "equation", "test"]),
24.983 + []) => ()
24.984 + | _ => error "diff.behav.in ctree.sml: pt_extract ([2], Res)";
24.985 +
24.986 +val (ModSpec (_,_,form,_,_,_), SOME tac, asm) = pt_extract (pt, ([3], Pbl));
24.987 +case (term2str form, tac, terms2strs asm) of
24.988 + ("solve (-1 + x = 0, x)", Apply_Method ["Test", "solve_linear"], []) => ()
24.989 + | _ => error "diff.behav.in ctree.sml: pt_extract ([3], Pbl)";
24.990 +
24.991 +val (Form form, SOME tac, asm) = pt_extract (pt, ([3,1], Frm));
24.992 +case (term2str form, tac, terms2strs asm) of
24.993 + ("-1 + x = 0", Rewrite_Set_Inst (["(''bdv'', x)"], "isolate_bdv"), []) => ()
24.994 + | _ => error "diff.behav.in ctree.sml: pt_extract ([3,1], Frm)";
24.995 +
24.996 +val (Form form, SOME tac, asm) = pt_extract (pt, ([3,1], Res));
24.997 +case (term2str form, tac, terms2strs asm) of
24.998 + ("x = 0 + -1 * -1", Rewrite_Set "Test_simplify", []) => ()
24.999 + | _ => error "diff.behav.in ctree.sml: pt_extract ([3,1], Res)";
24.1000 +
24.1001 +val (Form form, SOME tac, asm) = pt_extract (pt, ([3,2], Res));
24.1002 +case (term2str form, tac, terms2strs asm) of
24.1003 + ("x = 1", Check_Postcond ["LINEAR", "univariate", "equation", "test"],
24.1004 + []) => ()
24.1005 + | _ => error "diff.behav.in ctree.sml: pt_extract ([3,2], Res)";
24.1006 +
24.1007 +(*========== inhibit exn AK110719 ==============================================
24.1008 +val (Form form, SOME tac, asm) = pt_extract (pt, ([3], Res));
24.1009 +case (term2str form, tac, terms2strs asm) of
24.1010 + ("[x = 1]", Check_elementwise "Assumptions", []) => ()
24.1011 + | _ => error "diff.behav.in ctree.sml: pt_extract ([3], Res)";
24.1012 +
24.1013 +val (Form form, SOME tac, asm) = pt_extract (pt, ([4], Res));
24.1014 +case (term2str form, tac, terms2strs asm) of
24.1015 + ("[x = 1]",
24.1016 + Check_Postcond ["sqroot-test", "univariate", "equation", "test"],
24.1017 + []) => ()
24.1018 + | _ => error "diff.behav.in ctree.sml: pt_extract ([4], Res)";
24.1019 +
24.1020 +val (Form form, tac, asm) = pt_extract (pt, ([], Res));
24.1021 +case (term2str form, tac, terms2strs asm) of
24.1022 + ("[x = 1]", NONE, []) => ()
24.1023 + | _ => error "diff.behav.in ctree.sml: pt_extract ([], Res)";
24.1024 +========== inhibit exn AK110719 ==============================================*)
24.1025 +
24.1026 +"=====new ctree 6 minisubpbl intersteps ==========================";
24.1027 +"=====new ctree 6 minisubpbl intersteps ==========================";
24.1028 +"=====new ctree 6 minisubpbl intersteps ==========================";
24.1029 +reset_states ();
24.1030 +CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
24.1031 + ("Test", ["sqroot-test","univariate","equation","test"],
24.1032 + ["Test","squ-equ-test-subpbl1"]))];
24.1033 +Iterator 1; moveActiveRoot 1;
24.1034 +autoCalculate 1 CompleteCalc;
24.1035 +interSteps 1 ([2],Res);
24.1036 +interSteps 1 ([3,2],Res);
24.1037 +val ((pt,_),_) = get_calc 1;
24.1038 +show_pt pt;
24.1039 +
24.1040 +(**##############################################################**)
24.1041 +"-------------- get_allpos' new ----------------------------------";
24.1042 +"-------------- get_allpos' new ----------------------------------";
24.1043 +"-------------- get_allpos' new ----------------------------------";
24.1044 +"--- whole ctree";
24.1045 +(*default_print_depth 99;*)
24.1046 +val cuts = get_allp [] ([], ([],Frm)) pt;
24.1047 +(*default_print_depth 3;*)
24.1048 +if cuts =
24.1049 + [(*never returns the first pos'*)
24.1050 + ([1], Frm),
24.1051 + ([1], Res),
24.1052 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
24.1053 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
24.1054 + ([2], Res),
24.1055 + ([3], Pbl),
24.1056 + ([3, 1], Frm), ([3, 1], Res),
24.1057 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
24.1058 + ([3, 2], Res),
24.1059 + ([3], Res),
24.1060 + ([4], Res),
24.1061 + ([], Res)] then () else
24.1062 +error "ctree.sml diff.behav. get_allp new []";
24.1063 +
24.1064 +(*default_print_depth 99;*)
24.1065 +val cuts2 = get_allps [] [1] (children pt);
24.1066 +(*default_print_depth 3;*)
24.1067 +if cuts = cuts2 @ [([], Res)] then () else
24.1068 +error "ctree.sml diff.behav. get_allps new []";
24.1069 +
24.1070 +"---(3) on S(606)..S(608)--------";
24.1071 +"--- nd [2] with 6 children---------------------------------";
24.1072 +val cuts = get_allp [] ([2], ([],Frm)) (get_nd pt [2]);
24.1073 +if cuts =
24.1074 + [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
24.1075 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
24.1076 + ([2], Res)] then () else
24.1077 +error "ctree.sml diff.behav. get_allp new [2]";
24.1078 +
24.1079 +val cuts2 = get_allps [] [2,1] (children (get_nd pt [2]));
24.1080 +if cuts = cuts2 @ [([2], Res)] then () else
24.1081 +error "ctree.sml diff.behav. get_allps new [2]";
24.1082 +
24.1083 +
24.1084 +"---(4) on S(606)..S(608)--------";
24.1085 +"--- nd [3] subproblem--------------------------------------";
24.1086 +val cuts = get_allp [] ([3], ([],Frm)) (get_nd pt [3]);
24.1087 +if cuts =
24.1088 + [([3, 1], Frm),
24.1089 + ([3, 1], Res),
24.1090 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
24.1091 + ([3, 2], Res),
24.1092 + ([3], Res)] then () else
24.1093 +error "ctree.sml diff.behav. get_allp new [3]";
24.1094 +
24.1095 +val cuts2 = get_allps [] [3,1] (children (get_nd pt [3]));
24.1096 +if cuts = cuts2 @ [([3], Res)] then () else
24.1097 +error "ctree.sml diff.behav. get_allps new [3]";
24.1098 +
24.1099 +"--- nd [3,2] with 2 children--------------------------------";
24.1100 +val cuts = get_allp [] ([3,2], ([],Frm)) (get_nd pt [3,2]);
24.1101 +if cuts =
24.1102 + [([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
24.1103 + ([3, 2], Res)] then () else
24.1104 +error "ctree.sml diff.behav. get_allp new [3,2]";
24.1105 +
24.1106 +val cuts2 = get_allps [] [3,2,1] (children (get_nd pt [3,2]));
24.1107 +if cuts = cuts2 @ [([3, 2], Res)] then () else
24.1108 +error "ctree.sml diff.behav. get_allps new [3,2]";
24.1109 +
24.1110 +"---(5a) on S(606)..S(608)--------";
24.1111 +"--- nd [3,2,1] with 0 children------------------------------";
24.1112 +val cuts = get_allp [] ([3,2,1], ([],Frm)) (get_nd pt [3,2,1]);
24.1113 +if cuts =
24.1114 + [] then () else
24.1115 +error "ctree.sml diff.behav. get_allp new [3,2,1]";
24.1116 +
24.1117 +val cuts2 = get_allps [] [3,2,1,1] (children (get_nd pt [3,2,1]));
24.1118 +if cuts = cuts2 @ [] then () else
24.1119 +error "ctree.sml diff.behav. get_allps new [3,2,1]";
24.1120 +
24.1121 +
24.1122 +(**#################################################################**)
24.1123 +"-------------- cut_tree new (from ctree above)-------------------";
24.1124 +"-------------- cut_tree new (from ctree above)-------------------";
24.1125 +"-------------- cut_tree new (from ctree above)-------------------";
24.1126 +show_pt pt;
24.1127 +val b = get_obj g_branch pt [];
24.1128 +if b = TransitiveB then () else
24.1129 +error ("ctree.sml diff.behav. in [] branch="^branch2str b);
24.1130 +val b = get_obj g_branch pt [3];
24.1131 +if b = TransitiveB then () else
24.1132 +error ("ctree.sml diff.behav. in [3] branch="^branch2str b);
24.1133 +
24.1134 +"---(2) on S(606)..S(608)--------";
24.1135 +val (pt', cuts) = cut_tree pt ([1],Res);
24.1136 +(*default_print_depth 99;*)
24.1137 +cuts;
24.1138 +(*default_print_depth 3;*)
24.1139 +if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
24.1140 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
24.1141 + ([3, 1], Frm), ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
24.1142 + ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
24.1143 + ([], Res)] then () else
24.1144 +error "ctree.sml: diff.behav. cut_tree ([1],Res)";
24.1145 +
24.1146 +
24.1147 +"---(3) on S(606)..S(608)--------";
24.1148 +val (pt', cuts) = cut_tree pt ([2],Res);
24.1149 +(*default_print_depth 99;*)
24.1150 +cuts;
24.1151 +(*default_print_depth 3;*)
24.1152 +if cuts = [(*preceding step on WS was ([1]),Res*)
24.1153 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
24.1154 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
24.1155 + ([2], Res),
24.1156 + ([3], Pbl),
24.1157 + ([3, 1], Frm),
24.1158 + ([3, 1], Res),
24.1159 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
24.1160 + ([3, 2], Res),
24.1161 + ([3], Res),
24.1162 + ([4], Res),
24.1163 + ([],Res)] then ()
24.1164 +else error "ctree.sml: diff.behav. cut_tree ([2],Res)";
24.1165 +
24.1166 +"---(4) on S(606)..S(608)--------";
24.1167 +val (pt', cuts) = cut_tree pt ([3],Pbl);
24.1168 +(*default_print_depth 99;*)
24.1169 +cuts;
24.1170 +(*default_print_depth 3;*)
24.1171 +if cuts = [([3], Pbl),
24.1172 + ([3, 1], Frm), ([3, 1], Res),
24.1173 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
24.1174 + ([3, 2], Res),
24.1175 + ([3], Res),
24.1176 + ([4], Res),
24.1177 + ([], Res)]
24.1178 +then () else error "ctree.sml: diff.behav. cut_tree ([3],Pbl)";
24.1179 +
24.1180 +"---(5a) on S(606)..S(608) cut_tree --------";
24.1181 +val (pt', cuts) = cut_tree pt ([3,2,1],Res);
24.1182 +(*default_print_depth 99;*)
24.1183 +cuts;
24.1184 +(*default_print_depth 1;*)
24.1185 +if cuts = [([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),([],Res)] then ()
24.1186 +else error "ctree.sml: diff.behav. cut_tree ([3,2,1],Res)";
24.1187 +show_pt pt';
24.1188 +
24.1189 +
24.1190 +"-------------- cappend on complete ctree from above -------------";
24.1191 +"-------------- cappend on complete ctree from above -------------";
24.1192 +"-------------- cappend on complete ctree from above -------------";
24.1193 +show_pt pt;
24.1194 +
24.1195 +"---(2) on S(606)..S(608)--------";
24.1196 +(*========== inhibit exn AK110726 ==============================================
24.1197 +(* ERROR: Can't unify istate to istate * Proof.context *)
24.1198 +val (pt', cuts) = cappend_atomic pt [1] e_istate (str2term "Inform[1]")
24.1199 + (Tac "test") (str2term "Inres[1]",[]) Complete;
24.1200 +
24.1201 +(*default_print_depth 99;*)
24.1202 +cuts;
24.1203 +(*default_print_depth 3;*)
24.1204 +if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
24.1205 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
24.1206 + ([3, 1], Frm), ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
24.1207 + ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
24.1208 + ([], Res)] then ()
24.1209 +else error "ctree.sml: diff:behav. in complete pt:append_atomic[1] cuts";
24.1210 +
24.1211 +val afterins = get_allp [] ([], ([],Frm)) pt';
24.1212 +(*default_print_depth 99;*)
24.1213 +afterins;
24.1214 +(*default_print_depth 3;*)
24.1215 +if afterins = [([1], Frm), ([1], Res)] then()
24.1216 +else error "ctree.sml: diff:behav. in complete pt: append_atomic[1] afterins";
24.1217 +show_pt pt';
24.1218 +"---(3) on S(606)..S(608)--------";
24.1219 +show_pt pt;
24.1220 +val (pt', cuts) = cappend_atomic pt [2] e_istate (str2term "Inform[2]")
24.1221 + (Tac "test") (str2term "Inres[2]",[]) Complete;
24.1222 +(*default_print_depth 99;*)
24.1223 +cuts;
24.1224 +(*default_print_depth 3;*)
24.1225 +
24.1226 +if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
24.1227 + ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
24.1228 + ([3, 1], Frm),([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
24.1229 + ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
24.1230 + ([], Res)] then ()
24.1231 +else error "ctree.sml: diff:behav.in complete pt: append_atomic[2] cuts";
24.1232 +
24.1233 +
24.1234 +val afterins = get_allp [] ([], ([],Frm)) pt';
24.1235 +(*default_print_depth 99;*)
24.1236 +afterins;
24.1237 +(*default_print_depth 3;*)
24.1238 +
24.1239 +if afterins = [([1], Frm), ([1], Res), ([2], Frm), ([2], Res)]
24.1240 +then () else
24.1241 +error "ctree.sml: diff:behav. in complete pt: append_atomic[2] afterins";
24.1242 +show_pt pt';
24.1243 +
24.1244 +
24.1245 +(*
24.1246 + val p = move_dn [] pt' ([],Pbl) (*-> ([1],Frm)*);
24.1247 + val p = move_dn [] pt' p (*-> ([1],Res)*);
24.1248 + val p = move_dn [] pt' p (*-> ([2],Frm)*);
24.1249 + val p = move_dn [] pt' p (*-> ([2],Res)*);
24.1250 +
24.1251 + term2str (get_obj g_form pt' [2]);
24.1252 + term2str (get_obj g_res pt' [2]);
24.1253 + ostate2str (get_obj g_ostate pt' [2]);
24.1254 + *)
24.1255 +
24.1256 +"---(4) on S(606)..S(608)--------";
24.1257 +val (pt', cuts) = cappend_problem pt [3] e_istate ([],e_spec)
24.1258 + ([],e_spec, str2term "Inhead[3]");
24.1259 +(*default_print_depth 99;*)
24.1260 +cuts;
24.1261 +(*default_print_depth 3;*)
24.1262 +if cuts = [([3], Pbl),
24.1263 + ([3, 1], Frm), ([3, 1], Res),
24.1264 + ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
24.1265 + ([3, 2], Res),
24.1266 + ([3], Res), ([4], Res),
24.1267 + ([], Res)] then ()else
24.1268 +error "ctree.sml: diff:behav. in ccomplete pt: append_problem[3] cuts";
24.1269 +val afterins = get_allp [] ([], ([],Frm)) pt';
24.1270 +(*default_print_depth 99;*)
24.1271 +afterins;
24.1272 +(*default_print_depth 3;*)
24.1273 +if afterins =
24.1274 + [([1], Frm), ([1], Res),([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
24.1275 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res),
24.1276 + ([3], Pbl)] then () else
24.1277 +error "ctree.sml: diff:behav.in complete pt: append_problem[3] afterins";
24.1278 +(* use"systest/ctree.sml";
24.1279 + use"ctree.sml";
24.1280 + *)
24.1281 +
24.1282 +"---(6-1) on S(606)..S(608)--------";
24.1283 +val (pt', cuts) = cappend_atomic pt [3,1] e_istate (str2term "Inform[3,1]")
24.1284 + (Tac "test") (str2term "Inres[3,1]",[]) Complete;
24.1285 +(*default_print_depth 99;*)
24.1286 +cuts;
24.1287 +(*default_print_depth 3;*)
24.1288 +if cuts = [([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
24.1289 + ([3, 2], Res),
24.1290 +(*WN060727 added*)([3], Res), ([4], Res), ([], Res)] then () else
24.1291 +error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] cuts";
24.1292 +
24.1293 +val afterins = get_allp [] ([], ([],Frm)) pt';
24.1294 +(*default_print_depth 99;*)
24.1295 +afterins;
24.1296 +(*default_print_depth 3;*)
24.1297 +if afterins = [([1], Frm), ([1], Res),
24.1298 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
24.1299 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
24.1300 + ([2], Res),
24.1301 + ([3], Pbl),
24.1302 + ([3, 1], Frm), ([3, 1], Res)] then () else
24.1303 +error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] insrtd";
24.1304 +
24.1305 +if term2str (get_obj g_form pt' [3,1]) = "Inform [3, 1]" then () else
24.1306 +error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] Inform";
24.1307 +
24.1308 +"---(6) on S(606)..S(608)--------";
24.1309 +val (pt', cuts) = cappend_atomic pt [3,2] e_istate (str2term "Inform[3,2]")
24.1310 + (Tac "test") (str2term "Inres[3,2]",[]) Complete;
24.1311 +(*default_print_depth 99;*)
24.1312 +cuts;
24.1313 +(*default_print_depth 3;*)
24.1314 +if cuts = [([3], Res), ([4], Res), ([], Res)] then () else
24.1315 +error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] cuts";
24.1316 +val afterins = get_allp [] ([], ([],Frm)) pt';
24.1317 +(*default_print_depth 99;*)
24.1318 +afterins;
24.1319 +(*default_print_depth 3;*)
24.1320 +if afterins = [([1], Frm), ([1], Res),
24.1321 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
24.1322 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
24.1323 + ([2], Res),
24.1324 + ([3], Pbl),
24.1325 + ([3, 1], Frm), ([3, 1], Res), ([3, 2], Frm), ([3, 2], Res)]
24.1326 +then () else
24.1327 +error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] insrtd";
24.1328 +
24.1329 +if term2str (get_obj g_form pt' [3,2]) = "Inform [3, 2]" then () else
24.1330 +error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] Inform";
24.1331 +
24.1332 +"---(6++) on S(606)..S(608)--------";
24.1333 +(**)
24.1334 +val (pt', cuts) = cappend_atomic pt [3,2,1] e_istate (str2term "Inform[3,2,1]")
24.1335 + (Tac "test") (str2term "Inres[3,2,1]",[]) Complete;
24.1336 +(*default_print_depth 99;*)
24.1337 +cuts;
24.1338 +(*default_print_depth 1;*)
24.1339 +if cuts = [([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res), ([], Res)]
24.1340 +then () else
24.1341 +error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2,1] cuts";
24.1342 +val afterins = get_allp [] ([], ([],Frm)) pt';
24.1343 +(*default_print_depth 99;*)
24.1344 +afterins;
24.1345 +(*default_print_depth 3;*)
24.1346 +if afterins = [([1], Frm), ([1], Res),
24.1347 + ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
24.1348 + ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
24.1349 + ([2], Res),
24.1350 + ([3], Pbl),
24.1351 + ([3, 1], Frm), ([3, 1], Res),
24.1352 + ([3, 2, 1], Frm), ([3, 2, 1], Res)] then () else
24.1353 +error "ctree.sml: diff:behav. in complete pt: append_atom[3,2,1] insrtd";
24.1354 +if term2str (get_obj g_form pt' [3,2,1]) = "Inform [3, 2, 1]" then () else
24.1355 +error "ctree.sml: diff:behav. complete pt: append_atomic[3,2,1] Inform";
24.1356 +(*
24.1357 +show_pt pt';
24.1358 +show_pt pt;
24.1359 +*)
24.1360 +========== inhibit exn AK110726 ==============================================*)
24.1361 +"-------------- repl_app------------------------------------------";
24.1362 +"-------------- repl_app------------------------------------------";
24.1363 +"-------------- repl_app------------------------------------------";
24.1364 +(*
24.1365 +> repl [1,2,3] 2 22222;
24.1366 +val it = [1,22222,3] : int list
24.1367 +> repl_app [1,2,3,4] 5 5555;
24.1368 +val it = [1,2,3,4,5555] : int list
24.1369 +> repl_app [1,2,3] 2 22222;
24.1370 +val it = [1,22222,3] : int list
24.1371 +> repl_app [1] 2 22222 ;
24.1372 +val it = [1,22222] : int list
24.1373 +*)
25.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
25.2 +++ b/test/Tools/isac/MathEngBasic/model.sml Sat Oct 26 13:03:16 2019 +0200
25.3 @@ -0,0 +1,51 @@
25.4 +(* Title: "Specify/model.sml"
25.5 + Author: Walther Neuper
25.6 + (c) due to copyright terms
25.7 +*)
25.8 +
25.9 +"-----------------------------------------------------------------------------------------------";
25.10 +"table of contents -----------------------------------------------------------------------------";
25.11 +"-----------------------------------------------------------------------------------------------";
25.12 +"-----------------------------------------------------------------------------------------------";
25.13 +"----------- fun upd_envv ----------------------------------------------------------------------";
25.14 +"-----------------------------------------------------------------------------------------------";
25.15 +"-----------------------------------------------------------------------------------------------";
25.16 +"-----------------------------------------------------------------------------------------------";
25.17 +
25.18 +
25.19 +"----------- fun upd_envv ----------------------------------------------------------------------";
25.20 +"----------- fun upd_envv ----------------------------------------------------------------------";
25.21 +"----------- fun upd_envv ----------------------------------------------------------------------";
25.22 +(* 14.9.01: not used after putting pre-penv into itm_
25.23 +fun upd_envv thy envv vats dsc id vl =
25.24 +
25.25 +THUS ..*)
25.26 +(*//------------------------------ wait for re-design of Specify ----------------------------\\* )
25.27 + val envv = [(1,[]:penv),(2,[]:penv),(3,[]:penv)]:envv;
25.28 +
25.29 + val vats = [2]
25.30 + val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"boundVariable b";
25.31 + val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"boundVariable v_";
25.32 + val envv = upd_envv thy envv vats dsc id vl;
25.33 +val envv = [(2,[(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")])])]
25.34 + : (int * (term * term list) list) list
25.35 +
25.36 + val vats = [1,2,3];
25.37 + val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"maximum A";
25.38 + val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"maximum m_";
25.39 + upd_envv thy envv vats dsc id vl;
25.40 +[(1,[(Free ("m_","bool"),[Free ("A","bool")])]),
25.41 + (2,
25.42 + [(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")]),
25.43 + (Free ("m_","bool"),[Free ("A","bool")])]),
25.44 + (3,[(Free ("m_","bool"),[Free ("A","bool")])])]
25.45 +: (int * (term * term list) list) list
25.46 +
25.47 +
25.48 + val env = []:envv;
25.49 + val (d,ts) = (split_dts o Thm.term_of o the o (parse thy))
25.50 + "fixedValues [r=Arbfix]";
25.51 + val (_,id) = (split_did o Thm.term_of o the o (parse thy))"fixedValues fix_";
25.52 + val vats = [1,2,3];
25.53 + val env = upd_envv thy env vats d id (mkval ts);
25.54 +( *\\------------------------------ wait for re-design of Specify ----------------------------//*)
25.55 \ No newline at end of file
26.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
26.2 +++ b/test/Tools/isac/MathEngBasic/mstools.sml Sat Oct 26 13:03:16 2019 +0200
26.3 @@ -0,0 +1,302 @@
26.4 +(* Title: tests for Interpret/mstools.sml
26.5 + Author: Walther Neuper 100930, Mathias Lehnfeld
26.6 + (c) copyright due to lincense terms.
26.7 +*)
26.8 +"-----------------------------------------------------------------------------------------------";
26.9 +"table of contents -----------------------------------------------------------------------------";
26.10 +"-----------------------------------------------------------------------------------------------";
26.11 +"----------- go through Model_Problem until nxt_tac --------------------------------------------";
26.12 +"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
26.13 +"----------- type penv -------------------------------------------------------------------------";
26.14 +"----------- fun untouched ---------------------------------------------------------------------";
26.15 +"----------- fun pbl_ids -----------------------------------------------------------------------";
26.16 +"----------- fun upd_penv ----------------------------------------------------------------------";
26.17 +"----------- fun upd ---------------------------------------------------------------------------";
26.18 +"----------- fun upds_envv ---------------------------------------------------------------------";
26.19 +"----------- fun common_subthy -----------------------------------------------------------------";
26.20 +"--------------------------------------------------------";
26.21 +"--------------------------------------------------------";
26.22 +"--------------------------------------------------------";
26.23 +"--------------------------------------------------------";
26.24 +
26.25 +
26.26 +"----------- go through Model_Problem until nxt_tac --------------------------------------------";
26.27 +"----------- go through Model_Problem until nxt_tac --------------------------------------------";
26.28 +"----------- go through Model_Problem until nxt_tac --------------------------------------------";
26.29 +(*FIXME.WN110511 delete this test? (goes through "Model_Problem until nxt_tac)*)
26.30 +val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
26.31 +val (dI',pI',mI') =
26.32 + ("Test", ["sqroot-test","univariate","equation","test"],
26.33 + ["Test","squ-equ-test-subpbl1"]);
26.34 +(*========== inhibit exn AK110725 ================================================
26.35 +(* ERROR: same as above, see lines 120- 123 *)
26.36 +val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
26.37 +========== inhibit exn AK110725 ================================================*)
26.38 +
26.39 +(*========== inhibit exn AK110725 ================================================
26.40 +(* ERROR: p, nxt, pt not declared due to above error *)
26.41 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.42 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.43 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.44 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.45 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.46 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.47 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.48 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.49 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
26.50 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Subproblem",*)
26.51 +val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Model_Problem",*)
26.52 +"~~~~~ fun me, args:"; val (_,tac) = nxt;
26.53 +val (pt, p) = case locatetac tac (pt,p) of
26.54 + ("ok", (_, _, ptp)) => ptp | _ => error "script.sml locatetac";
26.55 +"~~~~~ fun step, args:"; val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'), []))
26.56 +val pIopt = get_pblID (pt,ip);
26.57 +tacis; (*= []*)
26.58 +pIopt; (*= SOME ["sqroot-test", "univariate", ...]*)
26.59 +member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (*= true*)
26.60 +"~~~~~ fun nxt_specify_, args:"; val (ptp as (pt, pos as (p,p_))) = (pt, ip);
26.61 +val pblobj as (PblObj{meth,origin=origin as (oris,(dI',pI',mI'),_),
26.62 + probl,spec=(dI,pI,mI),...}) = get_obj I pt p;
26.63 +just_created_ pblobj (*by Subproblem*) andalso origin <> e_origin; (*false=oldNB*)
26.64 +val cpI = if pI = e_pblID then pI' else pI;
26.65 + val cmI = if mI = e_metID then mI' else mI;
26.66 + val {ppc, prls, where_, ...} = get_pbt cpI;
26.67 + val pre = check_preconds "thy 100820" prls where_ probl;
26.68 + val pb = foldl and_ (true, map fst pre);
26.69 +val (_,tac) = nxt_spec p_ pb oris (dI',pI',mI') (probl, meth)
26.70 + (ppc, (#ppc o get_met) cmI) (dI, pI, mI); (*tac = Add_Given "equality (-1 + x = 0)"*)
26.71 +"~~~~~ fun nxt_specif, args:"; val (Add_Given ct, ptp) = (tac, ptp);
26.72 +"~~~~~ fun nxt_specif_additem, args:"; val (sel, ct, ptp as (pt, (p, Pbl))) = ("#Given", ct, ptp);
26.73 +val (PblObj{meth=met,origin=(oris,(dI',pI',_),_),
26.74 + probl=pbl,spec=(dI,pI,_),...}) = get_obj I pt p;
26.75 +val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
26.76 +val cpI = if pI = e_pblID then pI' else pI;
26.77 +val ctxt = get_ctxt pt (p, Pbl);
26.78 +"~~~~~ fun appl_add, args:"; val (ctxt, sel, oris, ppc, pbt, str) = (ctxt, sel, oris, pbl, ((#ppc o get_pbt) cpI), ct);
26.79 +val SOME t = parseNEW ctxt str;
26.80 +is_known ctxt sel oris t;
26.81 +"~~~~~ fun is_known, args:"; val (ctxt, sel, ori, t) = (ctxt, sel, oris, t);
26.82 +val _ = tracing ("RM is_known: t=" ^ term2str t);
26.83 +val ots = (distinct o flat o (map #5)) (ori:ori list);
26.84 +val oids = ((map (fst o dest_Free)) o distinct o flat o (map vars)) ots;
26.85 +val (d, ts) = split_dts t;
26.86 +"~~~~~ fun split_dts, args:"; val (t as d $ arg) = t;
26.87 +(*if is_dsc d then () else error "TODO";*)
26.88 +if is_dsc d then () else error "TODO";
26.89 +"----- these were the errors (call hierarchy from bottom up)";
26.90 +appl_add ctxt sel oris pbl ((#ppc o get_pbt) cpI) ct;(*WAS
26.91 +Err "[error] appl_add: is_known: identifiers [equality] not in example"*)
26.92 +nxt_specif_additem "#Given" ct ptp;(*WAS
26.93 +Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
26.94 +nxt_specif tac ptp;(*WAS
26.95 +Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
26.96 +nxt_specify_ (pt,ip); (*WAS
26.97 +Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
26.98 +(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; WAS
26.99 +Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
26.100 +========== inhibit exn AK110725 ================================================*)
26.101 +
26.102 +"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
26.103 +"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
26.104 +"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
26.105 +(*val t = str2term "maximum A";
26.106 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.107 +val it = "maximum A" : cterm
26.108 +> val t = str2term "fixedValues [r=Arbfix]";
26.109 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.110 +"fixedValues [r = Arbfix]"
26.111 +> val t = str2term "valuesFor [a]";
26.112 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.113 +"valuesFor [a]"
26.114 +> val t = str2term "valuesFor [a,b]";
26.115 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.116 +"valuesFor [a, b]"
26.117 +> val t = str2term "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]";
26.118 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.119 +relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]"
26.120 +> val t = str2term "boundVariable a";
26.121 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.122 +"boundVariable a"
26.123 +> val t = str2term "interval {x::real. 0 <= x & x <= 2*r}";
26.124 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.125 +"interval {x. 0 <= x & x <= 2 * r}"
26.126 +
26.127 +> val t = str2term "equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))";
26.128 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.129 +"equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))"
26.130 +> val t = str2term "solveFor x";
26.131 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.132 +"solveFor x"
26.133 +> val t = str2term "errorBound (eps=0)";
26.134 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.135 +"errorBound (eps = 0)"
26.136 +> val t = str2term "solutions L";
26.137 +> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
26.138 +"solutions L"
26.139 +
26.140 +before 6.5.03:
26.141 +> val t = (Thm.term_of o the o (parse thy)) "testdscforlist [#1]";
26.142 +> val (d,ts) = split_dts t;
26.143 +> comp_dts thy (d,ts);
26.144 +val it = "testdscforlist [#1]" : cterm
26.145 +
26.146 +> val t = (Thm.term_of o the o (parse thy)) "(A::real)";
26.147 +> val (d,ts) = split_dts t;
26.148 +val d = Const ("empty","empty") : term
26.149 +val ts = [Free ("A","RealDef.real")] : term list
26.150 +> val t = (Thm.term_of o the o (parse thy)) "[R=(R::real)]";
26.151 +> val (d,ts) = split_dts t;
26.152 +val d = Const ("empty","empty") : term
26.153 +val ts = [Const # $ Free # $ Free (#,#)] : term list
26.154 +> val t = (Thm.term_of o the o (parse thy)) "[#1,#2]";
26.155 +> val (d,ts) = split_dts t;
26.156 +val ts = [Free ("#1","'a"),Free ("#2","'a")] : NOT WANTED
26.157 +*)
26.158 +"----------- type penv -------------------------------------------------------------------------";
26.159 +"----------- type penv -------------------------------------------------------------------------";
26.160 +"----------- type penv -------------------------------------------------------------------------";
26.161 +(*
26.162 + val e_ = (Thm.term_of o the o (parse thy)) "e_::bool";
26.163 + val ev = (Thm.term_of o the o (parse thy)) "#4 + #3 * x^^^#2 = #0";
26.164 + val v_ = (Thm.term_of o the o (parse thy)) "v_";
26.165 + val vv = (Thm.term_of o the o (parse thy)) "x";
26.166 + val r_ = (Thm.term_of o the o (parse thy)) "err_::bool";
26.167 + val rv1 = (Thm.term_of o the o (parse thy)) "#0";
26.168 + val rv2 = (Thm.term_of o the o (parse thy)) "eps";
26.169 +
26.170 + val penv = [(e_,[ev]),(v_,[vv]),(r_,[rv2,rv2])]:penv;
26.171 + map getval penv;
26.172 +[(Free ("e_","bool"),
26.173 + Const (#,#) $ (# $ # $ (# $ #)) $ Free ("#0","RealDef.real")),
26.174 + (Free ("v_","RealDef.real"),Free ("x","RealDef.real")),
26.175 + (Free ("err_","bool"),Free ("#0","RealDef.real"))] : (term * term) list
26.176 +*)
26.177 +"----------- fun untouched ---------------------------------------------------------------------";
26.178 +"----------- fun untouched ---------------------------------------------------------------------";
26.179 +"----------- fun untouched ---------------------------------------------------------------------";
26.180 +(*> untouched [];
26.181 +val it = true : bool
26.182 +> untouched [e_itm];
26.183 +val it = true : bool
26.184 +> untouched [e_itm, (1,[],false,"e_itm",Syn "e_itm")];
26.185 +val it = false : bool*)
26.186 +"----------- fun pbl_ids -----------------------------------------------------------------------";
26.187 +"----------- fun pbl_ids -----------------------------------------------------------------------";
26.188 +"----------- fun pbl_ids -----------------------------------------------------------------------";
26.189 +(*
26.190 +val t as t1 $ t2 = str2term "antiDerivativeName M_b";
26.191 +pbl_ids ctxt t1 t2;
26.192 +
26.193 + val t = (Thm.term_of o the o (parse thy)) "fixedValues [r=Arbfix]";
26.194 + val (d,argl) = strip_comb t;
26.195 + is_dsc d; (*see split_dts*)
26.196 + dest_list (d,argl);
26.197 + val (_ $ v) = t;
26.198 + is_list v;
26.199 + pbl_ids ctxt d v;
26.200 +[Const ("List.list.Cons","[bool, bool List.list] => bool List.list") $
26.201 + (Const # $ Free # $ Const (#,#)) $ Const ("List.list.Nil","bool List..
26.202 +
26.203 + val (dsc,vl) = (split_dts o Thm.term_of o the o (parse thy)) "solveFor x";
26.204 +val dsc = Const ("Input_Descript.solveFor","RealDef.real => Tools.una") : term
26.205 +val vl = Free ("x","RealDef.real") : term
26.206 +
26.207 + val (dsc,id) = (split_did o Thm.term_of o the o (parse thy)) "solveFor v_";
26.208 + pbl_ids ctxt dsc vl;
26.209 +val it = [Free ("x","RealDef.real")] : term list
26.210 +
26.211 + val (dsc,vl) = (split_dts o Thm.term_of o the o(parse thy))
26.212 + "errorBound (eps=#0)";
26.213 + val (dsc,id) = (split_did o Thm.term_of o the o(parse thy)) "errorBound err_";
26.214 + pbl_ids ctxt dsc vl;
26.215 +val it = [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")] : term list *)
26.216 +"----------- fun upd_penv ----------------------------------------------------------------------";
26.217 +"----------- fun upd_penv ----------------------------------------------------------------------";
26.218 +"----------- fun upd_penv ----------------------------------------------------------------------";
26.219 +(*
26.220 + val penv = [];
26.221 + val (dsc,vl) = (split_did o Thm.term_of o the o (parse thy)) "solveFor x";
26.222 + val (dsc,id) = (split_did o Thm.term_of o the o (parse thy)) "solveFor v_";
26.223 + val penv = upd_penv thy penv dsc (id, vl);
26.224 +[(Free ("v_","RealDef.real"),
26.225 + [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")])]
26.226 +: (term * term list) list
26.227 +
26.228 + val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"errorBound (eps=#0)";
26.229 + val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"errorBound err_";
26.230 + upd_penv thy penv dsc (id, vl);
26.231 +[(Free ("v_","RealDef.real"),
26.232 + [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")]),
26.233 + (Free ("err_","bool"),
26.234 + [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")])]
26.235 +: (term * term list) list ^.........!!!!
26.236 +*)
26.237 +"----------- fun upd ---------------------------------------------------------------------------";
26.238 +"----------- fun upd ---------------------------------------------------------------------------";
26.239 +"----------- fun upd ---------------------------------------------------------------------------";
26.240 +(*
26.241 + val i = 2;
26.242 + val envv = [(1,[]:penv),(2,[]:penv),(3,[]:penv)]:envv;
26.243 + val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"boundVariable b";
26.244 + val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"boundVariable v_";
26.245 + upd thy envv dsc (id, vl) i;
26.246 +val it = (2,[(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")])])
26.247 + : int * (term * term list) list*)
26.248 +
26.249 +"----------- fun upds_envv ---------------------------------------------------------------------";
26.250 +"----------- fun upds_envv ---------------------------------------------------------------------";
26.251 +"----------- fun upds_envv ---------------------------------------------------------------------";
26.252 +(* eval test-maximum.sml until Specify_Method ...
26.253 + val PblObj{probl=(_,pbl),origin=(_,(_,_,mI),_),...} = get_obj I pt [];
26.254 + val met = (#ppc o get_met) mI;
26.255 +
26.256 + val envv = [];
26.257 + val eargs = flat eargs;
26.258 + val (vs, dsc, id, vl) = hd eargs;
26.259 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
26.260 +
26.261 + val (vs, dsc, id, vl) = hd (tl eargs);
26.262 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
26.263 +
26.264 + val (vs, dsc, id, vl) = hd (tl (tl eargs));
26.265 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
26.266 +
26.267 + val (vs, dsc, id, vl) = hd (tl (tl (tl eargs)));
26.268 + val envv = upds_envv thy envv [(vs, dsc, id, vl)];
26.269 +[(1,
26.270 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
26.271 + (Free ("m_","bool"),[Free (#,#)]),
26.272 + (Free ("vs_","bool List.list"),[# $ # $ Const #]),
26.273 + (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
26.274 + (2,
26.275 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
26.276 + (Free ("m_","bool"),[Free (#,#)]),
26.277 + (Free ("vs_","bool List.list"),[# $ # $ Const #]),
26.278 + (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
26.279 + (3,
26.280 + [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
26.281 + (Free ("m_","bool"),[Free (#,#)]),
26.282 + (Free ("vs_","bool List.list"),[# $ # $ Const #])])] : envv *)
26.283 +
26.284 +"----------- fun common_subthy -----------------------------------------------------------------";
26.285 +"----------- fun common_subthy -----------------------------------------------------------------";
26.286 +"----------- fun common_subthy -----------------------------------------------------------------";
26.287 +val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory Inverse_Z_Transform});
26.288 +if Context.theory_name (common_subthy (thy1, thy2)) = "Inverse_Z_Transform"
26.289 +then () else error "common_subthy 1";
26.290 +
26.291 +val (thy1, thy2) = (@{theory Inverse_Z_Transform}, @{theory Partial_Fractions});(* Isac.Inverse_Z_Transform *)
26.292 +if Context.theory_name (common_subthy (thy1, thy2)) = "Inverse_Z_Transform"
26.293 +then () else error "common_subthy 2";
26.294 +
26.295 +val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory PolyEq});
26.296 +if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 3";
26.297 +
26.298 +val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory Isac_Knowledge});
26.299 +if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 4";
26.300 +
26.301 +val (thy1, thy2) = (@{theory PolyEq}, @{theory Partial_Fractions});
26.302 +if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 5";
26.303 +
26.304 +val (thy1, thy2) = (@{theory Isac_Knowledge}, @{theory Partial_Fractions});
26.305 +if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 6";
27.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
27.2 +++ b/test/Tools/isac/MathEngBasic/specification-elems.sml Sat Oct 26 13:03:16 2019 +0200
27.3 @@ -0,0 +1,62 @@
27.4 +(* ~~/test/Tools/isac/Interpret/specification-elems.sml
27.5 + Author: Walther Neuper
27.6 + Use is subject to license terms.
27.7 +*)
27.8 +
27.9 +"-----------------------------------------------------------------------------";
27.10 +"-----------------------------------------------------------------------------";
27.11 +"table of contents -----------------------------------------------------------";
27.12 +"-----------------------------------------------------------------------------";
27.13 +"-------- fun subst_to_subst' ------------------------------------------------";
27.14 +"-------- fun subst'_to_sube -------------------------------------------------";
27.15 +"-------- fun subs2subst -----------------------------------------------------";
27.16 +"-------- fun subst'_to_subst ------------------------------------------------";
27.17 +"-------- fun subst2subs -----------------------------------------------------";
27.18 +"-----------------------------------------------------------------------------";
27.19 +"-----------------------------------------------------------------------------";
27.20 +
27.21 +"-------- fun subst_to_subst' ------------------------------------------------";
27.22 +"-------- fun subst_to_subst' ------------------------------------------------";
27.23 +"-------- fun subst_to_subst' ------------------------------------------------";
27.24 +val subst_rew =
27.25 + [(@{term "bdv_1 :: real"}, @{term "x :: real"}),
27.26 + (@{term "bdv_2 :: real"}, @{term "y :: real"}),
27.27 + (@{term "bdv_3 :: real"}, @{term "z :: real"})];
27.28 +if term2str (subst_to_subst' subst_rew) = "[(''bdv_1'', x), (''bdv_2'', y), (''bdv_3'', z)]"
27.29 +then () else error "subst_to_subst' changed"
27.30 +
27.31 +"-------- fun subst'_to_sube -------------------------------------------------";
27.32 +"-------- fun subst'_to_sube -------------------------------------------------";
27.33 +"-------- fun subst'_to_sube -------------------------------------------------";
27.34 +val subst_prog = @{term "[(''bdv_1'', x::real), (''bdv_2'', y::real), (''bdv_3'', z::real)]"};
27.35 +if Selem.subst'_to_sube subst_prog = ["(''bdv_1'', x)", "(''bdv_2'', y)", "(''bdv_3'', z)"] then ()
27.36 +else error "subst'_to_sube changed";
27.37 +
27.38 +"-------- fun subs2subst -----------------------------------------------------";
27.39 +"-------- fun subs2subst -----------------------------------------------------";
27.40 +"-------- fun subs2subst -----------------------------------------------------";
27.41 +case subs2subst @{theory} ["(''bdv_1'', x)", "(''bdv_2'', y)", "(''bdv_3'', z)"] of
27.42 + [(Free ("bdv_1", _), Free ("x", _)),
27.43 + (Free ("bdv_2", _), Free ("y", _)),
27.44 + (Free ("bdv_3", _), Free ("z", _))] => ()
27.45 +| _ => error "subs2subst changed";
27.46 +
27.47 +"-------- fun subst'_to_subst ------------------------------------------------";
27.48 +"-------- fun subst'_to_subst ------------------------------------------------";
27.49 +"-------- fun subst'_to_subst ------------------------------------------------";
27.50 +val t = @{term "[(''bdv_1'', x::real), (''bdv_2'', y::real), (''bdv_3'', z::real)]"};
27.51 +case subst'_to_subst t of
27.52 + [(Free ("bdv_1", _), Free ("x", _)),
27.53 + (Free ("bdv_2", _), Free ("y", _)),
27.54 + (Free ("bdv_3", _), Free ("z", _))] => ()
27.55 +| _ => error "subst'_to_subst changed";
27.56 +
27.57 +"-------- fun subst2subs -----------------------------------------------------";
27.58 +"-------- fun subst2subs -----------------------------------------------------";
27.59 +"-------- fun subst2subs -----------------------------------------------------";
27.60 +val subst_rew =
27.61 + [(@{term "bdv_1 :: real"}, @{term "x :: real"}),
27.62 + (@{term "bdv_2 :: real"}, @{term "y :: real"}),
27.63 + (@{term "bdv_3 :: real"}, @{term "z :: real"})];
27.64 +if subst2subs subst_rew = ["(''bdv_1'', x)", "(''bdv_2'', y)", "(''bdv_3'', z)"]then ()
27.65 +else error "subst2subs changed";
28.1 --- a/test/Tools/isac/Specify/ctree-navi.sml Fri Oct 25 16:07:15 2019 +0200
28.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
28.3 @@ -1,301 +0,0 @@
28.4 -(* Title: tests for Interpret/mstools.sml
28.5 - Author: Walther Neuper 100930, Mathias Lehnfeld
28.6 - (c) copyright due to lincense terms.
28.7 -*)
28.8 -"-----------------------------------------------------------------------------------------------";
28.9 -"table of contents -----------------------------------------------------------------------------";
28.10 -"-----------------------------------------------------------------------------------------------";
28.11 -"----------- go through Model_Problem until nxt_tac --------------------------------------------";
28.12 -"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
28.13 -"----------- type penv -------------------------------------------------------------------------";
28.14 -"----------- fun untouched ---------------------------------------------------------------------";
28.15 -"----------- fun pbl_ids -----------------------------------------------------------------------";
28.16 -"----------- fun upd_penv ----------------------------------------------------------------------";
28.17 -"----------- fun upd ---------------------------------------------------------------------------";
28.18 -"----------- fun upds_envv ---------------------------------------------------------------------";
28.19 -"----------- fun common_subthy -----------------------------------------------------------------";
28.20 -"--------------------------------------------------------";
28.21 -"--------------------------------------------------------";
28.22 -"--------------------------------------------------------";
28.23 -"--------------------------------------------------------";
28.24 -
28.25 -
28.26 -"----------- go through Model_Problem until nxt_tac --------------------------------------------";
28.27 -"----------- go through Model_Problem until nxt_tac --------------------------------------------";
28.28 -"----------- go through Model_Problem until nxt_tac --------------------------------------------";
28.29 -(*FIXME.WN110511 delete this test? (goes through "Model_Problem until nxt_tac)*)
28.30 -val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
28.31 -val (dI',pI',mI') =
28.32 - ("Test", ["sqroot-test","univariate","equation","test"],
28.33 - ["Test","squ-equ-test-subpbl1"]);
28.34 -(*========== inhibit exn AK110725 ================================================
28.35 -(* ERROR: same as above, see lines 120- 123 *)
28.36 -val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
28.37 -========== inhibit exn AK110725 ================================================*)
28.38 -
28.39 -(*========== inhibit exn AK110725 ================================================
28.40 -(* ERROR: p, nxt, pt not declared due to above error *)
28.41 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.42 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.43 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.44 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.45 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.46 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.47 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.48 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.49 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
28.50 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Subproblem",*)
28.51 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Model_Problem",*)
28.52 -"~~~~~ fun me, args:"; val (_,tac) = nxt;
28.53 -val (pt, p) = case locatetac tac (pt,p) of
28.54 - ("ok", (_, _, ptp)) => ptp | _ => error "script.sml locatetac";
28.55 -"~~~~~ fun step, args:"; val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'), []))
28.56 -val pIopt = get_pblID (pt,ip);
28.57 -tacis; (*= []*)
28.58 -pIopt; (*= SOME ["sqroot-test", "univariate", ...]*)
28.59 -member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (*= true*)
28.60 -"~~~~~ fun nxt_specify_, args:"; val (ptp as (pt, pos as (p,p_))) = (pt, ip);
28.61 -val pblobj as (PblObj{meth,origin=origin as (oris,(dI',pI',mI'),_),
28.62 - probl,spec=(dI,pI,mI),...}) = get_obj I pt p;
28.63 -just_created_ pblobj (*by Subproblem*) andalso origin <> e_origin; (*false=oldNB*)
28.64 -val cpI = if pI = e_pblID then pI' else pI;
28.65 - val cmI = if mI = e_metID then mI' else mI;
28.66 - val {ppc, prls, where_, ...} = get_pbt cpI;
28.67 - val pre = check_preconds "thy 100820" prls where_ probl;
28.68 - val pb = foldl and_ (true, map fst pre);
28.69 -val (_,tac) = nxt_spec p_ pb oris (dI',pI',mI') (probl, meth)
28.70 - (ppc, (#ppc o get_met) cmI) (dI, pI, mI); (*tac = Add_Given "equality (-1 + x = 0)"*)
28.71 -"~~~~~ fun nxt_specif, args:"; val (Add_Given ct, ptp) = (tac, ptp);
28.72 -"~~~~~ fun nxt_specif_additem, args:"; val (sel, ct, ptp as (pt, (p, Pbl))) = ("#Given", ct, ptp);
28.73 -val (PblObj{meth=met,origin=(oris,(dI',pI',_),_),
28.74 - probl=pbl,spec=(dI,pI,_),...}) = get_obj I pt p;
28.75 -val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
28.76 -val cpI = if pI = e_pblID then pI' else pI;
28.77 -val ctxt = get_ctxt pt (p, Pbl);
28.78 -"~~~~~ fun appl_add, args:"; val (ctxt, sel, oris, ppc, pbt, str) = (ctxt, sel, oris, pbl, ((#ppc o get_pbt) cpI), ct);
28.79 -val SOME t = parseNEW ctxt str;
28.80 -is_known ctxt sel oris t;
28.81 -"~~~~~ fun is_known, args:"; val (ctxt, sel, ori, t) = (ctxt, sel, oris, t);
28.82 -val _ = tracing ("RM is_known: t=" ^ term2str t);
28.83 -val ots = (distinct o flat o (map #5)) (ori:ori list);
28.84 -val oids = ((map (fst o dest_Free)) o distinct o flat o (map vars)) ots;
28.85 -val (d, ts) = split_dts t;
28.86 -"~~~~~ fun split_dts, args:"; val (t as d $ arg) = t;
28.87 -(*if is_dsc d then () else error "TODO";*)
28.88 -if is_dsc d then () else error "TODO";
28.89 -"----- these were the errors (call hierarchy from bottom up)";
28.90 -appl_add ctxt sel oris pbl ((#ppc o get_pbt) cpI) ct;(*WAS
28.91 -Err "[error] appl_add: is_known: identifiers [equality] not in example"*)
28.92 -nxt_specif_additem "#Given" ct ptp;(*WAS
28.93 -Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
28.94 -nxt_specif tac ptp;(*WAS
28.95 -Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
28.96 -nxt_specify_ (pt,ip); (*WAS
28.97 -Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
28.98 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; WAS
28.99 -Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
28.100 -========== inhibit exn AK110725 ================================================*)
28.101 -
28.102 -"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
28.103 -"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
28.104 -"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
28.105 -(*val t = str2term "maximum A";
28.106 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.107 -val it = "maximum A" : cterm
28.108 -> val t = str2term "fixedValues [r=Arbfix]";
28.109 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.110 -"fixedValues [r = Arbfix]"
28.111 -> val t = str2term "valuesFor [a]";
28.112 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.113 -"valuesFor [a]"
28.114 -> val t = str2term "valuesFor [a,b]";
28.115 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.116 -"valuesFor [a, b]"
28.117 -> val t = str2term "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]";
28.118 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.119 -relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]"
28.120 -> val t = str2term "boundVariable a";
28.121 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.122 -"boundVariable a"
28.123 -> val t = str2term "interval {x::real. 0 <= x & x <= 2*r}";
28.124 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.125 -"interval {x. 0 <= x & x <= 2 * r}"
28.126 -
28.127 -> val t = str2term "equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))";
28.128 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.129 -"equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))"
28.130 -> val t = str2term "solveFor x";
28.131 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.132 -"solveFor x"
28.133 -> val t = str2term "errorBound (eps=0)";
28.134 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.135 -"errorBound (eps = 0)"
28.136 -> val t = str2term "solutions L";
28.137 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
28.138 -"solutions L"
28.139 -
28.140 -before 6.5.03:
28.141 -> val t = (Thm.term_of o the o (parse thy)) "testdscforlist [#1]";
28.142 -> val (d,ts) = split_dts t;
28.143 -> comp_dts thy (d,ts);
28.144 -val it = "testdscforlist [#1]" : cterm
28.145 -
28.146 -> val t = (Thm.term_of o the o (parse thy)) "(A::real)";
28.147 -> val (d,ts) = split_dts t;
28.148 -val d = Const ("empty","empty") : term
28.149 -val ts = [Free ("A","RealDef.real")] : term list
28.150 -> val t = (Thm.term_of o the o (parse thy)) "[R=(R::real)]";
28.151 -> val (d,ts) = split_dts t;
28.152 -val d = Const ("empty","empty") : term
28.153 -val ts = [Const # $ Free # $ Free (#,#)] : term list
28.154 -> val t = (Thm.term_of o the o (parse thy)) "[#1,#2]";
28.155 -> val (d,ts) = split_dts t;
28.156 -val ts = [Free ("#1","'a"),Free ("#2","'a")] : NOT WANTED
28.157 -*)
28.158 -"----------- type penv -------------------------------------------------------------------------";
28.159 -"----------- type penv -------------------------------------------------------------------------";
28.160 -"----------- type penv -------------------------------------------------------------------------";
28.161 -(*
28.162 - val e_ = (Thm.term_of o the o (parse thy)) "e_::bool";
28.163 - val ev = (Thm.term_of o the o (parse thy)) "#4 + #3 * x^^^#2 = #0";
28.164 - val v_ = (Thm.term_of o the o (parse thy)) "v_";
28.165 - val vv = (Thm.term_of o the o (parse thy)) "x";
28.166 - val r_ = (Thm.term_of o the o (parse thy)) "err_::bool";
28.167 - val rv1 = (Thm.term_of o the o (parse thy)) "#0";
28.168 - val rv2 = (Thm.term_of o the o (parse thy)) "eps";
28.169 -
28.170 - val penv = [(e_,[ev]),(v_,[vv]),(r_,[rv2,rv2])]:penv;
28.171 - map getval penv;
28.172 -[(Free ("e_","bool"),
28.173 - Const (#,#) $ (# $ # $ (# $ #)) $ Free ("#0","RealDef.real")),
28.174 - (Free ("v_","RealDef.real"),Free ("x","RealDef.real")),
28.175 - (Free ("err_","bool"),Free ("#0","RealDef.real"))] : (term * term) list
28.176 -*)
28.177 -"----------- fun untouched ---------------------------------------------------------------------";
28.178 -"----------- fun untouched ---------------------------------------------------------------------";
28.179 -"----------- fun untouched ---------------------------------------------------------------------";
28.180 -(*> untouched [];
28.181 -val it = true : bool
28.182 -> untouched [e_itm];
28.183 -val it = true : bool
28.184 -> untouched [e_itm, (1,[],false,"e_itm",Syn "e_itm")];
28.185 -val it = false : bool*)
28.186 -"----------- fun pbl_ids -----------------------------------------------------------------------";
28.187 -"----------- fun pbl_ids -----------------------------------------------------------------------";
28.188 -"----------- fun pbl_ids -----------------------------------------------------------------------";
28.189 -(*
28.190 -val t as t1 $ t2 = str2term "antiDerivativeName M_b";
28.191 -pbl_ids ctxt t1 t2;
28.192 -
28.193 - val t = (Thm.term_of o the o (parse thy)) "fixedValues [r=Arbfix]";
28.194 - val (d,argl) = strip_comb t;
28.195 - is_dsc d; (*see split_dts*)
28.196 - dest_list (d,argl);
28.197 - val (_ $ v) = t;
28.198 - is_list v;
28.199 - pbl_ids ctxt d v;
28.200 -[Const ("List.list.Cons","[bool, bool List.list] => bool List.list") $
28.201 - (Const # $ Free # $ Const (#,#)) $ Const ("List.list.Nil","bool List..
28.202 -
28.203 - val (dsc,vl) = (split_dts o Thm.term_of o the o (parse thy)) "solveFor x";
28.204 -val dsc = Const ("Input_Descript.solveFor","RealDef.real => Tools.una") : term
28.205 -val vl = Free ("x","RealDef.real") : term
28.206 -
28.207 - val (dsc,id) = (split_did o Thm.term_of o the o (parse thy)) "solveFor v_";
28.208 - pbl_ids ctxt dsc vl;
28.209 -val it = [Free ("x","RealDef.real")] : term list
28.210 -
28.211 - val (dsc,vl) = (split_dts o Thm.term_of o the o(parse thy))
28.212 - "errorBound (eps=#0)";
28.213 - val (dsc,id) = (split_did o Thm.term_of o the o(parse thy)) "errorBound err_";
28.214 - pbl_ids ctxt dsc vl;
28.215 -val it = [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")] : term list *)
28.216 -"----------- fun upd_penv ----------------------------------------------------------------------";
28.217 -"----------- fun upd_penv ----------------------------------------------------------------------";
28.218 -"----------- fun upd_penv ----------------------------------------------------------------------";
28.219 -(*
28.220 - val penv = [];
28.221 - val (dsc,vl) = (split_did o Thm.term_of o the o (parse thy)) "solveFor x";
28.222 - val (dsc,id) = (split_did o Thm.term_of o the o (parse thy)) "solveFor v_";
28.223 - val penv = upd_penv thy penv dsc (id, vl);
28.224 -[(Free ("v_","RealDef.real"),
28.225 - [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")])]
28.226 -: (term * term list) list
28.227 -
28.228 - val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"errorBound (eps=#0)";
28.229 - val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"errorBound err_";
28.230 - upd_penv thy penv dsc (id, vl);
28.231 -[(Free ("v_","RealDef.real"),
28.232 - [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")]),
28.233 - (Free ("err_","bool"),
28.234 - [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")])]
28.235 -: (term * term list) list ^.........!!!!
28.236 -*)
28.237 -"----------- fun upd ---------------------------------------------------------------------------";
28.238 -"----------- fun upd ---------------------------------------------------------------------------";
28.239 -"----------- fun upd ---------------------------------------------------------------------------";
28.240 -(*
28.241 - val i = 2;
28.242 - val envv = [(1,[]:penv),(2,[]:penv),(3,[]:penv)]:envv;
28.243 - val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"boundVariable b";
28.244 - val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"boundVariable v_";
28.245 - upd thy envv dsc (id, vl) i;
28.246 -val it = (2,[(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")])])
28.247 - : int * (term * term list) list*)
28.248 -"----------- fun upds_envv ---------------------------------------------------------------------";
28.249 -"----------- fun upds_envv ---------------------------------------------------------------------";
28.250 -"----------- fun upds_envv ---------------------------------------------------------------------";
28.251 -(* eval test-maximum.sml until Specify_Method ...
28.252 - val PblObj{probl=(_,pbl),origin=(_,(_,_,mI),_),...} = get_obj I pt [];
28.253 - val met = (#ppc o get_met) mI;
28.254 -
28.255 - val envv = [];
28.256 - val eargs = flat eargs;
28.257 - val (vs, dsc, id, vl) = hd eargs;
28.258 - val envv = upds_envv thy envv [(vs, dsc, id, vl)];
28.259 -
28.260 - val (vs, dsc, id, vl) = hd (tl eargs);
28.261 - val envv = upds_envv thy envv [(vs, dsc, id, vl)];
28.262 -
28.263 - val (vs, dsc, id, vl) = hd (tl (tl eargs));
28.264 - val envv = upds_envv thy envv [(vs, dsc, id, vl)];
28.265 -
28.266 - val (vs, dsc, id, vl) = hd (tl (tl (tl eargs)));
28.267 - val envv = upds_envv thy envv [(vs, dsc, id, vl)];
28.268 -[(1,
28.269 - [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
28.270 - (Free ("m_","bool"),[Free (#,#)]),
28.271 - (Free ("vs_","bool List.list"),[# $ # $ Const #]),
28.272 - (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
28.273 - (2,
28.274 - [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
28.275 - (Free ("m_","bool"),[Free (#,#)]),
28.276 - (Free ("vs_","bool List.list"),[# $ # $ Const #]),
28.277 - (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
28.278 - (3,
28.279 - [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
28.280 - (Free ("m_","bool"),[Free (#,#)]),
28.281 - (Free ("vs_","bool List.list"),[# $ # $ Const #])])] : envv *)
28.282 -
28.283 -"----------- fun common_subthy -----------------------------------------------------------------";
28.284 -"----------- fun common_subthy -----------------------------------------------------------------";
28.285 -"----------- fun common_subthy -----------------------------------------------------------------";
28.286 -val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory Inverse_Z_Transform});
28.287 -if Context.theory_name (common_subthy (thy1, thy2)) = "Inverse_Z_Transform"
28.288 -then () else error "common_subthy 1";
28.289 -
28.290 -val (thy1, thy2) = (@{theory Inverse_Z_Transform}, @{theory Partial_Fractions});(* Isac.Inverse_Z_Transform *)
28.291 -if Context.theory_name (common_subthy (thy1, thy2)) = "Inverse_Z_Transform"
28.292 -then () else error "common_subthy 2";
28.293 -
28.294 -val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory PolyEq});
28.295 -if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 3";
28.296 -
28.297 -val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory Isac_Knowledge});
28.298 -if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 4";
28.299 -
28.300 -val (thy1, thy2) = (@{theory PolyEq}, @{theory Partial_Fractions});
28.301 -if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 5";
28.302 -
28.303 -val (thy1, thy2) = (@{theory Isac_Knowledge}, @{theory Partial_Fractions});
28.304 -if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 6";
29.1 --- a/test/Tools/isac/Specify/ctree.sml Fri Oct 25 16:07:15 2019 +0200
29.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
29.3 @@ -1,1370 +0,0 @@
29.4 -(* tests for sml/ME/ctree.sml
29.5 - authors: Walther Neuper 060113
29.6 - (c) due to copyright terms
29.7 -
29.8 -use"../smltest/ME/ctree.sml";
29.9 -use"ctree.sml";
29.10 -*)
29.11 -
29.12 -"-----------------------------------------------------------------";
29.13 -"table of contents -----------------------------------------------";
29.14 -"-----------------------------------------------------------------";
29.15 -"-----------------------------------------------------------------";
29.16 -"-------------- fun get_ctxt -------------------------------------";
29.17 -"-------------- fun update_ctxt, fun g_ctxt ----------------------";
29.18 -"-------------- check positions in miniscript --------------------";
29.19 -"-------------- get_allpos' (from ctree above)--------------------";
29.20 -"-------------- cut_level (from ctree above)----------------------";
29.21 -"-------------- cut_tree (from ctree above)-----------------------";
29.22 -"=====new ctree 1a miniscript with mini-subpbl ===================";
29.23 -"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
29.24 -"=====new ctree 2 miniscript with mini-subpbl ====================";
29.25 -"-------------- cut_tree (intermedi.ctree: 3rd level)-------------";
29.26 -"-------------- cappend (from ctree above)------------------------";
29.27 -"-------------- cappend minisubpbl -------------------------------";
29.28 -"=====new ctree 3 ================================================";
29.29 -"-------------- move_dn ------------------------------------------";
29.30 -"-------------- move_dn: Frm -> Res ------------------------------";
29.31 -"-------------- move_up ------------------------------------------";
29.32 -"------ move into detail -----------------------------------------";
29.33 -"=====new ctree 3a ===============================================";
29.34 -"-------------- move_dn in Incomplete ctree ----------------------";
29.35 -"=====new ctree 4: crooked by cut_level_'_ =======================";
29.36 -(*############## development stopped 0501 ########################*)
29.37 -(******************************************************************)
29.38 -(* val SAVE_get_trace = get_trace; *)
29.39 -(******************************************************************)
29.40 -"-------------- get_interval from ctree: incremental development--";
29.41 -(******************************************************************)
29.42 -(* val get_trace = SAVE_get_trace; *)
29.43 -(******************************************************************)
29.44 -(*############## development stopped 0501 ########################*)
29.45 -"=====new ctree 4 ratequation ====================================";
29.46 -"-------------- pt_extract form, tac, asm<>[] --------------------";
29.47 -"=====new ctree 5 minisubpbl =====================================";
29.48 -"-------------- pt_extract form, tac, asm ------------------------";
29.49 -"=====new ctree 6 minisubpbl intersteps ==========================";
29.50 -"-------------- get_allpos' new ----------------------------------";
29.51 -"-------------- cut_tree new (from ctree above)-------------------";
29.52 -"-------------- repl_app------------------------------------------";
29.53 -"-----------------------------------------------------------------";
29.54 -"-----------------------------------------------------------------";
29.55 -"-----------------------------------------------------------------";
29.56 -
29.57 -
29.58 -"-------------- fun get_ctxt -------------------------------------";
29.59 -"-------------- fun get_ctxt -------------------------------------";
29.60 -"-------------- fun get_ctxt -------------------------------------";
29.61 -val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
29.62 -val (dI',pI',mI') =
29.63 - ("Test", ["sqroot-test","univariate","equation","test"],
29.64 - ["Test","squ-equ-test-subpbl1"]);
29.65 -val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
29.66 -(get_ctxt pt p)
29.67 - handle _ => error "--- fun get_ctxt not even some ctxt found in PblObj";
29.68 -val (p,_,f,nxt,_,pt) = me nxt p [] pt;
29.69 -(get_ctxt pt p)
29.70 - handle _ => error "--- fun get_ctxt not even some ctxt found in PrfObj";
29.71 -
29.72 -"-------------- fun update_ctxt, fun g_ctxt ----------------------";
29.73 -"-------------- fun update_ctxt, fun g_ctxt ----------------------";
29.74 -"-------------- fun update_ctxt, fun g_ctxt ----------------------";
29.75 -val pt = EmptyPtree;
29.76 -val pt = append_problem [] (e_istate, e_ctxt) e_fmz ([(*oris*)], e_spec, e_term) pt;
29.77 -val ctxt = get_obj g_ctxt pt [];
29.78 -if is_e_ctxt ctxt then () else error "--- fun update_ctxt, fun g_ctxt: append_problem changed";
29.79 -val pt = update_ctxt pt [] (Proof_Context.init_global @{theory "Isac_Knowledge"});
29.80 -if (get_obj g_ctxt pt [] |> Proof_Context.theory_of |> Context.theory_name) = "Isac_Knowledge"
29.81 -then () else error "--- fun update_ctxt, fun g_ctxt changed";
29.82 -
29.83 -"-------------- check positions in miniscript --------------------";
29.84 -"-------------- check positions in miniscript --------------------";
29.85 -"-------------- check positions in miniscript --------------------";
29.86 -val fmz = ["equality (x+1=(2::real))",
29.87 - "solveFor x","solutions L"];
29.88 -val (dI',pI',mI') =
29.89 - ("Test",["sqroot-test","univariate","equation","test"],
29.90 - ["Test","squ-equ-test-subpbl1"]);
29.91 -val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
29.92 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.93 -(* nxt = Add_Given "equality (x + 1 = 2)"
29.94 - (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
29.95 - *)
29.96 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.97 -(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
29.98 - *)
29.99 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.100 -(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
29.101 - *)
29.102 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.103 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.104 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.105 -"ctree.sml-------------- get_allpos' new ------------------------\"";
29.106 -val (PP, pp) = split_last [1];
29.107 -val ((pt', cuts), clevup) = cut_bottom (PP, pp) (get_nd pt PP);
29.108 -
29.109 -val cuts = get_allp [] ([], ([],Frm)) pt;
29.110 -val cuts2 = get_allps [] [1] (children pt);
29.111 -"ctree.sml-------------- cut_tree new (from ctree above)----------";
29.112 -val (pt', cuts) = cut_tree pt ([1],Frm);
29.113 -"ctree.sml-------------- cappend on complete ctree from above ----";
29.114 -val (pt', cuts) = cappend_form pt [1] (e_istate, e_ctxt) (str2term "Inform[1]");
29.115 -"----------------------------------------------------------------/";
29.116 -
29.117 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_form: pos =[1]*);
29.118 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[1]*);
29.119 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[2]*);
29.120 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_problem: pos =[3]*);
29.121 -
29.122 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.123 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.124 -(*val nxt = ("Add_Given", Add_Given "equality (-1 + x = 0)").....*)
29.125 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.126 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.127 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.128 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.129 -(*val nxt = ("Apply_Method", Apply_Method ["Test", "solve_linear"])*)
29.130 -
29.131 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_form: pos =[3,1]*);
29.132 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[3,1]*);
29.133 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[3,2]*);
29.134 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*.append_result: pos =[3]*);
29.135 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*cappend_atomic: pos =[4]*);
29.136 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt(*.append_result: pos =[]*);
29.137 -val FormKF res = f;
29.138 -if res = "[x = 1]"
29.139 -then case nxt of ("End_Proof'", End_Proof') => ()
29.140 - | _ => error "new behaviour in test: miniscript with mini-subpbl 1"
29.141 -else error "new behaviour in test: miniscript with mini-subpbl 2"
29.142 -
29.143 - show_pt pt;
29.144 -
29.145 -"-------------- get_allpos' (from ctree above)--------------------";
29.146 -"-------------- get_allpos' (from ctree above)--------------------";
29.147 -"-------------- get_allpos' (from ctree above)--------------------";
29.148 -if get_allpos' ([], 1) pt =
29.149 - [([], Frm),
29.150 - ([1], Frm),
29.151 - ([1], Res),
29.152 - ([2], Res),
29.153 - ([3], Frm),
29.154 - ([3, 1], Frm),
29.155 - ([3, 1], Res),
29.156 - ([3, 2], Res),
29.157 - ([3], Res),
29.158 - ([4], Res),
29.159 - ([], Res)]
29.160 -then () else error "ctree.sml: diff:behav. in get_allpos' 1";
29.161 -
29.162 -if get_allpos's ([], 1) (children pt) =
29.163 - [([1], Frm),
29.164 - ([1], Res),
29.165 - ([2], Res),
29.166 - ([3], Frm),
29.167 - ([3, 1], Frm),
29.168 - ([3, 1], Res),
29.169 - ([3, 2], Res),
29.170 - ([3], Res),
29.171 - ([4], Res)]
29.172 -then () else error "ctree.sml: diff:behav. in get_allpos' 2";
29.173 -
29.174 -if get_allpos's ([], 2) (takerest (1, children pt)) =
29.175 - [([2], Res),
29.176 - ([3], Frm),
29.177 - ([3, 1], Frm),
29.178 - ([3, 1], Res),
29.179 - ([3, 2], Res),
29.180 - ([3], Res),
29.181 - ([4], Res)]
29.182 -then () else error "ctree.sml: diff:behav. in get_allpos' 3";
29.183 -
29.184 -if get_allpos's ([], 3) (takerest (2, children pt)) =
29.185 - [([3], Frm),
29.186 - ([3, 1], Frm),
29.187 - ([3, 1], Res),
29.188 - ([3, 2], Res),
29.189 - ([3], Res),
29.190 - ([4], Res)]
29.191 -then () else error "ctree.sml: diff:behav. in get_allpos' 4";
29.192 -
29.193 -if get_allpos's ([3], 1) (children (nth 3 (children pt))) =
29.194 - [([3, 1], Frm),
29.195 - ([3, 1], Res),
29.196 - ([3, 2], Res)]
29.197 -then () else error "ctree.sml: diff:behav. in get_allpos' 5";
29.198 -
29.199 -if get_allpos' ([3], 1) (nth 3 (children pt)) =
29.200 - [([3], Frm),
29.201 - ([3, 1], Frm),
29.202 - ([3, 1], Res),
29.203 - ([3, 2], Res),
29.204 - ([3], Res)]
29.205 -then () else error "ctree.sml: diff:behav. in get_allpos' 6";
29.206 -
29.207 -
29.208 -
29.209 -
29.210 -
29.211 -
29.212 -"-------------- cut_level (from ctree above)----------------------";
29.213 -"-------------- cut_level (from ctree above)----------------------";
29.214 -"-------------- cut_level (from ctree above)----------------------";
29.215 -show_pt pt;
29.216 -show_pt pt';
29.217 -(*default_print_depth 99*) cuts; (*default_print_depth 3*)
29.218 -
29.219 -(*if cuts = [([2], Res),
29.220 - ([3], Frm),
29.221 - ([3, 1], Frm),
29.222 - ([3, 1], Res),
29.223 - ([3, 2], Res),
29.224 - ([3], Res),
29.225 - ([4], Res)]
29.226 -then () else error "ctree.sml: diff:behav. in cut_level 1a";
29.227 -val (res,asm) = get_obj g_result pt' [2];
29.228 -if res = e_term andalso asm = [] then () else
29.229 -error "ctree.sml: diff:behav. in cut_level 1aa" WN050219*);
29.230 -if not (existpt [2] pt') then () else
29.231 -error "ctree.sml: diff:behav. in cut_level 1aa2" (*WN050220*);
29.232 -
29.233 -val (res,asm) = get_obj g_result pt' [];
29.234 -
29.235 -(*============ inhibit exn AK110726 ==============================================
29.236 -if term2str res = "[x = 1]" (*WN050219 e_term in cut_tree!!!*) then () else
29.237 -error "ctree.sml: diff:behav. in cut_level 1ab";
29.238 -============ inhibit exn AK110726 ==============================================*)
29.239 -(*============ inhibit exn AK110726 ==============================================
29.240 -if map fst3 (get_interval ([],Frm) ([],Res) 9999 pt') =
29.241 - [([], Frm),
29.242 - ([1], Frm),
29.243 - ([1], Res),
29.244 - ([2], Res),(*, e_term in cut_tree!!!*)
29.245 - ([], Res)] then () else
29.246 -error "ctree.sml: diff:behav. in cut_level 1b";
29.247 -============ inhibit exn AK110726 ==============================================*)
29.248 -
29.249 -val (pt',cuts) = cut_level [] [] pt ([2],Res);
29.250 -if cuts = [([3], Frm),
29.251 - ([3, 1], Frm),
29.252 - ([3, 1], Res),
29.253 - ([3, 2], Res),
29.254 - ([3], Res),
29.255 - ([4], Res)]
29.256 -then () else error "ctree.sml: diff:behav. in cut_level 2a";
29.257 -
29.258 -if pr_ctree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n"
29.259 -then () else error "ctree.sml: diff:behav. in cut_level 2b";
29.260 -
29.261 -val (pt',cuts) = cut_level [] [3] pt ([3,1],Frm);
29.262 -if cuts = [([3, 1], Res), ([3, 2], Res)]
29.263 -then () else error "ctree.sml: diff:behav. in cut_level 3a";
29.264 -if pr_ctree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n3. ----- pblobj -----\n3.1. -1 + x = 0\n4. [x = 1]\n"
29.265 -then () else error "ctree.sml: diff:behav. in cut_level 3b";
29.266 -
29.267 -val (pt',cuts) = cut_level [] [3] pt ([3,1],Res);
29.268 -if cuts = [([3, 2], Res)]
29.269 -then () else error "ctree.sml: diff:behav. in cut_level 4a";
29.270 -if pr_ctree pr_short pt' = ". ----- pblobj -----\n1. x + 1 = 2\n2. x + 1 + -1 * 2 = 0\n3. ----- pblobj -----\n3.1. -1 + x = 0\n4. [x = 1]\n"
29.271 -then () else error "ctree.sml: diff:behav. in cut_level 4b";
29.272 -
29.273 -
29.274 -"-------------- cut_tree (from ctree above)-----------------------";
29.275 -"-------------- cut_tree (from ctree above)-----------------------";
29.276 -"-------------- cut_tree (from ctree above)-----------------------";
29.277 -val (pt', cuts) = cut_tree pt ([2],Frm);(*not created by move_dn -- not on WS*)
29.278 -
29.279 -(*============ inhibit exn AK110726 ==============================================
29.280 -if cuts = [([2], Res),
29.281 - ([3], Frm),
29.282 - ([3, 1], Frm),
29.283 - ([3, 1], Res),
29.284 - ([3, 2], Res),
29.285 - ([3], Res),
29.286 - ([4], Res),
29.287 - ([], Res)]
29.288 -then () else error "ctree.sml: diff:behav. in cut_tree 1a";
29.289 -
29.290 -val (res,asm) = get_obj g_result pt' [2];
29.291 -============ inhibit exn AK110726 ==============================================*)
29.292 -
29.293 -if res = e_term (*WN050219 done by cut_level*) then () else
29.294 -error "ctree.sml: diff:behav. in cut_tree 1aa";
29.295 -
29.296 -(*============ inhibit exn AK110726 ==============================================
29.297 -val form = get_obj g_form pt' [2];
29.298 -if term2str form = "x + 1 + -1 * 2 = 0" (*remained !!!*) then () else
29.299 -error "ctree.sml: diff:behav. in cut_tree 1ab";
29.300 -============ inhibit exn AK110726 ==============================================*)
29.301 -(* AK110727 Debuging
29.302 - (* get_obj g_form pt' [2];
29.303 - (* ERROR: exception PTREE "get_obj: pos = [2] does not exist"
29.304 - raised (line 908 /src/Tools/isac/Interpret/ctree.sml")*)*)
29.305 -"~~~~~ fun get_obj, args:"; val (f, (Nd (b, bs)) ,(p::ps)) = (g_form, pt', [2]);*)
29.306 -
29.307 -val (res,asm) = get_obj g_result pt' [];
29.308 -if res = e_term (*WN050219 done by cut_tree*) then () else
29.309 -error "ctree.sml: diff:behav. in cut_tree 1ac";
29.310 -
29.311 -if map fst3 (get_interval ([],Frm) ([],Res) 9999 pt') =
29.312 - [([], Frm),
29.313 - ([1], Frm),
29.314 - ([1], Res)] then () else
29.315 -error "ctree.sml: diff:behav. in cut_tree 1ad";
29.316 -
29.317 -val (pt', cuts) = cut_tree pt ([2],Res);
29.318 -(*============ inhibit exn AK110726 ==============================================
29.319 -if cuts = [([3], Frm),
29.320 - ([3, 1], Frm),
29.321 - ([3, 1], Res),
29.322 - ([3, 2], Res),
29.323 - ([3], Res),
29.324 - ([4], Res),
29.325 - ([], Res)]
29.326 -then () else error "ctree.sml: diff:behav. in cut_tree 2";
29.327 -============ inhibit exn AK110726 ==============================================*)
29.328 -
29.329 -val (pt', cuts) = cut_tree pt ([3,1],Frm);
29.330 -(*============ inhibit exn AK110726 ==============================================
29.331 -if cuts = [([3, 1], Res),
29.332 - ([3, 2], Res),
29.333 - ([3], Res),
29.334 - ([4], Res),
29.335 - ([], Res)]
29.336 -then () else error "ctree.sml: diff:behav. in cut_tree 3";
29.337 -============ inhibit exn AK110726 ==============================================*)
29.338 -
29.339 -val (pt', cuts) = cut_tree pt ([3,1],Res);
29.340 -if cuts = [([3, 2], Res),
29.341 - ([3], Res),
29.342 - ([4], Res),
29.343 - ([], Res)]
29.344 -then () else error "ctree.sml: diff:behav. in cut_tree 4";
29.345 -
29.346 -"=====new ctree 1a miniscript with mini-subpbl ===================";
29.347 -"=====new ctree 1a miniscript with mini-subpbl ===================";
29.348 -"=====new ctree 1a miniscript with mini-subpbl ===================";
29.349 -val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
29.350 -val (dI',pI',mI') =
29.351 - ("Test",["sqroot-test","univariate","equation","test"],
29.352 - ["Test","squ-equ-test-subpbl1"]);
29.353 -val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
29.354 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.355 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.356 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.357 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.358 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.359 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.360 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.361 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.362 -show_pt pt;
29.363 -
29.364 -"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
29.365 -"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
29.366 -"-------------- cut_level ( ,Frm) on Incomplete Nd ---------------";
29.367 -
29.368 -val (pt',cuts) = cut_level [] [3] pt ([1],Frm);(*([1],Frm) is stored*)
29.369 -if cuts = [](*([1],Res) is not yet stored (Nd.ostate=Incomplete)*)
29.370 -then () else error "ctree.sml: diff:behav. in cut_tree 4a";
29.371 -
29.372 -val (pt', cuts) = cut_tree pt ([1],Frm);
29.373 -if cuts = []
29.374 -then () else error "ctree.sml: diff:behav. in cut_tree 4a";
29.375 -
29.376 -(*WN050219
29.377 -val pos as ([p],_) = ([1],Frm);
29.378 -val pt as Nd (b,_) = pt;
29.379 -
29.380 -
29.381 -show_pt pt;
29.382 -show_pt pt';
29.383 -(*default_print_depth 99;*)cuts;(*default_print_depth 3;*)
29.384 -(*default_print_depth 99;*)map fst3 (get_interval ([],Frm) ([],Res) 9999 pt');(*default_print_depth 3;*)
29.385 -####################################################################*)
29.386 -
29.387 -
29.388 -
29.389 -"=====new ctree 2 miniscript with mini-subpbl ====================";
29.390 -"=====new ctree 2 miniscript with mini-subpbl ====================";
29.391 -"=====new ctree 2 miniscript with mini-subpbl ====================";
29.392 -reset_states ();
29.393 - CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
29.394 - ("Test", ["sqroot-test","univariate","equation","test"],
29.395 - ["Test","squ-equ-test-subpbl1"]))];
29.396 - Iterator 1; moveActiveRoot 1;
29.397 - autoCalculate 1 CompleteCalc;
29.398 -
29.399 - interSteps 1 ([3,2],Res);
29.400 -
29.401 - val ((pt,_),_) = get_calc 1;
29.402 - show_pt pt;
29.403 -
29.404 -if (term2str o fst) (get_obj g_result pt [3,2,1]) = "x = 0 + 1" then ()
29.405 -else error "mini-subpbl interSteps broken";
29.406 -
29.407 -"-------------- cut_tree (intermedi.ctree: 3rd level)-------------";
29.408 -"-------------- cut_tree (intermedi.ctree: 3rd level)-------------";
29.409 -"-------------- cut_tree (intermedi.ctree: 3rd level)-------------";
29.410 -(*WN050225 intermed. outcommented
29.411 - val (pt', cuts) = cut_tree pt ([3,2,1],Frm);
29.412 - if cuts = [([3, 2, 1], Res),
29.413 - ([3, 2, 2], Res),
29.414 - ([3, 2], Res),
29.415 - ([3], Res),
29.416 - ([4], Res)]
29.417 - then () else error "ctree.sml: diff:behav. in cut_tree 3rd level 1";
29.418 -
29.419 - val (pt', cuts) = cut_tree pt ([3,2,1],Res);
29.420 - if cuts = [([3, 2, 2], Res),
29.421 - ([3, 2], Res),
29.422 - ([3], Res),
29.423 - ([4], Res)]
29.424 - then () else error "ctree.sml: diff:behav. in cut_tree 3rd level 2";
29.425 -
29.426 -
29.427 -"-------------- cappend (from ctree above)------------------------";
29.428 -"-------------- cappend (from ctree above)------------------------";
29.429 -"-------------- cappend (from ctree above)------------------------";
29.430 -val (pt',cuts) = cappend_form pt [3,2,1] e_istate (str2term "newnew");
29.431 -if cuts = [([3, 2, 1], Res),
29.432 - ([3, 2, 2], Res),
29.433 - ([3, 2], Res),
29.434 - ([3], Res),
29.435 - ([4], Res),
29.436 - ([], Res)]
29.437 -then () else error "ctree.sml: diff:behav. in cappend_form";
29.438 -if term2str (get_obj g_form pt' [3,2,1]) = "newnew" andalso
29.439 - get_obj g_tac pt' [3,2,1] = Empty_Tac andalso
29.440 - term2str (fst (get_obj g_result pt' [3,2,1])) = "??.empty"
29.441 - then () else error "ctree.sml: diff:behav. in cappend 1";
29.442 -
29.443 -val (pt',cuts) = cappend_atomic pt [3,2,1] e_istate (str2term "newform")
29.444 - (Tac "test") (str2term "newresult",[]) Complete;
29.445 -if cuts = [([3, 2, 1], Res), (*?????????????*)
29.446 - ([3, 2, 2], Res),
29.447 - ([3, 2], Res),
29.448 - ([3], Res),
29.449 - ([4], Res),
29.450 - ([], Res)]
29.451 -then () else error "ctree.sml: diff:behav. in cappend_atomic";
29.452 -
29.453 -
29.454 -
29.455 -"-------------- cappend minisubpbl -------------------------------";
29.456 -"-------------- cappend minisubpbl -------------------------------";
29.457 -"-------------- cappend minisubpbl -------------------------------";
29.458 -"=====new ctree 1 miniscript with mini-subpbl ====================";
29.459 -val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
29.460 -val (dI',pI',mI') =
29.461 - ("Test",["sqroot-test","univariate","equation","test"],
29.462 - ["Test","squ-equ-test-subpbl1"]);
29.463 -val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
29.464 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.465 -(* nxt = Add_Given "equality (x + 1 = 2)"
29.466 - (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
29.467 - *)
29.468 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.469 -(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
29.470 - *)
29.471 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.472 -(* (writeln o (itms2str_ ctxt)) (get_obj g_pbl pt (fst p));
29.473 - *)
29.474 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.475 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.476 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
29.477 -(*###cappend_form: pos =[1] ... while calculating nxt, which pt is dropped
29.478 -val nxt = ("Apply_Method", Apply_Method ["Test", "squ-equ-test-subpbl1"])*)
29.479 -
29.480 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[1]*);
29.481 -val p = ([1], Frm);
29.482 -val (pt,cuts) = cappend_form pt (fst p) e_istate (str2term "x + 1 = 2");
29.483 -val form = get_obj g_form pt (fst p);
29.484 -val (res,_) = get_obj g_result pt (fst p);
29.485 -if term2str form = "x + 1 = 2" andalso res = e_term then () else
29.486 -error "ctree.sml, diff.behav. cappend minisubpbl ([1],Frm)";
29.487 -if not (existpt ((lev_on o fst) p) pt) then () else
29.488 -error "ctree.sml, diff.behav. cappend minisubpbl ([1],Frm) nxt";
29.489 -
29.490 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[1]*);
29.491 -val p = ([1], Res);
29.492 -val (pt,cuts) =
29.493 - cappend_atomic pt (fst p) e_istate (str2term "x + 1 = 2")
29.494 - Empty_Tac (str2term "x + 1 + -1 * 2 = 0",[]) Incomplete;
29.495 -val form = get_obj g_form pt (fst p);
29.496 -val (res,_) = get_obj g_result pt (fst p);
29.497 -if term2str form = "x + 1 = 2" andalso term2str res = "x + 1 + -1 * 2 = 0"
29.498 -then () else error "ctree.sml, diff.behav. cappend minisubpbl ([1],Res)";
29.499 -if not (existpt ((lev_on o fst) p) pt) then () else
29.500 -error "ctree.sml, diff.behav. cappend minisubpbl ([1],Res) nxt";
29.501 -
29.502 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[2]*);
29.503 -val p = ([2], Res);
29.504 -val (pt,cuts) =
29.505 - cappend_atomic pt (fst p) e_istate (str2term "x + 1 + -1 * 2 = 0")
29.506 - Empty_Tac (str2term "-1 + x = 0",[]) Incomplete;
29.507 -val form = get_obj g_form pt (fst p);
29.508 -val (res,_) = get_obj g_result pt (fst p);
29.509 -if term2str form = "x + 1 + -1 * 2 = 0" andalso term2str res = "-1 + x = 0"
29.510 -then () else error "ctree.sml, diff.behav. cappend minisubpbl ([2],Res)";
29.511 -if not (existpt ((lev_on o fst) p) pt) then () else
29.512 -error "ctree.sml, diff.behav. cappend minisubpbl ([2],Res) nxt";
29.513 -
29.514 -
29.515 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(**)cappend_problem: pos =[3]*)
29.516 -val p = ([3], Pbl);
29.517 -val (pt,cuts) = cappend_problem pt (fst p) e_istate e_fmz ([],e_spec,e_term);
29.518 -if is_pblobj (get_obj I pt (fst p)) then () else
29.519 -error "ctree.sml, diff.behav. cappend minisubpbl ([3],Pbl)";
29.520 -if not (existpt ((lev_on o fst) p) pt) then () else
29.521 -error "ctree.sml, diff.behav. cappend minisubpbl ([3],Pbl) nxt";
29.522 -
29.523 -(* ...complete calchead skipped...*)
29.524 -
29.525 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[3,1]*);
29.526 -val p = ([3, 1], Frm);
29.527 -val (pt,cuts) = cappend_form pt (fst p) e_istate (str2term "-1 + x = 0");
29.528 -val form = get_obj g_form pt (fst p);
29.529 -val (res,_) = get_obj g_result pt (fst p);
29.530 -if term2str form = "-1 + x = 0" andalso res = e_term then () else
29.531 -error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Frm)";
29.532 -if not (existpt ((lev_on o fst) p) pt) then () else
29.533 -error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Frm) nxt";
29.534 -
29.535 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt;(**)cappend_atomic: pos =[3,1]*)
29.536 -val p = ([3, 1], Res);
29.537 -val (pt,cuts) =
29.538 - cappend_atomic pt (fst p) e_istate (str2term "-1 + x = 0")
29.539 - Empty_Tac (str2term "x = 0 + -1 * -1",[]) Incomplete;
29.540 -val form = get_obj g_form pt (fst p);
29.541 -val (res,_) = get_obj g_result pt (fst p);
29.542 -if term2str form = "-1 + x = 0" andalso term2str res = "x = 0 + -1 * -1" then()
29.543 -else error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Res)";
29.544 -if not (existpt ((lev_on o fst) p) pt) then () else
29.545 -error "ctree.sml, diff.behav. cappend minisubpbl ([3,1],Res) nxt";
29.546 -
29.547 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_form: pos =[3,1]*);
29.548 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[3,1]*);
29.549 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[3,2]*);
29.550 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**).append_result: pos =[3]*);
29.551 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**)cappend_atomic: pos =[4]*);
29.552 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt(**).append_result: pos =[]*);
29.553 -
29.554 -WN050225 intermed. outcommented---*)
29.555 -
29.556 -"=====new ctree 3 ================================================";
29.557 -"=====new ctree 3 ================================================";
29.558 -"=====new ctree 3 ================================================";
29.559 -
29.560 -reset_states ();
29.561 - CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
29.562 - ("Test", ["sqroot-test","univariate","equation","test"],
29.563 - ["Test","squ-equ-test-subpbl1"]))];
29.564 - Iterator 1; moveActiveRoot 1;
29.565 - autoCalculate 1 CompleteCalc;
29.566 -
29.567 - val ((pt,_),_) = get_calc 1;
29.568 - show_pt pt;
29.569 -
29.570 -"-------------- move_dn ------------------------------------------";
29.571 -"-------------- move_dn ------------------------------------------";
29.572 -"-------------- move_dn ------------------------------------------";
29.573 - val p = move_dn [] pt ([],Pbl) (*-> ([1],Frm)*);
29.574 - val p = move_dn [] pt p (*-> ([1],Res)*);
29.575 - val p = move_dn [] pt p (*-> ([2],Res)*);
29.576 - val p = move_dn [] pt p (*-> ([3],Pbl)*);
29.577 - val p = move_dn [] pt p (*-> ([3,1],Frm)*);
29.578 - val p = move_dn [] pt p (*-> ([3,1],Res)*);
29.579 - val p = move_dn [] pt p (*-> ([3,2],Res)*);
29.580 - val p = move_dn [] pt p (*-> ([3],Res)*);
29.581 -(* term2str (get_obj g_res pt [3]);
29.582 - term2str (get_obj g_form pt [4]);
29.583 - *)
29.584 - val p = move_dn [] pt p (*-> ([4],Res)*);
29.585 - val p = move_dn [] pt p (*-> ([],Res)*);
29.586 -(*
29.587 - val p = (move_dn [] pt p) handle e => print_exn_G e;
29.588 - Exception PTREE end of calculation*)
29.589 -
29.590 -if p=([],Res) then () else error "ctree.sml: diff:behav. in move_dn";
29.591 -
29.592 -"-------------- move_dn: Frm -> Res ------------------------------";
29.593 -"-------------- move_dn: Frm -> Res ------------------------------";
29.594 -"-------------- move_dn: Frm -> Res ------------------------------";
29.595 - reset_states ();
29.596 - CalcTree (*start of calculation, return No.1*)
29.597 - [(["equality (1+-1*2+x=(0::real))", "solveFor x","solutions L"],
29.598 - ("Test",
29.599 - ["LINEAR","univariate","equation","test"],
29.600 - ["Test","solve_linear"]))];
29.601 - Iterator 1; moveActiveRoot 1;
29.602 - autoCalculate 1 CompleteCalcHead;
29.603 - autoCalculate 1 (Step 1);
29.604 - refFormula 1 (get_pos 1 1);
29.605 -
29.606 - moveActiveRoot 1;
29.607 - moveActiveDown 1;
29.608 - if get_pos 1 1 = ([1], Frm) then ()
29.609 - else error "ctree.sml: diff.behav. in move_dn: Frm -> Res (1)";
29.610 - moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
29.611 -
29.612 - autoCalculate 1 (Step 1);
29.613 - refFormula 1 (get_pos 1 1);
29.614 -
29.615 - moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
29.616 - if get_pos 1 1 = ([1], Res) then ()
29.617 - else error "ctree.sml: diff.behav. in move_dn: Frm -> Res (1)";
29.618 - moveActiveDown 1; (*<ERROR> pos does not exist </ERROR>*)
29.619 -
29.620 -
29.621 -"-------------- move_up ------------------------------------------";
29.622 -"-------------- move_up ------------------------------------------";
29.623 -"-------------- move_up ------------------------------------------";
29.624 - val p = move_up [] pt ([],Res); (*-> ([4],Res)*)
29.625 - val p = move_up [] pt p; (*-> ([3],Res)*)
29.626 - val p = move_up [] pt p; (*-> ([3,2],Res)*)
29.627 - val p = move_up [] pt p; (*-> ([3,1],Res)*)
29.628 - val p = move_up [] pt p; (*-> ([3,1],Frm)*)
29.629 - val p = move_up [] pt p; (*-> ([3],Pbl)*)
29.630 - val p = move_up [] pt p; (*-> ([2],Res)*)
29.631 - val p = move_up [] pt p; (*-> ([1],Res)*)
29.632 - val p = move_up [] pt p; (*-> ([1],Frm)*)
29.633 - val p = move_up [] pt p; (*-> ([],Pbl)*)
29.634 -(*val p = (move_up [] pt p) handle e => print_exn_G e;
29.635 - Exception PTREE begin of calculation*)
29.636 -
29.637 -if p=([],Pbl) then () else error "ctree.sml: diff.behav. in move_up";
29.638 -
29.639 -"------ move into detail -----------------------------------------";
29.640 -"------ move into detail -----------------------------------------";
29.641 -"------ move into detail -----------------------------------------";
29.642 - reset_states ();
29.643 - CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
29.644 - ("Test", ["sqroot-test","univariate","equation","test"],
29.645 - ["Test","squ-equ-test-subpbl1"]))];
29.646 - Iterator 1; moveActiveRoot 1;
29.647 - autoCalculate 1 CompleteCalc;
29.648 - moveActiveRoot 1;
29.649 - moveActiveDown 1;
29.650 - moveActiveDown 1;
29.651 - moveActiveDown 1;
29.652 - refFormula 1 (get_pos 1 1) (* 2 Res, <ISA> -1 + x = 0 </ISA> *);
29.653 -
29.654 - interSteps 1 ([2],Res);
29.655 -
29.656 - val ((pt,_),_) = get_calc 1; show_pt pt;
29.657 - val p = get_pos 1 1;
29.658 -
29.659 - val p = move_up [] pt p; (*([2, 6], Res)*);
29.660 - val p = movelevel_up [] pt p;(*([2], Frm)*);
29.661 - val p = move_dn [] pt p; (*([2, 1], Frm)*);
29.662 - val p = move_dn [] pt p; (*([2, 1], Res)*);
29.663 - val p = move_dn [] pt p; (*([2, 2], Res)*);
29.664 - val p = move_dn [] pt p; (*([2, 3], Res)*);
29.665 - val p = move_dn [] pt p; (*([2, 4], Res)*);
29.666 - val p = move_dn [] pt p; (*([2, 5], Res)*);
29.667 - val p = move_dn [] pt p; (*([2, 6], Res)*);
29.668 - if p = ([2, 6], Res) then()
29.669 - else error "ctree.sml: diff.behav. in move into detail";
29.670 -
29.671 -"=====new ctree 3a ===============================================";
29.672 -"=====new ctree 3a ===============================================";
29.673 -"=====new ctree 3a ===============================================";
29.674 - reset_states ();
29.675 - CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
29.676 - ("Test", ["sqroot-test","univariate","equation","test"],
29.677 - ["Test","squ-equ-test-subpbl1"]))];
29.678 - Iterator 1; moveActiveRoot 1;
29.679 - autoCalculate 1 CompleteCalcHead;
29.680 - autoCalculate 1 (Step 1);
29.681 - autoCalculate 1 (Step 1);
29.682 - autoCalculate 1 (Step 1);
29.683 - val ((pt,_),_) = get_calc 1;
29.684 - val p = move_dn [] pt ([],Pbl) (*-> ([1], Frm)*);
29.685 - val p = move_dn [] pt ([1], Frm) (*-> ([1], Res)*);
29.686 - val p = move_dn [] pt ([1], Res) (*-> ([2], Res)*);
29.687 - (*val p = move_dn [] pt ([2], Res) ->Exception- PTREE "[] not complete"*);
29.688 -
29.689 - moveDown 1 ([],Pbl) (*-> ([1], Frm)*);
29.690 - moveDown 1 ([1],Frm) (*-> ([1],Res)*);
29.691 - moveDown 1 ([1],Res) (*-> ([2],Res)*);
29.692 - moveDown 1 ([2],Res) (*-> pos does not exist*);
29.693 -(*
29.694 - get_obj g_ostate pt [1];
29.695 - show_pt pt;
29.696 -*)
29.697 -
29.698 -"-------------- move_dn in Incomplete ctree ----------------------";
29.699 -"-------------- move_dn in Incomplete ctree ----------------------";
29.700 -"-------------- move_dn in Incomplete ctree ----------------------";
29.701 -
29.702 -
29.703 -
29.704 -"=====new ctree 4: crooked by cut_level_'_ =======================";
29.705 -"=====new ctree 4: crooked by cut_level_'_ =======================";
29.706 -"=====new ctree 4: crooked by cut_level_'_ =======================";
29.707 -reset_states ();
29.708 -CalcTree
29.709 -[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
29.710 - "solveFor x","solutions L"],
29.711 - ("RatEq",["univariate","equation"],["no_met"]))];
29.712 -Iterator 1; moveActiveRoot 1;
29.713 -autoCalculate 1 CompleteCalc;
29.714 -
29.715 -getTactic 1 ([1],Res);(*Rewrite_Set RatEq_simplify*)
29.716 -getTactic 1 ([2],Res);(*Rewrite_Set norm_Rational*)
29.717 -getTactic 1 ([3],Res);(*Rewrite_Set RatEq_eliminate*)
29.718 -getTactic 1 ([4,1],Res);(*Rewrite all_left*)
29.719 -getTactic 1 ([4,2],Res);(*Rewrite_Set expand_binoms*)
29.720 -getTactic 1 ([4,3],Res);(*Rewrite_Set_Inst make_ratpoly_in*)
29.721 -
29.722 -moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
29.723 -moveActiveFormula 1 ([2],Res)(**ME_Isa: 'expand' not known*);
29.724 -moveActiveFormula 1 ([3],Res)(*3.1.*);
29.725 -moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
29.726 -moveActiveFormula 1 ([4,3],Res)(**one_scr_arg: called by Program Stepwise t_=*);
29.727 -
29.728 -moveActiveFormula 1 ([1],Res)(*1.1...1.4*);
29.729 -interSteps 1 ([1],Res)(*..is activeFormula !?!*);
29.730 -
29.731 -getTactic 1 ([1,1],Res);(*Rewrite real_diff_minus*)
29.732 -getTactic 1 ([1,2],Res);(*Rewrite real_diff_minus*)
29.733 -getTactic 1 ([1,3],Res);(*Rewrite real_diff_minus*)
29.734 -getTactic 1 ([1,4],Res);(*Rewrite real_rat_mult_1*)
29.735 -
29.736 -moveActiveFormula 1 ([4,2],Res)(*4.2.1.*);
29.737 -interSteps 1 ([4,2],Res)(*..is activeFormula !?!*);
29.738 -val ((pt,_),_) = get_calc 1;
29.739 -writeln(pr_ctree pr_short pt);
29.740 -(*delete [4,1] in order to make pos [4],[4,4] for pblobjs differen [4],[4,3]:
29.741 - ###########################################################################*)
29.742 -val (pt, ppp) = cut_level_'_ [] [] pt ([4,1],Frm);
29.743 -writeln(pr_ctree pr_short pt);
29.744 -
29.745 -
29.746 -
29.747 -
29.748 -
29.749 -"-------------- get_interval from ctree: incremental development--";
29.750 -"-------------- get_interval from ctree: incremental development--";
29.751 -"-------------- get_interval from ctree: incremental development--";
29.752 -"--- level 1: get pos from start b to end p ----------------------";
29.753 -"--- level 1: get pos from start b to end p ----------------------";
29.754 -"--- level 1: get pos from start b to end p ----------------------";
29.755 -(******************************************************************)
29.756 -(**) val SAVE_get_trace = get_trace; (**)
29.757 -(******************************************************************)
29.758 -(*'getnds' below is structured as such:*)
29.759 -fun www _ [x] = "l+r-margin"
29.760 - | www true [x1,x2] = "l-margin, r-margin"
29.761 - | www _ [x1,x2] = "intern, r-margin"
29.762 - | www true (x::(xs as _::_)) = "l-margin " ^ www false xs
29.763 - | www _ (x::(xs as _::_)) = "intern " ^ www false xs;
29.764 -www true [1,2,3,4,5];
29.765 -(*val it = "from intern intern intern to" : string*)
29.766 -www true [1,2];
29.767 -(*val it = "from to" : string*)
29.768 -www true [1];
29.769 -(*val it = "from+to" : string*)
29.770 -
29.771 -local
29.772 -(*specific values of hd of pos p,q for simple handling take_fromto,
29.773 - from-pos p, to-pos q: take_fromto (hdp p) (hdq q) (children pt) ...
29.774 - ... can be used even for positions _below_ p or q*)
29.775 -fun hdp [] = 1 | hdp [0] = 1 | hdp x = hd x;(*start with first*)
29.776 -fun hdq [] = 99999 | hdq [0] = 99999 | hdq x = hd x;(*take until last*)
29.777 -(*analoguous for tl*)
29.778 -fun tlp [] = [0] | tlp [_] = [0] | tlp x = tl x;
29.779 -fun tlq [] = [99999] | tlq [_] = [99999] | tlq x = tl x;
29.780 -
29.781 -(*see modspec.sml#pt_form
29.782 -fun pt_form (PrfObj {form,...}) = term2str form
29.783 - | pt_form (PblObj {probl,spec,origin=(_,spec',_),...}) =
29.784 - let val (dI, pI, _) = get_somespec' spec spec'
29.785 - val {cas,...} = get_pbt pI
29.786 - in case cas of
29.787 - NONE => term2str (pblterm dI pI)
29.788 - | SOME t => term2str (subst_atomic (mk_env probl) t)
29.789 - end;
29.790 -*)
29.791 -(*.get an 'interval' from ctree down to a certain level
29.792 - by 'take_fromto children' of the nodes with specific 'from' and 'to';
29.793 - 'i > 0' suppresses output during recursive descent towards 'from'
29.794 - b: the 'from' incremented to the actual pos
29.795 - p,q: specific 'from','to' for simple use of 'take_fromto'*)
29.796 -fun getnd i (b,p) q (Nd (po, nds)) =
29.797 - (if i <= 0 then [(*[(b, pt_form po)]*) (**)[b](**)] else [])
29.798 -
29.799 - @ (writeln("getnd : b="^(ints2str' b)^", p="^
29.800 - (ints2str' p)^", q="^(ints2str' q));
29.801 -
29.802 - getnds (i-1) true (b@[hdp p], tlp p) (tlq q)
29.803 - (take_fromto (hdp p) (hdq q) nds))
29.804 -
29.805 -and getnds _ _ _ _ [] = [] (*no children*)
29.806 - | getnds i _ (b,p) q [nd] = (getnd i (b,p) q nd) (*l+r-margin*)
29.807 - | getnds i true (b,p) q [n1, n2] = (*l-margin, r-margin*)
29.808 - (writeln("getnds3: b="^ ints2str' b ^", p="^ ints2str' p ^
29.809 - ", q="^ ints2str' q);
29.810 - (getnd i ( b, p ) [99999] n1) @
29.811 - (getnd ~99999 (lev_on b,[0]) q n2))
29.812 - | getnds i _ (b,p) q [n1, n2] = (*intern, r-margin*)
29.813 - (writeln("getnds4: b="^ ints2str' b ^", p="^ ints2str' p ^
29.814 - ", q="^ ints2str' q);
29.815 - (getnd i ( b,[0]) [99999] n1) @
29.816 - (getnd ~99999 (lev_on b,[0]) q n2))
29.817 - | getnds i true (b,p) q (nd::(nds as _::_)) = (*l-margin, intern*)
29.818 - (writeln("getnds5: b="^ ints2str' b ^", p="^ ints2str' p ^
29.819 - ", q="^ ints2str' q);
29.820 - (getnd i ( b, p ) [99999] nd) @
29.821 - (getnds ~99999 false (lev_on b,[0]) q nds))
29.822 - | getnds i _ (b,p) q (nd::(nds as _::_)) = (*intern, ...*)
29.823 - (getnd i ( b,[0]) [99999] nd) @
29.824 - (getnds ~99999 false (lev_on b,[0]) q nds);
29.825 -in
29.826 -(*get an 'interval from to' from a ctree as 'intervals f t' of respective nodes
29.827 - where 'from' are pos, i.e. a key as int list, 'f' an int (to,t analoguous)
29.828 -(1) the 'f' are given
29.829 -(1a) by 'from' if 'f' = the respective element of 'from' (left margin)
29.830 -(1b) -inifinity, if 'f' > the respective element of 'from' (internal node)
29.831 -(2) the 't' ar given
29.832 -(2a) by 'to' if 't' = the respective element of 'to' (right margin)
29.833 -(2b) inifinity, if 't' < the respective element of 'to (internal node)'
29.834 -the 'f' and 't' are set by hdp,... *)
29.835 -fun get_trace pt p q =
29.836 - (flat o (getnds ((length p) -1) true ([hdp p], tlp p) (tlq q)))
29.837 - (take_fromto (hdp p) (hdq q) (children pt));
29.838 -end;
29.839 -
29.840 -writeln(pr_ctree pr_short pt);
29.841 -
29.842 -case get_trace pt [1,3] [4,1,1] of
29.843 - [[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1]] => ()
29.844 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1a";
29.845 -case get_trace pt [2] [4,3,2] of
29.846 - [[2],[3],[4],[4,1],[4,1,1],[4,2],[4,3],[4,3,1],[4,3,2]] => ()
29.847 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1b";
29.848 -case get_trace pt [1,4] [4,3,1] of
29.849 - [[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],[4,3],[4,3,1]] => ()
29.850 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1c";
29.851 -
29.852 -
29.853 -(*========== inhibit exn AK110719 ==============================================
29.854 -case get_trace pt [4,2] [5] of
29.855 - (*[([4,2],_),([4,3],_),([4,4],_),([4,4,1],_),([4,4,2],_),([4,4,3],_),
29.856 - ([4,4,4],_),([4,4,5],_),([5],_)] => () ..with pt_form*)
29.857 - [[4,2],[4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5],[5]]=>()
29.858 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1d";
29.859 -========== inhibit exn AK110719 ==============================================*)
29.860 -
29.861 -case get_trace pt [] [4,4,2] of
29.862 - [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],
29.863 - [4,3],[4,3,1],[4,3,2]] => ()
29.864 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1e";
29.865 -
29.866 -(*========== inhibit exn AK110719 ==============================================
29.867 -case get_trace pt [] [] of
29.868 - [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,1,1],[4,2],
29.869 - [4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5],[5]] => ()
29.870 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1f";
29.871 -case get_trace pt [4,3] [4,3] of
29.872 - [[4,3],[4,3,1],[4,3,2],[4,3,3],[4,3,4],[4,3,5]] => ()
29.873 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1g";
29.874 -========== inhibit exn AK110719 ==============================================*)
29.875 -
29.876 -"--- level 2: get pos' from start b to end p ---------------------";
29.877 -"--- level 2: get pos' from start b to end p ---------------------";
29.878 -"--- level 2: get pos' from start b to end p ---------------------";
29.879 -(*idea: pos_ is _ONLY_ relevant exactly at (endpoint of) from, to
29.880 - development stopped in favour of move_dn, see get_interval
29.881 - actually used (inefficient) version with move_dn: see modspec.sml
29.882 -*)
29.883 -(*
29.884 -case get_trace pt ([1,4],Res) ([4,4,1],Frm) of
29.885 - [[2],[3],[4],[4,1],[4,2],[4,2,1],[4,3],[4,4],[4,4,1]] => ()
29.886 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1b";
29.887 -case get_trace pt ([],Pbl) ([],Res) of
29.888 - [[1],[1,1],[1,2],[1,3],[1,4],[2],[3],[4],[4,1],[4,2],[4,2,1],[4,3],
29.889 - [4,4],[4,4,1],[4,4,2],[4,4,3],[4,4,4],[4,4,5],[5]] => ()
29.890 - | _ => error "diff.behav.in ctree.sml: get_interval lev 1e";
29.891 -*)
29.892 -
29.893 -(******************************************************************)
29.894 -(**) val get_trace = SAVE_get_trace; (**)
29.895 -(******************************************************************)
29.896 -
29.897 -
29.898 -"=====new ctree 4 ratequation ====================================";
29.899 -"=====new ctree 4 ratequation ====================================";
29.900 -"=====new ctree 4 ratequation ====================================";
29.901 -reset_states ();
29.902 -CalcTree
29.903 -[(["equality (x/(x^2 - 6*x+9) - 1/(x^2 - 3*x) =1/x)",
29.904 - "solveFor x","solutions L"],
29.905 - ("RatEq",["univariate","equation"],["no_met"]))];
29.906 -Iterator 1; moveActiveRoot 1;
29.907 -autoCalculate 1 CompleteCalc;
29.908 -val ((pt,_),_) = get_calc 1;
29.909 -val p = get_pos 1 1;
29.910 -val (Form f, tac, asms) = pt_extract (pt, p);
29.911 -(*============ inhibit exn WN120316 ==============================================
29.912 -if term2str f = "[x = 6 / 5]" andalso p = ([], Res) then ()
29.913 - else error "after ===new ctree 4 ratequation ===";
29.914 -(*WN120317.TODO dropped rateq*)
29.915 -============ inhibit exn WN120316 ==============================================*)
29.916 -if p = ([], Res) andalso term2str f = "[]" (*see WN120317.TODO dropped rateq*)
29.917 -andalso asms = [] (*STRANGE!, compare test --- x / (x ^ 2 - 6 * x + 9) - 1 / (x ^ 2 ...*)
29.918 -then () else error "after ===new ctree 4 ratequation ===";
29.919 -
29.920 -
29.921 -"-------------- pt_extract form, tac, asm<>[] --------------------";
29.922 -"-------------- pt_extract form, tac, asm<>[] --------------------";
29.923 -"-------------- pt_extract form, tac, asm<>[] --------------------";
29.924 -val (Form form, SOME tac, asm) = pt_extract (pt, ([3], Res));
29.925 -case (term2str form, tac, terms2strs asm) of
29.926 - ("(3 + -1 * x + x ^^^ 2) * x = 1 * (9 * x + -6 * x ^^^ 2 + x ^^^ 3)",
29.927 - Subproblem
29.928 - ("PolyEq",
29.929 - ["normalise", "polynomial", "univariate", "equation"]),
29.930 - ["9 * x + -6 * x ^^^ 2 + x ^^^ 3 \<noteq> 0"]) => ()
29.931 - | _ => error "diff.behav.in ctree.sml: pt_extract asm<>[]";
29.932 -(*WN060717 unintentionally changed some rls/ord while
29.933 - completing knowl. for thes2file...
29.934 -
29.935 - case (term2str form, tac, terms2strs asm) of
29.936 - ((*"(3 + (-1 * x + x ^^^ 2)) * x = 1 * (9 * x + (x ^^^ 3 + -6 * x ^^^ 2))",
29.937 - *)Subproblem
29.938 - ("PolyEq",
29.939 - ["normalise", "polynomial", "univariate", "equation"]),
29.940 - ["9 * x + (x ^^^ 3 + -6 * x ^^^ 2) ~= 0"]) => ()
29.941 - | _ => error "diff.behav.in ctree.sml: pt_extract asm<>[]";
29.942 -
29.943 -.... but it became even better*)
29.944 -
29.945 -
29.946 -
29.947 -"=====new ctree 5 minisubpbl =====================================";
29.948 -"=====new ctree 5 minisubpbl =====================================";
29.949 -"=====new ctree 5 minisubpbl =====================================";
29.950 -reset_states ();
29.951 -CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
29.952 - ("Test", ["sqroot-test","univariate","equation","test"],
29.953 - ["Test","squ-equ-test-subpbl1"]))];
29.954 -Iterator 1; moveActiveRoot 1;
29.955 -autoCalculate 1 CompleteCalc;
29.956 -val ((pt,_),_) = get_calc 1;
29.957 -show_pt pt;
29.958 -
29.959 -"-------------- pt_extract form, tac, asm ------------------------";
29.960 -"-------------- pt_extract form, tac, asm ------------------------";
29.961 -"-------------- pt_extract form, tac, asm ------------------------";
29.962 -val (ModSpec (_,_,form,_,_,_), SOME tac, asm) = pt_extract (pt, ([], Frm));
29.963 -case (term2str form, tac, terms2strs asm) of
29.964 - ("solve (x + 1 = 2, x)",
29.965 - Apply_Method ["Test", "squ-equ-test-subpbl1"],
29.966 - []) => ()
29.967 - | _ => error "diff.behav.in ctree.sml: pt_extract ([], Pbl)";
29.968 -
29.969 -val (Form form, SOME tac, asm) = pt_extract (pt, ([1], Frm));
29.970 -case (term2str form, tac, terms2strs asm) of
29.971 - ("x + 1 = 2", Rewrite_Set "norm_equation", []) => ()
29.972 - | _ => error "diff.behav.in ctree.sml: pt_extract ([1], Frm)";
29.973 -
29.974 -val (Form form, SOME tac, asm) = pt_extract (pt, ([1], Res));
29.975 -case (term2str form, tac, terms2strs asm) of
29.976 - ("x + 1 + -1 * 2 = 0", Rewrite_Set "Test_simplify", []) => ()
29.977 - | _ => error "diff.behav.in ctree.sml: pt_extract ([1], Res)";
29.978 -
29.979 -val (Form form, SOME tac, asm) = pt_extract (pt, ([2], Res));
29.980 -case (term2str form, tac, terms2strs asm) of
29.981 - ("-1 + x = 0",
29.982 - Subproblem ("Test", ["LINEAR", "univariate", "equation", "test"]),
29.983 - []) => ()
29.984 - | _ => error "diff.behav.in ctree.sml: pt_extract ([2], Res)";
29.985 -
29.986 -val (ModSpec (_,_,form,_,_,_), SOME tac, asm) = pt_extract (pt, ([3], Pbl));
29.987 -case (term2str form, tac, terms2strs asm) of
29.988 - ("solve (-1 + x = 0, x)", Apply_Method ["Test", "solve_linear"], []) => ()
29.989 - | _ => error "diff.behav.in ctree.sml: pt_extract ([3], Pbl)";
29.990 -
29.991 -val (Form form, SOME tac, asm) = pt_extract (pt, ([3,1], Frm));
29.992 -case (term2str form, tac, terms2strs asm) of
29.993 - ("-1 + x = 0", Rewrite_Set_Inst (["(''bdv'', x)"], "isolate_bdv"), []) => ()
29.994 - | _ => error "diff.behav.in ctree.sml: pt_extract ([3,1], Frm)";
29.995 -
29.996 -val (Form form, SOME tac, asm) = pt_extract (pt, ([3,1], Res));
29.997 -case (term2str form, tac, terms2strs asm) of
29.998 - ("x = 0 + -1 * -1", Rewrite_Set "Test_simplify", []) => ()
29.999 - | _ => error "diff.behav.in ctree.sml: pt_extract ([3,1], Res)";
29.1000 -
29.1001 -val (Form form, SOME tac, asm) = pt_extract (pt, ([3,2], Res));
29.1002 -case (term2str form, tac, terms2strs asm) of
29.1003 - ("x = 1", Check_Postcond ["LINEAR", "univariate", "equation", "test"],
29.1004 - []) => ()
29.1005 - | _ => error "diff.behav.in ctree.sml: pt_extract ([3,2], Res)";
29.1006 -
29.1007 -(*========== inhibit exn AK110719 ==============================================
29.1008 -val (Form form, SOME tac, asm) = pt_extract (pt, ([3], Res));
29.1009 -case (term2str form, tac, terms2strs asm) of
29.1010 - ("[x = 1]", Check_elementwise "Assumptions", []) => ()
29.1011 - | _ => error "diff.behav.in ctree.sml: pt_extract ([3], Res)";
29.1012 -
29.1013 -val (Form form, SOME tac, asm) = pt_extract (pt, ([4], Res));
29.1014 -case (term2str form, tac, terms2strs asm) of
29.1015 - ("[x = 1]",
29.1016 - Check_Postcond ["sqroot-test", "univariate", "equation", "test"],
29.1017 - []) => ()
29.1018 - | _ => error "diff.behav.in ctree.sml: pt_extract ([4], Res)";
29.1019 -
29.1020 -val (Form form, tac, asm) = pt_extract (pt, ([], Res));
29.1021 -case (term2str form, tac, terms2strs asm) of
29.1022 - ("[x = 1]", NONE, []) => ()
29.1023 - | _ => error "diff.behav.in ctree.sml: pt_extract ([], Res)";
29.1024 -========== inhibit exn AK110719 ==============================================*)
29.1025 -
29.1026 -"=====new ctree 6 minisubpbl intersteps ==========================";
29.1027 -"=====new ctree 6 minisubpbl intersteps ==========================";
29.1028 -"=====new ctree 6 minisubpbl intersteps ==========================";
29.1029 -reset_states ();
29.1030 -CalcTree [(["equality (x+1=(2::real))", "solveFor x","solutions L"],
29.1031 - ("Test", ["sqroot-test","univariate","equation","test"],
29.1032 - ["Test","squ-equ-test-subpbl1"]))];
29.1033 -Iterator 1; moveActiveRoot 1;
29.1034 -autoCalculate 1 CompleteCalc;
29.1035 -interSteps 1 ([2],Res);
29.1036 -interSteps 1 ([3,2],Res);
29.1037 -val ((pt,_),_) = get_calc 1;
29.1038 -show_pt pt;
29.1039 -
29.1040 -(**##############################################################**)
29.1041 -"-------------- get_allpos' new ----------------------------------";
29.1042 -"-------------- get_allpos' new ----------------------------------";
29.1043 -"-------------- get_allpos' new ----------------------------------";
29.1044 -"--- whole ctree";
29.1045 -(*default_print_depth 99;*)
29.1046 -val cuts = get_allp [] ([], ([],Frm)) pt;
29.1047 -(*default_print_depth 3;*)
29.1048 -if cuts =
29.1049 - [(*never returns the first pos'*)
29.1050 - ([1], Frm),
29.1051 - ([1], Res),
29.1052 - ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
29.1053 - ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
29.1054 - ([2], Res),
29.1055 - ([3], Pbl),
29.1056 - ([3, 1], Frm), ([3, 1], Res),
29.1057 - ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
29.1058 - ([3, 2], Res),
29.1059 - ([3], Res),
29.1060 - ([4], Res),
29.1061 - ([], Res)] then () else
29.1062 -error "ctree.sml diff.behav. get_allp new []";
29.1063 -
29.1064 -(*default_print_depth 99;*)
29.1065 -val cuts2 = get_allps [] [1] (children pt);
29.1066 -(*default_print_depth 3;*)
29.1067 -if cuts = cuts2 @ [([], Res)] then () else
29.1068 -error "ctree.sml diff.behav. get_allps new []";
29.1069 -
29.1070 -"---(3) on S(606)..S(608)--------";
29.1071 -"--- nd [2] with 6 children---------------------------------";
29.1072 -val cuts = get_allp [] ([2], ([],Frm)) (get_nd pt [2]);
29.1073 -if cuts =
29.1074 - [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
29.1075 - ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
29.1076 - ([2], Res)] then () else
29.1077 -error "ctree.sml diff.behav. get_allp new [2]";
29.1078 -
29.1079 -val cuts2 = get_allps [] [2,1] (children (get_nd pt [2]));
29.1080 -if cuts = cuts2 @ [([2], Res)] then () else
29.1081 -error "ctree.sml diff.behav. get_allps new [2]";
29.1082 -
29.1083 -
29.1084 -"---(4) on S(606)..S(608)--------";
29.1085 -"--- nd [3] subproblem--------------------------------------";
29.1086 -val cuts = get_allp [] ([3], ([],Frm)) (get_nd pt [3]);
29.1087 -if cuts =
29.1088 - [([3, 1], Frm),
29.1089 - ([3, 1], Res),
29.1090 - ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
29.1091 - ([3, 2], Res),
29.1092 - ([3], Res)] then () else
29.1093 -error "ctree.sml diff.behav. get_allp new [3]";
29.1094 -
29.1095 -val cuts2 = get_allps [] [3,1] (children (get_nd pt [3]));
29.1096 -if cuts = cuts2 @ [([3], Res)] then () else
29.1097 -error "ctree.sml diff.behav. get_allps new [3]";
29.1098 -
29.1099 -"--- nd [3,2] with 2 children--------------------------------";
29.1100 -val cuts = get_allp [] ([3,2], ([],Frm)) (get_nd pt [3,2]);
29.1101 -if cuts =
29.1102 - [([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
29.1103 - ([3, 2], Res)] then () else
29.1104 -error "ctree.sml diff.behav. get_allp new [3,2]";
29.1105 -
29.1106 -val cuts2 = get_allps [] [3,2,1] (children (get_nd pt [3,2]));
29.1107 -if cuts = cuts2 @ [([3, 2], Res)] then () else
29.1108 -error "ctree.sml diff.behav. get_allps new [3,2]";
29.1109 -
29.1110 -"---(5a) on S(606)..S(608)--------";
29.1111 -"--- nd [3,2,1] with 0 children------------------------------";
29.1112 -val cuts = get_allp [] ([3,2,1], ([],Frm)) (get_nd pt [3,2,1]);
29.1113 -if cuts =
29.1114 - [] then () else
29.1115 -error "ctree.sml diff.behav. get_allp new [3,2,1]";
29.1116 -
29.1117 -val cuts2 = get_allps [] [3,2,1,1] (children (get_nd pt [3,2,1]));
29.1118 -if cuts = cuts2 @ [] then () else
29.1119 -error "ctree.sml diff.behav. get_allps new [3,2,1]";
29.1120 -
29.1121 -
29.1122 -(**#################################################################**)
29.1123 -"-------------- cut_tree new (from ctree above)-------------------";
29.1124 -"-------------- cut_tree new (from ctree above)-------------------";
29.1125 -"-------------- cut_tree new (from ctree above)-------------------";
29.1126 -show_pt pt;
29.1127 -val b = get_obj g_branch pt [];
29.1128 -if b = TransitiveB then () else
29.1129 -error ("ctree.sml diff.behav. in [] branch="^branch2str b);
29.1130 -val b = get_obj g_branch pt [3];
29.1131 -if b = TransitiveB then () else
29.1132 -error ("ctree.sml diff.behav. in [3] branch="^branch2str b);
29.1133 -
29.1134 -"---(2) on S(606)..S(608)--------";
29.1135 -val (pt', cuts) = cut_tree pt ([1],Res);
29.1136 -(*default_print_depth 99;*)
29.1137 -cuts;
29.1138 -(*default_print_depth 3;*)
29.1139 -if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
29.1140 - ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
29.1141 - ([3, 1], Frm), ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
29.1142 - ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
29.1143 - ([], Res)] then () else
29.1144 -error "ctree.sml: diff.behav. cut_tree ([1],Res)";
29.1145 -
29.1146 -
29.1147 -"---(3) on S(606)..S(608)--------";
29.1148 -val (pt', cuts) = cut_tree pt ([2],Res);
29.1149 -(*default_print_depth 99;*)
29.1150 -cuts;
29.1151 -(*default_print_depth 3;*)
29.1152 -if cuts = [(*preceding step on WS was ([1]),Res*)
29.1153 - ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
29.1154 - ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
29.1155 - ([2], Res),
29.1156 - ([3], Pbl),
29.1157 - ([3, 1], Frm),
29.1158 - ([3, 1], Res),
29.1159 - ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
29.1160 - ([3, 2], Res),
29.1161 - ([3], Res),
29.1162 - ([4], Res),
29.1163 - ([],Res)] then ()
29.1164 -else error "ctree.sml: diff.behav. cut_tree ([2],Res)";
29.1165 -
29.1166 -"---(4) on S(606)..S(608)--------";
29.1167 -val (pt', cuts) = cut_tree pt ([3],Pbl);
29.1168 -(*default_print_depth 99;*)
29.1169 -cuts;
29.1170 -(*default_print_depth 3;*)
29.1171 -if cuts = [([3], Pbl),
29.1172 - ([3, 1], Frm), ([3, 1], Res),
29.1173 - ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
29.1174 - ([3, 2], Res),
29.1175 - ([3], Res),
29.1176 - ([4], Res),
29.1177 - ([], Res)]
29.1178 -then () else error "ctree.sml: diff.behav. cut_tree ([3],Pbl)";
29.1179 -
29.1180 -"---(5a) on S(606)..S(608) cut_tree --------";
29.1181 -val (pt', cuts) = cut_tree pt ([3,2,1],Res);
29.1182 -(*default_print_depth 99;*)
29.1183 -cuts;
29.1184 -(*default_print_depth 1;*)
29.1185 -if cuts = [([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),([],Res)] then ()
29.1186 -else error "ctree.sml: diff.behav. cut_tree ([3,2,1],Res)";
29.1187 -show_pt pt';
29.1188 -
29.1189 -
29.1190 -"-------------- cappend on complete ctree from above -------------";
29.1191 -"-------------- cappend on complete ctree from above -------------";
29.1192 -"-------------- cappend on complete ctree from above -------------";
29.1193 -show_pt pt;
29.1194 -
29.1195 -"---(2) on S(606)..S(608)--------";
29.1196 -(*========== inhibit exn AK110726 ==============================================
29.1197 -(* ERROR: Can't unify istate to istate * Proof.context *)
29.1198 -val (pt', cuts) = cappend_atomic pt [1] e_istate (str2term "Inform[1]")
29.1199 - (Tac "test") (str2term "Inres[1]",[]) Complete;
29.1200 -
29.1201 -(*default_print_depth 99;*)
29.1202 -cuts;
29.1203 -(*default_print_depth 3;*)
29.1204 -if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
29.1205 - ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
29.1206 - ([3, 1], Frm), ([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
29.1207 - ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
29.1208 - ([], Res)] then ()
29.1209 -else error "ctree.sml: diff:behav. in complete pt:append_atomic[1] cuts";
29.1210 -
29.1211 -val afterins = get_allp [] ([], ([],Frm)) pt';
29.1212 -(*default_print_depth 99;*)
29.1213 -afterins;
29.1214 -(*default_print_depth 3;*)
29.1215 -if afterins = [([1], Frm), ([1], Res)] then()
29.1216 -else error "ctree.sml: diff:behav. in complete pt: append_atomic[1] afterins";
29.1217 -show_pt pt';
29.1218 -"---(3) on S(606)..S(608)--------";
29.1219 -show_pt pt;
29.1220 -val (pt', cuts) = cappend_atomic pt [2] e_istate (str2term "Inform[2]")
29.1221 - (Tac "test") (str2term "Inres[2]",[]) Complete;
29.1222 -(*default_print_depth 99;*)
29.1223 -cuts;
29.1224 -(*default_print_depth 3;*)
29.1225 -
29.1226 -if cuts = [([2, 1], Frm), ([2, 1], Res), ([2, 2], Res), ([2, 3], Res),
29.1227 - ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res), ([3], Pbl),
29.1228 - ([3, 1], Frm),([3, 1], Res), ([3, 2, 1], Frm), ([3, 2, 1], Res),
29.1229 - ([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res),
29.1230 - ([], Res)] then ()
29.1231 -else error "ctree.sml: diff:behav.in complete pt: append_atomic[2] cuts";
29.1232 -
29.1233 -
29.1234 -val afterins = get_allp [] ([], ([],Frm)) pt';
29.1235 -(*default_print_depth 99;*)
29.1236 -afterins;
29.1237 -(*default_print_depth 3;*)
29.1238 -
29.1239 -if afterins = [([1], Frm), ([1], Res), ([2], Frm), ([2], Res)]
29.1240 -then () else
29.1241 -error "ctree.sml: diff:behav. in complete pt: append_atomic[2] afterins";
29.1242 -show_pt pt';
29.1243 -
29.1244 -
29.1245 -(*
29.1246 - val p = move_dn [] pt' ([],Pbl) (*-> ([1],Frm)*);
29.1247 - val p = move_dn [] pt' p (*-> ([1],Res)*);
29.1248 - val p = move_dn [] pt' p (*-> ([2],Frm)*);
29.1249 - val p = move_dn [] pt' p (*-> ([2],Res)*);
29.1250 -
29.1251 - term2str (get_obj g_form pt' [2]);
29.1252 - term2str (get_obj g_res pt' [2]);
29.1253 - ostate2str (get_obj g_ostate pt' [2]);
29.1254 - *)
29.1255 -
29.1256 -"---(4) on S(606)..S(608)--------";
29.1257 -val (pt', cuts) = cappend_problem pt [3] e_istate ([],e_spec)
29.1258 - ([],e_spec, str2term "Inhead[3]");
29.1259 -(*default_print_depth 99;*)
29.1260 -cuts;
29.1261 -(*default_print_depth 3;*)
29.1262 -if cuts = [([3], Pbl),
29.1263 - ([3, 1], Frm), ([3, 1], Res),
29.1264 - ([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
29.1265 - ([3, 2], Res),
29.1266 - ([3], Res), ([4], Res),
29.1267 - ([], Res)] then ()else
29.1268 -error "ctree.sml: diff:behav. in ccomplete pt: append_problem[3] cuts";
29.1269 -val afterins = get_allp [] ([], ([],Frm)) pt';
29.1270 -(*default_print_depth 99;*)
29.1271 -afterins;
29.1272 -(*default_print_depth 3;*)
29.1273 -if afterins =
29.1274 - [([1], Frm), ([1], Res),([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
29.1275 - ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res), ([2], Res),
29.1276 - ([3], Pbl)] then () else
29.1277 -error "ctree.sml: diff:behav.in complete pt: append_problem[3] afterins";
29.1278 -(* use"systest/ctree.sml";
29.1279 - use"ctree.sml";
29.1280 - *)
29.1281 -
29.1282 -"---(6-1) on S(606)..S(608)--------";
29.1283 -val (pt', cuts) = cappend_atomic pt [3,1] e_istate (str2term "Inform[3,1]")
29.1284 - (Tac "test") (str2term "Inres[3,1]",[]) Complete;
29.1285 -(*default_print_depth 99;*)
29.1286 -cuts;
29.1287 -(*default_print_depth 3;*)
29.1288 -if cuts = [([3, 2, 1], Frm), ([3, 2, 1], Res), ([3, 2, 2], Res),
29.1289 - ([3, 2], Res),
29.1290 -(*WN060727 added*)([3], Res), ([4], Res), ([], Res)] then () else
29.1291 -error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] cuts";
29.1292 -
29.1293 -val afterins = get_allp [] ([], ([],Frm)) pt';
29.1294 -(*default_print_depth 99;*)
29.1295 -afterins;
29.1296 -(*default_print_depth 3;*)
29.1297 -if afterins = [([1], Frm), ([1], Res),
29.1298 - ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
29.1299 - ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
29.1300 - ([2], Res),
29.1301 - ([3], Pbl),
29.1302 - ([3, 1], Frm), ([3, 1], Res)] then () else
29.1303 -error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] insrtd";
29.1304 -
29.1305 -if term2str (get_obj g_form pt' [3,1]) = "Inform [3, 1]" then () else
29.1306 -error "ctree.sml: diff:behav. in complete pt: append_atomic[3,1] Inform";
29.1307 -
29.1308 -"---(6) on S(606)..S(608)--------";
29.1309 -val (pt', cuts) = cappend_atomic pt [3,2] e_istate (str2term "Inform[3,2]")
29.1310 - (Tac "test") (str2term "Inres[3,2]",[]) Complete;
29.1311 -(*default_print_depth 99;*)
29.1312 -cuts;
29.1313 -(*default_print_depth 3;*)
29.1314 -if cuts = [([3], Res), ([4], Res), ([], Res)] then () else
29.1315 -error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] cuts";
29.1316 -val afterins = get_allp [] ([], ([],Frm)) pt';
29.1317 -(*default_print_depth 99;*)
29.1318 -afterins;
29.1319 -(*default_print_depth 3;*)
29.1320 -if afterins = [([1], Frm), ([1], Res),
29.1321 - ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
29.1322 - ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
29.1323 - ([2], Res),
29.1324 - ([3], Pbl),
29.1325 - ([3, 1], Frm), ([3, 1], Res), ([3, 2], Frm), ([3, 2], Res)]
29.1326 -then () else
29.1327 -error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] insrtd";
29.1328 -
29.1329 -if term2str (get_obj g_form pt' [3,2]) = "Inform [3, 2]" then () else
29.1330 -error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2] Inform";
29.1331 -
29.1332 -"---(6++) on S(606)..S(608)--------";
29.1333 -(**)
29.1334 -val (pt', cuts) = cappend_atomic pt [3,2,1] e_istate (str2term "Inform[3,2,1]")
29.1335 - (Tac "test") (str2term "Inres[3,2,1]",[]) Complete;
29.1336 -(*default_print_depth 99;*)
29.1337 -cuts;
29.1338 -(*default_print_depth 1;*)
29.1339 -if cuts = [([3, 2, 2], Res), ([3, 2], Res), ([3], Res), ([4], Res), ([], Res)]
29.1340 -then () else
29.1341 -error "ctree.sml: diff:behav. in complete pt: append_atomic[3,2,1] cuts";
29.1342 -val afterins = get_allp [] ([], ([],Frm)) pt';
29.1343 -(*default_print_depth 99;*)
29.1344 -afterins;
29.1345 -(*default_print_depth 3;*)
29.1346 -if afterins = [([1], Frm), ([1], Res),
29.1347 - ([2, 1], Frm), ([2, 1], Res), ([2, 2], Res),
29.1348 - ([2, 3], Res), ([2, 4], Res), ([2, 5], Res), ([2, 6], Res),
29.1349 - ([2], Res),
29.1350 - ([3], Pbl),
29.1351 - ([3, 1], Frm), ([3, 1], Res),
29.1352 - ([3, 2, 1], Frm), ([3, 2, 1], Res)] then () else
29.1353 -error "ctree.sml: diff:behav. in complete pt: append_atom[3,2,1] insrtd";
29.1354 -if term2str (get_obj g_form pt' [3,2,1]) = "Inform [3, 2, 1]" then () else
29.1355 -error "ctree.sml: diff:behav. complete pt: append_atomic[3,2,1] Inform";
29.1356 -(*
29.1357 -show_pt pt';
29.1358 -show_pt pt;
29.1359 -*)
29.1360 -========== inhibit exn AK110726 ==============================================*)
29.1361 -"-------------- repl_app------------------------------------------";
29.1362 -"-------------- repl_app------------------------------------------";
29.1363 -"-------------- repl_app------------------------------------------";
29.1364 -(*
29.1365 -> repl [1,2,3] 2 22222;
29.1366 -val it = [1,22222,3] : int list
29.1367 -> repl_app [1,2,3,4] 5 5555;
29.1368 -val it = [1,2,3,4,5555] : int list
29.1369 -> repl_app [1,2,3] 2 22222;
29.1370 -val it = [1,22222,3] : int list
29.1371 -> repl_app [1] 2 22222 ;
29.1372 -val it = [1,22222] : int list
29.1373 -*)
30.1 --- a/test/Tools/isac/Specify/model.sml Fri Oct 25 16:07:15 2019 +0200
30.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
30.3 @@ -1,51 +0,0 @@
30.4 -(* Title: "Specify/model.sml"
30.5 - Author: Walther Neuper
30.6 - (c) due to copyright terms
30.7 -*)
30.8 -
30.9 -"-----------------------------------------------------------------------------------------------";
30.10 -"table of contents -----------------------------------------------------------------------------";
30.11 -"-----------------------------------------------------------------------------------------------";
30.12 -"-----------------------------------------------------------------------------------------------";
30.13 -"----------- fun upd_envv ----------------------------------------------------------------------";
30.14 -"-----------------------------------------------------------------------------------------------";
30.15 -"-----------------------------------------------------------------------------------------------";
30.16 -"-----------------------------------------------------------------------------------------------";
30.17 -
30.18 -
30.19 -"----------- fun upd_envv ----------------------------------------------------------------------";
30.20 -"----------- fun upd_envv ----------------------------------------------------------------------";
30.21 -"----------- fun upd_envv ----------------------------------------------------------------------";
30.22 -(* 14.9.01: not used after putting pre-penv into itm_
30.23 -fun upd_envv thy envv vats dsc id vl =
30.24 -
30.25 -THUS ..*)
30.26 -(*//------------------------------ wait for re-design of Specify ----------------------------\\* )
30.27 - val envv = [(1,[]:penv),(2,[]:penv),(3,[]:penv)]:envv;
30.28 -
30.29 - val vats = [2]
30.30 - val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"boundVariable b";
30.31 - val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"boundVariable v_";
30.32 - val envv = upd_envv thy envv vats dsc id vl;
30.33 -val envv = [(2,[(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")])])]
30.34 - : (int * (term * term list) list) list
30.35 -
30.36 - val vats = [1,2,3];
30.37 - val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"maximum A";
30.38 - val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"maximum m_";
30.39 - upd_envv thy envv vats dsc id vl;
30.40 -[(1,[(Free ("m_","bool"),[Free ("A","bool")])]),
30.41 - (2,
30.42 - [(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")]),
30.43 - (Free ("m_","bool"),[Free ("A","bool")])]),
30.44 - (3,[(Free ("m_","bool"),[Free ("A","bool")])])]
30.45 -: (int * (term * term list) list) list
30.46 -
30.47 -
30.48 - val env = []:envv;
30.49 - val (d,ts) = (split_dts o Thm.term_of o the o (parse thy))
30.50 - "fixedValues [r=Arbfix]";
30.51 - val (_,id) = (split_did o Thm.term_of o the o (parse thy))"fixedValues fix_";
30.52 - val vats = [1,2,3];
30.53 - val env = upd_envv thy env vats d id (mkval ts);
30.54 -( *\\------------------------------ wait for re-design of Specify ----------------------------//*)
30.55 \ No newline at end of file
31.1 --- a/test/Tools/isac/Specify/mstools.sml Fri Oct 25 16:07:15 2019 +0200
31.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
31.3 @@ -1,302 +0,0 @@
31.4 -(* Title: tests for Interpret/mstools.sml
31.5 - Author: Walther Neuper 100930, Mathias Lehnfeld
31.6 - (c) copyright due to lincense terms.
31.7 -*)
31.8 -"-----------------------------------------------------------------------------------------------";
31.9 -"table of contents -----------------------------------------------------------------------------";
31.10 -"-----------------------------------------------------------------------------------------------";
31.11 -"----------- go through Model_Problem until nxt_tac --------------------------------------------";
31.12 -"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
31.13 -"----------- type penv -------------------------------------------------------------------------";
31.14 -"----------- fun untouched ---------------------------------------------------------------------";
31.15 -"----------- fun pbl_ids -----------------------------------------------------------------------";
31.16 -"----------- fun upd_penv ----------------------------------------------------------------------";
31.17 -"----------- fun upd ---------------------------------------------------------------------------";
31.18 -"----------- fun upds_envv ---------------------------------------------------------------------";
31.19 -"----------- fun common_subthy -----------------------------------------------------------------";
31.20 -"--------------------------------------------------------";
31.21 -"--------------------------------------------------------";
31.22 -"--------------------------------------------------------";
31.23 -"--------------------------------------------------------";
31.24 -
31.25 -
31.26 -"----------- go through Model_Problem until nxt_tac --------------------------------------------";
31.27 -"----------- go through Model_Problem until nxt_tac --------------------------------------------";
31.28 -"----------- go through Model_Problem until nxt_tac --------------------------------------------";
31.29 -(*FIXME.WN110511 delete this test? (goes through "Model_Problem until nxt_tac)*)
31.30 -val fmz = ["equality (x+1=(2::real))", "solveFor x","solutions L"];
31.31 -val (dI',pI',mI') =
31.32 - ("Test", ["sqroot-test","univariate","equation","test"],
31.33 - ["Test","squ-equ-test-subpbl1"]);
31.34 -(*========== inhibit exn AK110725 ================================================
31.35 -(* ERROR: same as above, see lines 120- 123 *)
31.36 -val (p,_,f,nxt,_,pt) = CalcTreeTEST [(fmz, (dI',pI',mI'))];
31.37 -========== inhibit exn AK110725 ================================================*)
31.38 -
31.39 -(*========== inhibit exn AK110725 ================================================
31.40 -(* ERROR: p, nxt, pt not declared due to above error *)
31.41 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.42 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.43 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.44 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.45 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.46 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.47 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.48 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.49 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt;
31.50 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Subproblem",*)
31.51 -val (p,_,f,nxt,_,pt) = me nxt p [1] pt; (*nxt = ("Model_Problem",*)
31.52 -"~~~~~ fun me, args:"; val (_,tac) = nxt;
31.53 -val (pt, p) = case locatetac tac (pt,p) of
31.54 - ("ok", (_, _, ptp)) => ptp | _ => error "script.sml locatetac";
31.55 -"~~~~~ fun step, args:"; val (ip as (_,p_), (ptp as (pt,p), tacis)) = (p, ((pt, e_pos'), []))
31.56 -val pIopt = get_pblID (pt,ip);
31.57 -tacis; (*= []*)
31.58 -pIopt; (*= SOME ["sqroot-test", "univariate", ...]*)
31.59 -member op = [Pbl,Met] p_ andalso is_none (get_obj g_env pt (fst p)); (*= true*)
31.60 -"~~~~~ fun nxt_specify_, args:"; val (ptp as (pt, pos as (p,p_))) = (pt, ip);
31.61 -val pblobj as (PblObj{meth,origin=origin as (oris,(dI',pI',mI'),_),
31.62 - probl,spec=(dI,pI,mI),...}) = get_obj I pt p;
31.63 -just_created_ pblobj (*by Subproblem*) andalso origin <> e_origin; (*false=oldNB*)
31.64 -val cpI = if pI = e_pblID then pI' else pI;
31.65 - val cmI = if mI = e_metID then mI' else mI;
31.66 - val {ppc, prls, where_, ...} = get_pbt cpI;
31.67 - val pre = check_preconds "thy 100820" prls where_ probl;
31.68 - val pb = foldl and_ (true, map fst pre);
31.69 -val (_,tac) = nxt_spec p_ pb oris (dI',pI',mI') (probl, meth)
31.70 - (ppc, (#ppc o get_met) cmI) (dI, pI, mI); (*tac = Add_Given "equality (-1 + x = 0)"*)
31.71 -"~~~~~ fun nxt_specif, args:"; val (Add_Given ct, ptp) = (tac, ptp);
31.72 -"~~~~~ fun nxt_specif_additem, args:"; val (sel, ct, ptp as (pt, (p, Pbl))) = ("#Given", ct, ptp);
31.73 -val (PblObj{meth=met,origin=(oris,(dI',pI',_),_),
31.74 - probl=pbl,spec=(dI,pI,_),...}) = get_obj I pt p;
31.75 -val thy = if dI = e_domID then assoc_thy dI' else assoc_thy dI;
31.76 -val cpI = if pI = e_pblID then pI' else pI;
31.77 -val ctxt = get_ctxt pt (p, Pbl);
31.78 -"~~~~~ fun appl_add, args:"; val (ctxt, sel, oris, ppc, pbt, str) = (ctxt, sel, oris, pbl, ((#ppc o get_pbt) cpI), ct);
31.79 -val SOME t = parseNEW ctxt str;
31.80 -is_known ctxt sel oris t;
31.81 -"~~~~~ fun is_known, args:"; val (ctxt, sel, ori, t) = (ctxt, sel, oris, t);
31.82 -val _ = tracing ("RM is_known: t=" ^ term2str t);
31.83 -val ots = (distinct o flat o (map #5)) (ori:ori list);
31.84 -val oids = ((map (fst o dest_Free)) o distinct o flat o (map vars)) ots;
31.85 -val (d, ts) = split_dts t;
31.86 -"~~~~~ fun split_dts, args:"; val (t as d $ arg) = t;
31.87 -(*if is_dsc d then () else error "TODO";*)
31.88 -if is_dsc d then () else error "TODO";
31.89 -"----- these were the errors (call hierarchy from bottom up)";
31.90 -appl_add ctxt sel oris pbl ((#ppc o get_pbt) cpI) ct;(*WAS
31.91 -Err "[error] appl_add: is_known: identifiers [equality] not in example"*)
31.92 -nxt_specif_additem "#Given" ct ptp;(*WAS
31.93 -Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
31.94 -nxt_specif tac ptp;(*WAS
31.95 -Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
31.96 -nxt_specify_ (pt,ip); (*WAS
31.97 -Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
31.98 -(*val (p,_,f,nxt,_,pt) = me nxt p [1] pt; WAS
31.99 -Tac "[error] appl_add: is_known: identifiers [equality] not in example"*)
31.100 -========== inhibit exn AK110725 ================================================*)
31.101 -
31.102 -"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
31.103 -"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
31.104 -"----------- fun comp_dts -- fun split_dts -----------------------------------------------------";
31.105 -(*val t = str2term "maximum A";
31.106 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.107 -val it = "maximum A" : cterm
31.108 -> val t = str2term "fixedValues [r=Arbfix]";
31.109 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.110 -"fixedValues [r = Arbfix]"
31.111 -> val t = str2term "valuesFor [a]";
31.112 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.113 -"valuesFor [a]"
31.114 -> val t = str2term "valuesFor [a,b]";
31.115 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.116 -"valuesFor [a, b]"
31.117 -> val t = str2term "relations [A=a*b, (a/2)^^^2 + (b/2)^^^2 = r^^^2]";
31.118 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.119 -relations [A = a * b, (a / 2) ^^^ 2 + (b / 2) ^^^ 2 = r ^^^ 2]"
31.120 -> val t = str2term "boundVariable a";
31.121 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.122 -"boundVariable a"
31.123 -> val t = str2term "interval {x::real. 0 <= x & x <= 2*r}";
31.124 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.125 -"interval {x. 0 <= x & x <= 2 * r}"
31.126 -
31.127 -> val t = str2term "equality (sqrt(9+4*x)=sqrt x + sqrt(5+x))";
31.128 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.129 -"equality (sqrt (9 + 4 * x) = sqrt x + sqrt (5 + x))"
31.130 -> val t = str2term "solveFor x";
31.131 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.132 -"solveFor x"
31.133 -> val t = str2term "errorBound (eps=0)";
31.134 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.135 -"errorBound (eps = 0)"
31.136 -> val t = str2term "solutions L";
31.137 -> val (d,ts) = split_dts thy t; comp_dts thy (d,ts);
31.138 -"solutions L"
31.139 -
31.140 -before 6.5.03:
31.141 -> val t = (Thm.term_of o the o (parse thy)) "testdscforlist [#1]";
31.142 -> val (d,ts) = split_dts t;
31.143 -> comp_dts thy (d,ts);
31.144 -val it = "testdscforlist [#1]" : cterm
31.145 -
31.146 -> val t = (Thm.term_of o the o (parse thy)) "(A::real)";
31.147 -> val (d,ts) = split_dts t;
31.148 -val d = Const ("empty","empty") : term
31.149 -val ts = [Free ("A","RealDef.real")] : term list
31.150 -> val t = (Thm.term_of o the o (parse thy)) "[R=(R::real)]";
31.151 -> val (d,ts) = split_dts t;
31.152 -val d = Const ("empty","empty") : term
31.153 -val ts = [Const # $ Free # $ Free (#,#)] : term list
31.154 -> val t = (Thm.term_of o the o (parse thy)) "[#1,#2]";
31.155 -> val (d,ts) = split_dts t;
31.156 -val ts = [Free ("#1","'a"),Free ("#2","'a")] : NOT WANTED
31.157 -*)
31.158 -"----------- type penv -------------------------------------------------------------------------";
31.159 -"----------- type penv -------------------------------------------------------------------------";
31.160 -"----------- type penv -------------------------------------------------------------------------";
31.161 -(*
31.162 - val e_ = (Thm.term_of o the o (parse thy)) "e_::bool";
31.163 - val ev = (Thm.term_of o the o (parse thy)) "#4 + #3 * x^^^#2 = #0";
31.164 - val v_ = (Thm.term_of o the o (parse thy)) "v_";
31.165 - val vv = (Thm.term_of o the o (parse thy)) "x";
31.166 - val r_ = (Thm.term_of o the o (parse thy)) "err_::bool";
31.167 - val rv1 = (Thm.term_of o the o (parse thy)) "#0";
31.168 - val rv2 = (Thm.term_of o the o (parse thy)) "eps";
31.169 -
31.170 - val penv = [(e_,[ev]),(v_,[vv]),(r_,[rv2,rv2])]:penv;
31.171 - map getval penv;
31.172 -[(Free ("e_","bool"),
31.173 - Const (#,#) $ (# $ # $ (# $ #)) $ Free ("#0","RealDef.real")),
31.174 - (Free ("v_","RealDef.real"),Free ("x","RealDef.real")),
31.175 - (Free ("err_","bool"),Free ("#0","RealDef.real"))] : (term * term) list
31.176 -*)
31.177 -"----------- fun untouched ---------------------------------------------------------------------";
31.178 -"----------- fun untouched ---------------------------------------------------------------------";
31.179 -"----------- fun untouched ---------------------------------------------------------------------";
31.180 -(*> untouched [];
31.181 -val it = true : bool
31.182 -> untouched [e_itm];
31.183 -val it = true : bool
31.184 -> untouched [e_itm, (1,[],false,"e_itm",Syn "e_itm")];
31.185 -val it = false : bool*)
31.186 -"----------- fun pbl_ids -----------------------------------------------------------------------";
31.187 -"----------- fun pbl_ids -----------------------------------------------------------------------";
31.188 -"----------- fun pbl_ids -----------------------------------------------------------------------";
31.189 -(*
31.190 -val t as t1 $ t2 = str2term "antiDerivativeName M_b";
31.191 -pbl_ids ctxt t1 t2;
31.192 -
31.193 - val t = (Thm.term_of o the o (parse thy)) "fixedValues [r=Arbfix]";
31.194 - val (d,argl) = strip_comb t;
31.195 - is_dsc d; (*see split_dts*)
31.196 - dest_list (d,argl);
31.197 - val (_ $ v) = t;
31.198 - is_list v;
31.199 - pbl_ids ctxt d v;
31.200 -[Const ("List.list.Cons","[bool, bool List.list] => bool List.list") $
31.201 - (Const # $ Free # $ Const (#,#)) $ Const ("List.list.Nil","bool List..
31.202 -
31.203 - val (dsc,vl) = (split_dts o Thm.term_of o the o (parse thy)) "solveFor x";
31.204 -val dsc = Const ("Input_Descript.solveFor","RealDef.real => Tools.una") : term
31.205 -val vl = Free ("x","RealDef.real") : term
31.206 -
31.207 - val (dsc,id) = (split_did o Thm.term_of o the o (parse thy)) "solveFor v_";
31.208 - pbl_ids ctxt dsc vl;
31.209 -val it = [Free ("x","RealDef.real")] : term list
31.210 -
31.211 - val (dsc,vl) = (split_dts o Thm.term_of o the o(parse thy))
31.212 - "errorBound (eps=#0)";
31.213 - val (dsc,id) = (split_did o Thm.term_of o the o(parse thy)) "errorBound err_";
31.214 - pbl_ids ctxt dsc vl;
31.215 -val it = [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")] : term list *)
31.216 -"----------- fun upd_penv ----------------------------------------------------------------------";
31.217 -"----------- fun upd_penv ----------------------------------------------------------------------";
31.218 -"----------- fun upd_penv ----------------------------------------------------------------------";
31.219 -(*
31.220 - val penv = [];
31.221 - val (dsc,vl) = (split_did o Thm.term_of o the o (parse thy)) "solveFor x";
31.222 - val (dsc,id) = (split_did o Thm.term_of o the o (parse thy)) "solveFor v_";
31.223 - val penv = upd_penv thy penv dsc (id, vl);
31.224 -[(Free ("v_","RealDef.real"),
31.225 - [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")])]
31.226 -: (term * term list) list
31.227 -
31.228 - val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"errorBound (eps=#0)";
31.229 - val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"errorBound err_";
31.230 - upd_penv thy penv dsc (id, vl);
31.231 -[(Free ("v_","RealDef.real"),
31.232 - [Const (#,#) $ Free (#,#) $ Free ("#0","RealDef.real")]),
31.233 - (Free ("err_","bool"),
31.234 - [Free ("#0","RealDef.real"),Free ("eps","RealDef.real")])]
31.235 -: (term * term list) list ^.........!!!!
31.236 -*)
31.237 -"----------- fun upd ---------------------------------------------------------------------------";
31.238 -"----------- fun upd ---------------------------------------------------------------------------";
31.239 -"----------- fun upd ---------------------------------------------------------------------------";
31.240 -(*
31.241 - val i = 2;
31.242 - val envv = [(1,[]:penv),(2,[]:penv),(3,[]:penv)]:envv;
31.243 - val (dsc,vl) = (split_did o Thm.term_of o the o(parse thy))"boundVariable b";
31.244 - val (dsc,id) = (split_did o Thm.term_of o the o(parse thy))"boundVariable v_";
31.245 - upd thy envv dsc (id, vl) i;
31.246 -val it = (2,[(Free ("v_","RealDef.real"),[Free ("b","RealDef.real")])])
31.247 - : int * (term * term list) list*)
31.248 -
31.249 -"----------- fun upds_envv ---------------------------------------------------------------------";
31.250 -"----------- fun upds_envv ---------------------------------------------------------------------";
31.251 -"----------- fun upds_envv ---------------------------------------------------------------------";
31.252 -(* eval test-maximum.sml until Specify_Method ...
31.253 - val PblObj{probl=(_,pbl),origin=(_,(_,_,mI),_),...} = get_obj I pt [];
31.254 - val met = (#ppc o get_met) mI;
31.255 -
31.256 - val envv = [];
31.257 - val eargs = flat eargs;
31.258 - val (vs, dsc, id, vl) = hd eargs;
31.259 - val envv = upds_envv thy envv [(vs, dsc, id, vl)];
31.260 -
31.261 - val (vs, dsc, id, vl) = hd (tl eargs);
31.262 - val envv = upds_envv thy envv [(vs, dsc, id, vl)];
31.263 -
31.264 - val (vs, dsc, id, vl) = hd (tl (tl eargs));
31.265 - val envv = upds_envv thy envv [(vs, dsc, id, vl)];
31.266 -
31.267 - val (vs, dsc, id, vl) = hd (tl (tl (tl eargs)));
31.268 - val envv = upds_envv thy envv [(vs, dsc, id, vl)];
31.269 -[(1,
31.270 - [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
31.271 - (Free ("m_","bool"),[Free (#,#)]),
31.272 - (Free ("vs_","bool List.list"),[# $ # $ Const #]),
31.273 - (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
31.274 - (2,
31.275 - [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
31.276 - (Free ("m_","bool"),[Free (#,#)]),
31.277 - (Free ("vs_","bool List.list"),[# $ # $ Const #]),
31.278 - (Free ("rs_","bool List.list"),[# $ # $ (# $ #)])]),
31.279 - (3,
31.280 - [(Free ("fix_","bool List.list"),[Const (#,#),Free (#,#)]),
31.281 - (Free ("m_","bool"),[Free (#,#)]),
31.282 - (Free ("vs_","bool List.list"),[# $ # $ Const #])])] : envv *)
31.283 -
31.284 -"----------- fun common_subthy -----------------------------------------------------------------";
31.285 -"----------- fun common_subthy -----------------------------------------------------------------";
31.286 -"----------- fun common_subthy -----------------------------------------------------------------";
31.287 -val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory Inverse_Z_Transform});
31.288 -if Context.theory_name (common_subthy (thy1, thy2)) = "Inverse_Z_Transform"
31.289 -then () else error "common_subthy 1";
31.290 -
31.291 -val (thy1, thy2) = (@{theory Inverse_Z_Transform}, @{theory Partial_Fractions});(* Isac.Inverse_Z_Transform *)
31.292 -if Context.theory_name (common_subthy (thy1, thy2)) = "Inverse_Z_Transform"
31.293 -then () else error "common_subthy 2";
31.294 -
31.295 -val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory PolyEq});
31.296 -if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 3";
31.297 -
31.298 -val (thy1, thy2) = (@{theory Partial_Fractions}, @{theory Isac_Knowledge});
31.299 -if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 4";
31.300 -
31.301 -val (thy1, thy2) = (@{theory PolyEq}, @{theory Partial_Fractions});
31.302 -if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 5";
31.303 -
31.304 -val (thy1, thy2) = (@{theory Isac_Knowledge}, @{theory Partial_Fractions});
31.305 -if Context.theory_name (common_subthy (thy1, thy2)) = "Isac_Knowledge" then () else error "common_subthy 6";
32.1 --- a/test/Tools/isac/Specify/specification-elems.sml Fri Oct 25 16:07:15 2019 +0200
32.2 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000
32.3 @@ -1,62 +0,0 @@
32.4 -(* ~~/test/Tools/isac/Interpret/specification-elems.sml
32.5 - Author: Walther Neuper
32.6 - Use is subject to license terms.
32.7 -*)
32.8 -
32.9 -"-----------------------------------------------------------------------------";
32.10 -"-----------------------------------------------------------------------------";
32.11 -"table of contents -----------------------------------------------------------";
32.12 -"-----------------------------------------------------------------------------";
32.13 -"-------- fun subst_to_subst' ------------------------------------------------";
32.14 -"-------- fun subst'_to_sube -------------------------------------------------";
32.15 -"-------- fun subs2subst -----------------------------------------------------";
32.16 -"-------- fun subst'_to_subst ------------------------------------------------";
32.17 -"-------- fun subst2subs -----------------------------------------------------";
32.18 -"-----------------------------------------------------------------------------";
32.19 -"-----------------------------------------------------------------------------";
32.20 -
32.21 -"-------- fun subst_to_subst' ------------------------------------------------";
32.22 -"-------- fun subst_to_subst' ------------------------------------------------";
32.23 -"-------- fun subst_to_subst' ------------------------------------------------";
32.24 -val subst_rew =
32.25 - [(@{term "bdv_1 :: real"}, @{term "x :: real"}),
32.26 - (@{term "bdv_2 :: real"}, @{term "y :: real"}),
32.27 - (@{term "bdv_3 :: real"}, @{term "z :: real"})];
32.28 -if term2str (subst_to_subst' subst_rew) = "[(''bdv_1'', x), (''bdv_2'', y), (''bdv_3'', z)]"
32.29 -then () else error "subst_to_subst' changed"
32.30 -
32.31 -"-------- fun subst'_to_sube -------------------------------------------------";
32.32 -"-------- fun subst'_to_sube -------------------------------------------------";
32.33 -"-------- fun subst'_to_sube -------------------------------------------------";
32.34 -val subst_prog = @{term "[(''bdv_1'', x::real), (''bdv_2'', y::real), (''bdv_3'', z::real)]"};
32.35 -if Selem.subst'_to_sube subst_prog = ["(''bdv_1'', x)", "(''bdv_2'', y)", "(''bdv_3'', z)"] then ()
32.36 -else error "subst'_to_sube changed";
32.37 -
32.38 -"-------- fun subs2subst -----------------------------------------------------";
32.39 -"-------- fun subs2subst -----------------------------------------------------";
32.40 -"-------- fun subs2subst -----------------------------------------------------";
32.41 -case subs2subst @{theory} ["(''bdv_1'', x)", "(''bdv_2'', y)", "(''bdv_3'', z)"] of
32.42 - [(Free ("bdv_1", _), Free ("x", _)),
32.43 - (Free ("bdv_2", _), Free ("y", _)),
32.44 - (Free ("bdv_3", _), Free ("z", _))] => ()
32.45 -| _ => error "subs2subst changed";
32.46 -
32.47 -"-------- fun subst'_to_subst ------------------------------------------------";
32.48 -"-------- fun subst'_to_subst ------------------------------------------------";
32.49 -"-------- fun subst'_to_subst ------------------------------------------------";
32.50 -val t = @{term "[(''bdv_1'', x::real), (''bdv_2'', y::real), (''bdv_3'', z::real)]"};
32.51 -case subst'_to_subst t of
32.52 - [(Free ("bdv_1", _), Free ("x", _)),
32.53 - (Free ("bdv_2", _), Free ("y", _)),
32.54 - (Free ("bdv_3", _), Free ("z", _))] => ()
32.55 -| _ => error "subst'_to_subst changed";
32.56 -
32.57 -"-------- fun subst2subs -----------------------------------------------------";
32.58 -"-------- fun subst2subs -----------------------------------------------------";
32.59 -"-------- fun subst2subs -----------------------------------------------------";
32.60 -val subst_rew =
32.61 - [(@{term "bdv_1 :: real"}, @{term "x :: real"}),
32.62 - (@{term "bdv_2 :: real"}, @{term "y :: real"}),
32.63 - (@{term "bdv_3 :: real"}, @{term "z :: real"})];
32.64 -if subst2subs subst_rew = ["(''bdv_1'', x)", "(''bdv_2'', y)", "(''bdv_3'', z)"]then ()
32.65 -else error "subst2subs changed";
33.1 --- a/test/Tools/isac/Test_Isac.thy Fri Oct 25 16:07:15 2019 +0200
33.2 +++ b/test/Tools/isac/Test_Isac.thy Sat Oct 26 13:03:16 2019 +0200
33.3 @@ -131,8 +131,12 @@
33.4 \<close>
33.5
33.6 ML \<open>
33.7 -"~~~~~ fun xxx, args:"; val () = ();
33.8 -\<close> ML \<open>
33.9 +"~~~~~ fun xxx , args:"; val () = ();
33.10 +"~~~~~ and xxx , args:"; val () = ();
33.11 +"~~~~~ from xxx to yyy return val:"; val () = ();
33.12 +(*if*) (*then*); (*else*); (*case*) (*of*); (*return value*);
33.13 +"xx"
33.14 +^ "xxx" (*+*)
33.15 \<close> ML \<open>
33.16 \<close>
33.17
33.18 @@ -192,10 +196,11 @@
33.19 ML_file "Minisubpbl/799-complete.sml"
33.20
33.21 subsection \<open>further functionality alongside batch build sequence\<close>
33.22 - ML_file "Specify/model.sml"
33.23 - ML_file "Specify/mstools.sml"
33.24 - ML_file "Specify/specification-elems.sml"
33.25 - ML_file "Specify/ctree.sml" (*!...!see(25)*)
33.26 + ML_file "MathEngBasic/model.sml"
33.27 + ML_file "MathEngBasic/mstools.sml"
33.28 + ML_file "MathEngBasic/specification-elems.sml"
33.29 + ML_file "MathEngBasic/ctree.sml" (*!...!see(25)*)
33.30 +
33.31 ML_file "Specify/ptyps.sml" (* requires setup from ptyps.thy *)
33.32 ML \<open>(*check_unsynchronized_ref (); ==== trick on error: CUT AND PASTE THIS LINE =========*)\<close>
33.33 ML_file "Specify/generate.sml"
34.1 --- a/test/Tools/isac/Test_Isac_Short.thy Fri Oct 25 16:07:15 2019 +0200
34.2 +++ b/test/Tools/isac/Test_Isac_Short.thy Sat Oct 26 13:03:16 2019 +0200
34.3 @@ -196,10 +196,11 @@
34.4 ML_file "Minisubpbl/799-complete.sml"
34.5
34.6 subsection \<open>further functionality alongside batch build sequence\<close>
34.7 - ML_file "Specify/model.sml"
34.8 - ML_file "Specify/mstools.sml"
34.9 - ML_file "Specify/specification-elems.sml"
34.10 - ML_file "Specify/ctree.sml" (*!...!see(25)*)
34.11 + ML_file "MathEngBasic/model.sml"
34.12 + ML_file "MathEngBasic/mstools.sml"
34.13 + ML_file "MathEngBasic/specification-elems.sml"
34.14 + ML_file "MathEngBasic/ctree.sml" (*!...!see(25)*)
34.15 +
34.16 ML_file "Specify/ptyps.sml" (* requires setup from ptyps.thy *)
34.17 ML \<open>(*check_unsynchronized_ref (); ==== trick on error: CUT AND PASTE THIS LINE =========*)\<close>
34.18 ML_file "Specify/generate.sml"