Mercurial > urweb
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