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