Nominal/Parser.thy
changeset 1941 d33781f9d2c7
parent 1913 39951d71bfce
child 1946 3395e87d94b8
--- a/Nominal/Parser.thy	Fri Apr 23 11:12:38 2010 +0200
+++ b/Nominal/Parser.thy	Sat Apr 24 09:49:23 2010 +0200
@@ -625,9 +625,14 @@
     map_index (prep_typ binds) annos
   end
 
+  val result = map (map (map (map (fn (a, b, c) => 
+    (a, b, c, if !alpha_type=AlphaLst andalso a = NONE then AlphaGen else !alpha_type)))))
+      (map (map prep_binds) (extract_annos_binds (get_cnstrs dt_strs)))
+ 
+  val _ = warning (@{make_string} result)
+
 in
-  map (map (map (map (fn (a, b, c) => (a, b, c, if !alpha_type=AlphaLst andalso a = NONE then AlphaGen else !alpha_type)))))
-  (map (map prep_binds) (extract_annos_binds (get_cnstrs dt_strs)))
+  result
 end
 *}
 
@@ -660,6 +665,51 @@
 end
 *}
 
+atom_decl name
+
+nominal_datatype exp =
+  EVar name
+| EUnit
+| EPair exp exp
+| ELetRec l::lrbs e::exp     bind "b_lrbs l" in e
+
+and fnclause =
+  K x::name p::pat f::exp    bind "b_pat p" in f 
+
+and fnclauses =
+  S fnclause
+| ORs fnclause fnclauses
+
+and lrb =
+  Clause fnclauses
+
+and lrbs =
+  Single lrb
+| More lrb lrbs
+
+and pat =
+  PVar name
+| PUnit
+| PPair pat pat
+
+binder
+  b_lrbs      :: "lrbs \<Rightarrow> atom set" and
+  b_pat       :: "pat \<Rightarrow> atom set" and
+  b_fnclauses :: "fnclauses \<Rightarrow> atom set" and
+  b_fnclause  :: "fnclause \<Rightarrow> atom set" and
+  b_lrb       :: "lrb \<Rightarrow> atom set"
+
+where
+  "b_lrbs (Single l) = b_lrb l"
+| "b_lrbs (More l ls) = b_lrb l \<union> b_lrbs ls"
+| "b_pat (PVar x) = {atom x}"
+| "b_pat (PUnit) = {}"
+| "b_pat (PPair p1 p2) = b_pat p1 \<union> b_pat p2"
+| "b_fnclauses (S fc) = (b_fnclause fc)"
+| "b_fnclauses (ORs fc fcs) = (b_fnclause fc) \<union> (b_fnclauses fcs)"
+| "b_lrb (Clause fcs) = (b_fnclauses fcs)"
+| "b_fnclause (K x pat exp) = {atom x}"
+
 
 end