ProgTutorial/Parsing.thy
changeset 322 2b7c08d90e2e
parent 321 e450fa467e3f
child 324 4172c0743cf2
--- a/ProgTutorial/Parsing.thy	Sat Aug 22 02:56:08 2009 +0200
+++ b/ProgTutorial/Parsing.thy	Tue Aug 25 00:07:37 2009 +0200
@@ -1089,8 +1089,131 @@
 apply(rule TrueI)
 done
 
+(*
+ML {*
+structure TacticData = ProofDataFun
+(
+  type T = thm list -> tactic;
+  fun init _ = undefined;
+);
+
+val set_tactic = TacticData.put;
+*}
+
+ML {*
+  TacticData.get @{context}
+*}
+
+ML {* Method.set_tactic  *}
+ML {* fun tactic (facts: thm list) : tactic = (atac 1) *}
+ML {* Context.map_proof *}
+ML {* ML_Context.expression *}
+ML {* METHOD *}
+
+
+ML {* 
+fun myexpression pos bind body txt =
+let
+  val _ = tracing ("bind)" ^ bind)
+  val _ = tracing ("body)" ^ body)
+  val _ = tracing ("txt)"  ^ txt)
+  val _ = tracing ("result) " ^ "Context.set_thread_data (SOME (let " ^ bind ^ " = " ^ txt ^ " in " ^ body ^
+      " end (ML_Context.the_generic_context ())));")
+in
+  ML_Context.exec (fn () => ML_Context.eval false pos
+    ("Context.set_thread_data (SOME (let " ^ bind ^ " = " ^ txt ^ " in " ^ body ^
+      " end (ML_Context.the_generic_context ())));"))
+end
+*}
 
 
+ML {*
+fun ml_tactic (txt, pos) ctxt =
+let
+  val ctxt' = ctxt |> Context.proof_map
+      (myexpression pos
+        "fun tactic (facts: thm list) : tactic"
+        "Context.map_proof (Method.set_tactic tactic)" txt);
+in 
+  Context.setmp_thread_data (SOME (Context.Proof ctxt)) (TacticData.get ctxt')
+end;
+*}
+
+ML {*
+fun tactic3 (txt, pos) ctxt = 
+  let
+    val _ = tracing ("1) " ^ txt )
+  in 
+   METHOD (ml_tactic (txt, pos) ctxt; K (atac 1))
+  end
+*}
+
+setup {*
+Method.setup (Binding.name "tactic3") (Scan.lift (OuterParse.position Args.name) 
+  >> tactic3)
+    "ML tactic as proof method"
+*}
+
+lemma "A \<Longrightarrow> A"
+apply(tactic3 {* (atac 1)  *})
+done
+
+ML {* 
+(ML_Context.the_generic_context ())
+*}
+
+ML {*
+Context.set_thread_data;
+ML_Context.the_generic_context
+*}
+
+lemma "A \<Longrightarrow> A"
+ML_prf {*
+Context.set_thread_data (SOME (let fun tactic (facts: thm list) : tactic =  (atac 1)   in Context.map_proof (Method.set_tactic tactic) end (ML_Context.the_generic_context ())));
+*}
+
+ML {*
+Context.set_thread_data (SOME ((let fun tactic (facts: thm list) : tactic =  (atac 1)   in 3 end) (ML_Context.the_generic_context ())));
+*}
+
+ML {*
+Context.set_thread_data (SOME (let 
+  fun tactic (facts: thm list) : tactic =  (atac 1) 
+in 
+  Context.map_proof (Method.set_tactic tactic) 
+end 
+  (ML_Context.the_generic_context ())));
+*}
+
+
+ML {*
+let 
+  fun tactic (facts: thm list) : tactic = atac
+in
+  Context.map_proof (Method.set_tactic tactic)
+end *}
+
+end *}
+
+ML {* Toplevel.program (fn () => 
+(ML_Context.expression Position.none "val plus : int" "3 + 4" "1" (Context.Proof @{context})))*}
+
+
+ML {*
+fun ml_tactic (txt, pos) ctxt =
+  let
+    val ctxt' = ctxt |> Context.proof_map
+      (ML_Context.expression pos
+        "fun tactic (facts: thm list) : tactic"
+        "Context.map_proof (Method.set_tactic tactic)" txt);
+  in Context.setmp_thread_data (SOME (Context.Proof ctxt)) (TacticData.get ctxt') end;
+
+*}
+
+ML {*
+Context.set_thread_data (SOME (let fun tactic (facts: thm list) : tactic =  (atac 1)   in Context.map_proof (Method.set_tactic tactic) end (ML_Context.the_generic_context ())));
+*}
+*)
 
 section {* Methods (TBD) *}