Mercurial > urweb

comparison src/monoize.sml @ 186:88d46972de53

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
bool in Basis
author Adam Chlipala <adamc@hcoop.net>
date Sun, 03 Aug 2008 18:53:20 -0400
parents 19ee24bffbc0
children 8e9f97508f0d
comparison
equal deleted inserted replaced
185:19ee24bffbc0 186:88d46972de53
284 284
285 fun setRadioGroup (t : t, x) = {radioGroup = SOME x} 285 fun setRadioGroup (t : t, x) = {radioGroup = SOME x}
286 286
287 end 287 end
288 288
289 fun monoPatCon pc = 289 fun monoPatCon env pc =
290 case pc of 290 case pc of
291 L.PConVar n => L'.PConVar n 291 L.PConVar n => L'.PConVar n
292 | L.PConFfi mx => L'.PConFfi mx 292 | L.PConFfi {mod = m, datatyp, con, arg} => L'.PConFfi {mod = m, datatyp = datatyp, con = con,
293 arg = Option.map (monoType env) arg}
293 294
294 fun monoPat env (p, loc) = 295 fun monoPat env (p, loc) =
295 case p of 296 case p of
296 L.PWild => (L'.PWild, loc) 297 L.PWild => (L'.PWild, loc)
297 | L.PVar (x, t) => (L'.PVar (x, monoType env t), loc) 298 | L.PVar (x, t) => (L'.PVar (x, monoType env t), loc)
298 | L.PPrim p => (L'.PPrim p, loc) 299 | L.PPrim p => (L'.PPrim p, loc)
299 | L.PCon (pc, po) => (L'.PCon (monoPatCon pc, Option.map (monoPat env) po), loc) 300 | L.PCon (pc, po) => (L'.PCon (monoPatCon env pc, Option.map (monoPat env) po), loc)
300 | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc) 301 | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc)
301 302
302 fun monoExp (env, st, fm) (all as (e, loc)) = 303 fun monoExp (env, st, fm) (all as (e, loc)) =
303 let 304 let
304 fun poly () = 305 fun poly () =
320 val (e, fm) = monoExp (env, st, fm) e 321 val (e, fm) = monoExp (env, st, fm) e
321 in 322 in
322 (SOME e, fm) 323 (SOME e, fm)
323 end 324 end
324 in 325 in
325 ((L'.ECon (monoPatCon pc, eo), loc), fm) 326 ((L'.ECon (monoPatCon env pc, eo), loc), fm)
326 end 327 end
327 | L.EFfi mx => ((L'.EFfi mx, loc), fm) 328 | L.EFfi mx => ((L'.EFfi mx, loc), fm)
328 | L.EFfiApp (m, x, es) => 329 | L.EFfiApp (m, x, es) =>
329 let 330 let
330 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es 331 val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es