Mercurial > urweb
comparison src/cjrize.sml @ 101:717b6f8d8505
First executable generated
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 10 Jul 2008 11:13:49 -0400 |
parents | 4f641f8fddaa |
children | 5f04adf47f48 |
comparison
equal
deleted
inserted
replaced
100:f0f59e918cac | 101:717b6f8d8505 |
---|---|
163 L.DVal (x, n, t, e) => | 163 L.DVal (x, n, t, e) => |
164 let | 164 let |
165 val (t, sm) = cifyTyp (t, sm) | 165 val (t, sm) = cifyTyp (t, sm) |
166 val (e, sm) = cifyExp (e, sm) | 166 val (e, sm) = cifyExp (e, sm) |
167 in | 167 in |
168 ((L'.DVal (x, n, t, e), loc), sm) | 168 (SOME (L'.DVal (x, n, t, e), loc), NONE, sm) |
169 end | 169 end |
170 | L.DFun (n, x, dom, ran, e) => | 170 | L.DFun (n, x, dom, ran, e) => |
171 let | 171 let |
172 val (dom, sm) = cifyTyp (dom, sm) | 172 val (dom, sm) = cifyTyp (dom, sm) |
173 val (ran, sm) = cifyTyp (ran, sm) | 173 val (ran, sm) = cifyTyp (ran, sm) |
174 val (e, sm) = cifyExp (e, sm) | 174 val (e, sm) = cifyExp (e, sm) |
175 in | 175 in |
176 ((L'.DFun (n, x, dom, ran, e), loc), sm) | 176 (SOME (L'.DFun (n, x, dom, ran, e), loc), NONE, sm) |
177 end | |
178 | L.DPage (xts, e) => | |
179 let | |
180 val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) => | |
181 let | |
182 val (t, sm) = cifyTyp (t, sm) | |
183 in | |
184 ((x, t), sm) | |
185 end) | |
186 sm xts | |
187 val (e, sm) = cifyExp (e, sm) | |
188 in | |
189 (NONE, SOME (xts, e), sm) | |
177 end | 190 end |
178 | 191 |
179 fun cjrize ds = | 192 fun cjrize ds = |
180 let | 193 let |
181 val (ds, sm) = ListUtil.foldlMap cifyDecl Sm.empty ds | 194 val (ds, ps, sm) = foldl (fn (d, (ds, ps, sm)) => |
195 let | |
196 val (dop, pop, sm) = cifyDecl (d, sm) | |
197 val ds = case dop of | |
198 NONE => ds | |
199 | SOME d => d :: ds | |
200 val ps = case pop of | |
201 NONE => ps | |
202 | SOME p => p :: ps | |
203 in | |
204 (ds, ps, sm) | |
205 end) | |
206 ([], [], Sm.empty) ds | |
182 in | 207 in |
183 List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm), | 208 (List.revAppend (map (fn v => (L'.DStruct v, ErrorMsg.dummySpan)) (Sm.declares sm), |
184 ds) | 209 rev ds), |
210 ps) | |
185 end | 211 end |
186 | 212 |
187 end | 213 end |