Nominal/NewParser.thy
changeset 2338 e1764a73c292
parent 2337 b151399bd2c3
child 2339 1e0b3992189c
--- a/Nominal/NewParser.thy	Sun Jun 27 21:41:21 2010 +0100
+++ b/Nominal/NewParser.thy	Mon Jun 28 15:23:56 2010 +0100
@@ -72,21 +72,6 @@
 *}
 
 
-ML {* 
-(* exports back the results *)
-fun add_primrec_wrapper funs eqs lthy = 
-  if null funs then ([], [], lthy)
-  else 
-   let 
-     val eqs' = map (fn (_, eq) => (Attrib.empty_binding, eq)) eqs
-     val funs' = map (fn (bn, ty, mx) => (bn, SOME ty, mx)) funs
-     val ((funs'', eqs''), lthy') = Primrec.add_primrec funs' eqs' lthy
-     val phi = ProofContext.export_morphism lthy' lthy
-   in 
-     (map (Morphism.term phi) funs'', map (Morphism.thm phi) eqs'', lthy')
-   end
-*}
-
 ML {*
 fun add_datatype_wrapper dt_names dts =
 let
@@ -450,16 +435,25 @@
     else raise TEST lthy6
 
   val qtys = map #qtyp qty_infos
- 
+  val qconstr_descrs = 
+    flat (map (fn (_, _, _, cs) => map (fn (b, _, mx) => (Name.of_binding b, mx)) cs) dts)
+    |> map2 (fn t => fn (b, mx) => (b, t, mx)) all_raw_constrs
+
+  val (qconstrs, lthy8) = 
+    if get_STEPS lthy > 15
+    then qconst_defs qtys qconstr_descrs lthy7
+    else raise TEST lthy7
+
+  (* HERE *)
+
   val _ = tracing ("all_raw_tys: " ^ commas (map @{make_string} all_raw_tys))
   val _ = tracing ("constrs: " ^ commas (map @{make_string} all_raw_constrs))
   val _ = tracing ("qtys: " ^ commas (map @{make_string} qtys))
-  
+  val _ = tracing ("qconstrs " ^ commas (map @{make_string} qconstrs))
   
-
   val _ = 
-    if get_STEPS lthy > 15
-    then true else raise TEST lthy7
+    if get_STEPS lthy > 16
+    then true else raise TEST lthy8
   
   (* old stuff *)
 
@@ -470,7 +464,7 @@
         Const (cname, map (Datatype_Aux.typ_of_dtyp descr sorts) dts --->
           Datatype_Aux.typ_of_dtyp descr sorts (Datatype_Aux.DtRec i))) l) descr);
   val dd = map2 (fn x => fn y => (x, y, NoSyn)) const_names raw_consts
-  val (consts, const_defs, lthy8) = quotient_lift_consts_export qtys dd lthy7;
+  val (consts, _, lthy8) = quotient_lift_consts_export qtys dd lthy7;
   val _ = warning "Proving respects";
 
   val bn_nos = map (fn (_, i, _) => i) raw_bn_info;