From 462c9d472ebe1a585e3bddb103a3f7cf1cdc64e5 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 17 Jul 2008 10:38:03 -0400 Subject: Tagging (non-mutual) 'val rec' --- src/tag.sml | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) (limited to 'src/tag.sml') diff --git a/src/tag.sml b/src/tag.sml index 301e0977..1a7e93ca 100644 --- a/src/tag.sml +++ b/src/tag.sml @@ -147,16 +147,21 @@ fun tag file = 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 @@ fun tag file = (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 -- cgit v1.2.3