comparison 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
comparison
equal deleted inserted replaced
125:fd98dd10dce7 126:76a4d69719d8
145 NONE => ([d], (env, count, tags, byTag)) 145 NONE => ([d], (env, count, tags, byTag))
146 | SOME n' => ([], (env, count, tags, byTag)) 146 | SOME n' => ([], (env, count, tags, byTag))
147 end 147 end
148 | _ => 148 | _ =>
149 let 149 let
150 val env' = E.declBinds env d
151 val env'' = case d' of
152 DValRec _ => env'
153 | _ => env
154
150 val (d, (count, tags, byTag, newTags)) = 155 val (d, (count, tags, byTag, newTags)) =
151 U.Decl.foldMap {kind = kind, 156 U.Decl.foldMap {kind = kind,
152 con = con, 157 con = con,
153 exp = exp env, 158 exp = exp env'',
154 decl = decl} 159 decl = decl}
155 (count, tags, byTag, []) d 160 (count, tags, byTag, []) d
156 161
157 val env = E.declBinds env d 162 val env = env'
158 163
159 val newDs = ListUtil.mapConcat 164 val newDs = map
160 (fn (f, cn) => 165 (fn (f, cn) =>
161 let 166 let
162 fun unravel (all as (t, _)) = 167 fun unravel (all as (t, _)) =
163 case t of 168 case t of
164 TFun (dom, ran) => 169 TFun (dom, ran) =>
200 (body, 0, unit) args 205 (body, 0, unit) args
201 in 206 in
202 (abs, t) 207 (abs, t)
203 end 208 end
204 in 209 in
205 [(DVal ("wrap_" ^ fnam, cn, t, abs, tag), loc), 210 (("wrap_" ^ fnam, cn, t, abs, tag),
206 (DExport cn, loc)] 211 (DExport cn, loc))
207 end) newTags 212 end) newTags
213
214 val (newVals, newExports) = ListPair.unzip newDs
215
216 val ds = case d of
217 (DValRec vis, _) => [(DValRec (vis @ newVals), loc)]
218 | _ => map (fn vi => (DVal vi, loc)) newVals @ [d]
208 in 219 in
209 (newDs @ [d], (env, count, tags, byTag)) 220 (ds @ newExports, (env, count, tags, byTag))
210 end 221 end
211 222
212 val (file, _) = ListUtil.foldlMapConcat doDecl (CoreEnv.empty, count+1, IM.empty, SM.empty) file 223 val (file, _) = ListUtil.foldlMapConcat doDecl (CoreEnv.empty, count+1, IM.empty, SM.empty) file
213 in 224 in
214 file 225 file