"isabelle make test" makes all major examples....they work up to supp theorems (excluding)
authorChristian Urban <urbanc@in.tum.de>
Fri, 27 Aug 2010 03:37:17 +0800
changeset 2440 0a36825b16c1
parent 2439 cc6e281d8f72
child 2441 fc3e8f79e698
"isabelle make test" makes all major examples....they work up to supp theorems (excluding)
IsaMakefile
Nominal/Ex/ExPS8.thy
Nominal/Ex/LF.thy
Nominal/Ex/Lambda.thy
Nominal/Ex/TypeVarsTest.thy
Nominal/NewParser.thy
Nominal/ROOT.ML
Nominal/nominal_dt_alpha.ML
--- a/IsaMakefile	Fri Aug 27 02:08:36 2010 +0800
+++ b/IsaMakefile	Fri Aug 27 03:37:17 2010 +0800
@@ -1,10 +1,10 @@
 
 ## targets
 
-default: Nominal2
+default: test
 images: 
 
-all: Nominal2 paper pearl pearl-jv qpaper
+all: test paper pearl pearl-jv qpaper
 
 
 ## global settings
@@ -18,7 +18,7 @@
 
 ## Nominal2
 
-Nominal2: $(LOG)/HOL-Nominal2.gz
+test: $(LOG)/HOL-Nominal2.gz
 
 $(LOG)/HOL-Nominal2.gz: Nominal/ROOT.ML Nominal/*.thy
 	@cd Nominal; $(USEDIR) -b -d "" HOL Nominal
--- a/Nominal/Ex/ExPS8.thy	Fri Aug 27 02:08:36 2010 +0800
+++ b/Nominal/Ex/ExPS8.thy	Fri Aug 27 03:37:17 2010 +0800
@@ -6,7 +6,7 @@
 
 atom_decl name
 
-declare [[STEPS = 15]]
+declare [[STEPS = 100]]
 
 nominal_datatype exp =
   EVar name
--- a/Nominal/Ex/LF.thy	Fri Aug 27 02:08:36 2010 +0800
+++ b/Nominal/Ex/LF.thy	Fri Aug 27 03:37:17 2010 +0800
@@ -2,7 +2,7 @@
 imports "../NewParser"
 begin
 
-declare [[STEPS = 20]]
+declare [[STEPS = 100]]
 
 atom_decl name
 atom_decl ident
--- a/Nominal/Ex/Lambda.thy	Fri Aug 27 02:08:36 2010 +0800
+++ b/Nominal/Ex/Lambda.thy	Fri Aug 27 03:37:17 2010 +0800
@@ -3,7 +3,7 @@
 begin
 
 atom_decl name
-declare [[STEPS = 21]]
+declare [[STEPS = 100]]
 
 nominal_datatype lam =
   Var "name"
--- a/Nominal/Ex/TypeVarsTest.thy	Fri Aug 27 02:08:36 2010 +0800
+++ b/Nominal/Ex/TypeVarsTest.thy	Fri Aug 27 03:37:17 2010 +0800
@@ -3,7 +3,7 @@
 begin
 
 atom_decl name
-declare [[STEPS = 21]]
+declare [[STEPS = 100]]
 
 class s1
 class s2
--- a/Nominal/NewParser.thy	Fri Aug 27 02:08:36 2010 +0800
+++ b/Nominal/NewParser.thy	Fri Aug 27 03:37:17 2010 +0800
@@ -434,7 +434,7 @@
 
   val alpha_bn_rsp = 
     if get_STEPS lthy > 20
-    then raw_alpha_bn_rsp alpha_bn_equivp_thms alpha_bn_imp_thms
+    then raw_alpha_bn_rsp alpha_bn_trms alpha_bn_equivp_thms alpha_bn_imp_thms
     else raise TEST lthy6 
 
   (* noting the quot_respects lemmas *)
--- a/Nominal/ROOT.ML	Fri Aug 27 02:08:36 2010 +0800
+++ b/Nominal/ROOT.ML	Fri Aug 27 03:37:17 2010 +0800
@@ -1,21 +1,19 @@
-quick_and_dirty := true;
 
-(*
+
 no_document use_thys
-   ["Ex/Lambda",
-    "Ex/LF",
-    "Ex/SingleLet",
-    "Ex/Ex1rec",
-    "Ex/Ex2",
-    "Ex/Ex3",
-    "Ex/ExLet",
-    "Ex/ExLetRec",
-    "Ex/TypeSchemes",
-    "Ex/Modules",
+   ["Ex/Classical",    
+    "Ex/CoreHaskell",
     "Ex/ExPS3",
     "Ex/ExPS7",
-    "Ex/CoreHaskell",
-    "Ex/Test"(*,
-    "Manual/Term4"*)
+    "Ex/ExPS8",
+    "Ex/LF",
+    "Ex/Lambda",
+    "Ex/Let",
+    "Ex/LetPat",
+    "Ex/LetRec",
+    "Ex/LetRec2",
+    "Ex/Modules",
+    "Ex/SingleLet",
+    "Ex/TypeSchemes",
+    "Ex/TypeVarsTest"
     ];
-*)
\ No newline at end of file
--- a/Nominal/nominal_dt_alpha.ML	Fri Aug 27 02:08:36 2010 +0800
+++ b/Nominal/nominal_dt_alpha.ML	Fri Aug 27 03:37:17 2010 +0800
@@ -29,7 +29,7 @@
     term list -> thm -> thm list -> Proof.context -> thm list
   val raw_size_rsp_aux: term list -> thm -> thm list -> Proof.context -> thm list
   val raw_constrs_rsp: term list -> term list -> thm list -> thm list -> Proof.context -> thm list
-  val raw_alpha_bn_rsp: thm list -> thm list -> thm list
+  val raw_alpha_bn_rsp: term list -> thm list -> thm list -> thm list
 
   val mk_funs_rsp: thm -> thm
   val mk_alpha_permute_rsp: thm -> thm 
@@ -703,12 +703,25 @@
   @{lemma "[|equivp Q; !!x y. R x y ==> Q x y|] ==> (R ===> R ===> op =) Q Q"
     by (simp only: fun_rel_def equivp_def, metis)}
 
-fun raw_alpha_bn_rsp alpha_bn_equivp alpha_bn_imps =
+
+(* we have to reorder the alpha_bn_imps theorems in order
+   to be in order with alpha_bn_trms *)
+fun raw_alpha_bn_rsp alpha_bn_trms alpha_bn_equivp alpha_bn_imps =
 let
+  fun mk_map thm =
+    thm |> `prop_of
+        |>> List.last  o snd o strip_comb
+        |>> HOLogic.dest_Trueprop
+        |>> head_of
+        |>> fst o dest_Const
+
+  val alpha_bn_imps' = 
+    map (lookup (map mk_map alpha_bn_imps) o fst o dest_Const) alpha_bn_trms
+
   fun mk_thm thm1 thm2 = 
     (forall_intr_vars thm2) COMP (thm1 RS rsp_equivp)
 in
-  map2 mk_thm alpha_bn_equivp alpha_bn_imps
+  map2 mk_thm alpha_bn_equivp alpha_bn_imps'
 end