diff src/tag.sml @ 126:76a4d69719d8

Tagging (non-mutual) 'val rec'
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Jul 2008 10:38:03 -0400
parents fd98dd10dce7
children f214c535d253
line wrap: on
line diff
--- a/src/tag.sml	Thu Jul 17 10:23:04 2008 -0400
+++ b/src/tag.sml	Thu Jul 17 10:38:03 2008 -0400
@@ -147,16 +147,21 @@
                 end
               | _ =>
                 let
+                    val env' = E.declBinds env d
+                    val env'' = case d' of
+                                    DValRec _ => env'
+                                  | _ => env
+
                     val (d, (count, tags, byTag, newTags)) =
                         U.Decl.foldMap {kind = kind,
                                         con = con,
-                                        exp = exp env,
+                                        exp = exp env'',
                                         decl = decl}
                                        (count, tags, byTag, []) d
 
-                    val env = E.declBinds env d
+                    val env = env'
 
-                    val newDs = ListUtil.mapConcat
+                    val newDs = map
                                     (fn (f, cn) =>
                                         let
                                             fun unravel (all as (t, _)) =
@@ -202,11 +207,17 @@
                                                         (abs, t)
                                                     end
                                         in
-                                            [(DVal ("wrap_" ^ fnam, cn, t, abs, tag), loc),
-                                             (DExport cn, loc)]
+                                            (("wrap_" ^ fnam, cn, t, abs, tag),
+                                             (DExport cn, loc))
                                         end) newTags
+
+                    val (newVals, newExports) = ListPair.unzip newDs
+
+                    val ds = case d of
+                                 (DValRec vis, _) => [(DValRec (vis @ newVals), loc)]
+                               | _ => map (fn vi => (DVal vi, loc)) newVals @ [d]
                 in
-                    (newDs @ [d], (env, count, tags, byTag))
+                    (ds @ newExports, (env, count, tags, byTag))
                 end
 
         val (file, _) = ListUtil.foldlMapConcat doDecl (CoreEnv.empty, count+1, IM.empty, SM.empty) file