Nominal/nominal_dt_rawfuns.ML
changeset 2464 f4eba60cbd69
parent 2438 abafea9b39bb
child 2476 8f8652a8107f
--- a/Nominal/nominal_dt_rawfuns.ML	Fri Sep 03 20:53:09 2010 +0800
+++ b/Nominal/nominal_dt_rawfuns.ML	Fri Sep 03 22:22:43 2010 +0800
@@ -151,7 +151,7 @@
 
 (** functions that construct the equations for fv and fv_bn **)
 
-fun mk_fv_rhs lthy fv_map fv_bn_map args (BC (_, binders, bodies)) =
+fun mk_fv_rhs lthy fv_map fv_bn_map args (BC (bmode, binders, bodies)) =
 let
   fun mk_fv_body fv_map args i = 
   let
@@ -163,21 +163,33 @@
     | SOME fv => fv $ arg
   end  
 
-  fun mk_fv_binder lthy fv_bn_map args (bn_option, i) = 
+  fun mk_fv_binder lthy fv_bn_map args binders = 
   let
-    val arg = nth args i
+    fun bind_set lthy args (NONE, i) = (setify lthy (nth args i), @{term "{}::atom set"})
+      | bind_set _ args (SOME bn, i) = (bn $ (nth args i), 
+          if  member (op=) bodies i then @{term "{}::atom set"}  
+          else lookup fv_bn_map bn $ (nth args i))
+    fun bind_lst lthy args (NONE, i) = (listify lthy (nth args i), @{term "[]::atom list"})
+      | bind_lst _ args (SOME bn, i) = (bn $ (nth args i),
+          if  member (op=) bodies i then @{term "[]::atom list"}  
+          else lookup fv_bn_map bn $ (nth args i)) 
+  
+    val (combine_fn, bind_fn) =
+      case bmode of
+        Lst => (fold_append, bind_lst) 
+      | Set => (fold_union, bind_set)
+      | Res => (fold_union, bind_set)
   in
-    case bn_option of
-      NONE => (setify lthy arg, @{term "{}::atom set"})
-    | SOME bn => (to_set (bn $ arg), 
-       if  member (op=) bodies i then @{term "{}::atom set"}  
-       else lookup fv_bn_map bn $ arg)
+    binders
+    |> map (bind_fn lthy args)
+    |> split_list
+    |> pairself combine_fn
   end  
 
   val t1 = map (mk_fv_body fv_map args) bodies
-  val (t2, t3) = split_list (map (mk_fv_binder lthy fv_bn_map args) binders)
+  val (t2, t3) = mk_fv_binder lthy fv_bn_map args binders
 in 
-  fold_union (mk_diff (fold_union t1, fold_union t2)::t3)
+  mk_union (mk_diff (fold_union t1, to_set t2), to_set t3)
 end
 
 (* in case of fv_bn we have to treat the case special, where an