Nominal/NewParser.thy
changeset 2339 1e0b3992189c
parent 2338 e1764a73c292
child 2346 4c5881455923
--- a/Nominal/NewParser.thy	Mon Jun 28 15:23:56 2010 +0100
+++ b/Nominal/NewParser.thy	Mon Jun 28 16:22:28 2010 +0100
@@ -425,8 +425,8 @@
   (* defining the quotient type *)
   val _ = warning "Declaring the quotient types"
   val qty_descr = map (fn (vs, bind, mx, _) => (vs, bind, mx)) dts
-  val qty_binds = map (fn (_, bind, _, _) => bind) dts            (* not used *)
-  val qty_names = map Name.of_binding qty_binds;                  (* not used *)
+  val qty_binds = map (fn (_, bind, _, _) => bind) dts        
+  val qty_names = map Name.of_binding qty_binds;              
   val qty_full_names = map (Long_Name.qualify thy_name) qty_names (* not used *)
   
   val (qty_infos, lthy7) = 
@@ -435,21 +435,28 @@
     else raise TEST lthy6
 
   val qtys = map #qtyp qty_infos
-  val qconstr_descrs = 
+  
+  (* defining of quotient term-constructors, binding functions, free vars functions *)
+  val qconstr_descr = 
     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) = 
+  val qbns_descr =
+    map2 (fn (b, _, mx) => fn t => (Name.of_binding b, t, mx)) bn_funs raw_bn_funs
+
+  val qfvs_descr = 
+    map2 (fn n => fn t => (n, t, NoSyn)) qty_names raw_fvs
+
+
+  val (qs, lthy8) = 
     if get_STEPS lthy > 15
-    then qconst_defs qtys qconstr_descrs lthy7
+    then qconst_defs qtys (qconstr_descr @ qbns_descr @ qfvs_descr) lthy7
     else raise TEST lthy7
 
+  val _ = tracing ("raw fvs  " ^ commas (map @{make_string} raw_fvs))
+  val _ = tracing ("raw fv_bns  " ^ commas (map @{make_string} raw_fv_bns))
+
   (* 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 > 16
@@ -498,7 +505,7 @@
       in constr_rsp_tac alpha_eq_iff (fv_rsp @ bns_rsp @ alpha_refl_thms @ alpha_alphabn) 1 end
   val (const_rsps, lthy12) = fold_map (fn cnst => prove_const_rsp qtys Binding.empty [cnst]
     const_rsp_tac) raw_consts lthy11a
-    val qfv_names = map (unsuffix "_raw" o Long_Name.base_name o fst o dest_Const) (raw_fvs @ raw_fv_bns)
+  val qfv_names = map (unsuffix "_raw" o Long_Name.base_name o fst o dest_Const) (raw_fvs @ raw_fv_bns)
   val dd = map2 (fn x => fn y => (x, y, NoSyn)) qfv_names (raw_fvs @ raw_fv_bns)
   val (qfv_ts, qfv_defs, lthy12a) = quotient_lift_consts_export qtys dd lthy12;
   val (qfv_ts_nobn, qfv_ts_bn) = chop (length raw_perm_funs) qfv_ts;