Mercurial > urweb

comparison src/monoize.sml @ 1655:b694f9153faa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Adapt Monoize serialization to handle freshly created variant types
author Adam Chlipala <adam@chlipala.net>
date Mon, 02 Jan 2012 16:54:18 -0500
parents dfc854e478bb
children 0577be31a435
comparison
equal deleted inserted replaced
1654:570636457047 1655:b694f9153faa
529 529
530 | L'.TDatatype (i, ref (dk, _)) => 530 | L'.TDatatype (i, ref (dk, _)) =>
531 let 531 let
532 fun makeDecl n fm = 532 fun makeDecl n fm =
533 let 533 let
534 val (x, _, xncs) = Env.lookupDatatype env i 534 val (x, xncs) =
535 case ListUtil.search (fn (L'.DDatatype [(x, i', xncs)], _) =>
536 if i' = i then
537 SOME (x, xncs)
538 else
539 NONE
540 | _ => NONE) (!pvarDefs) of
541 NONE =>
542 let
543 val (x, _, xncs) = Env.lookupDatatype env i
544 in
545 (x, map (fn (x, n, c) => (x, n, Option.map (monoType env) c)) xncs)
546 end
547 | SOME v => v
535 548
536 val (branches, fm) = 549 val (branches, fm) =
537 ListUtil.foldlMap 550 ListUtil.foldlMap
538 (fn ((x, n, to), fm) => 551 (fn ((x, n, to), fm) =>
539 case to of 552 case to of
541 (((L'.PCon (dk, L'.PConVar n, NONE), loc), 554 (((L'.PCon (dk, L'.PConVar n, NONE), loc),
542 (L'.EPrim (Prim.String x), loc)), 555 (L'.EPrim (Prim.String x), loc)),
543 fm) 556 fm)
544 | SOME t => 557 | SOME t =>
545 let 558 let
546 val t = monoType env t
547 val (arg, fm) = fooify fm ((L'.ERel 0, loc), t) 559 val (arg, fm) = fooify fm ((L'.ERel 0, loc), t)
548 in 560 in
549 (((L'.PCon (dk, L'.PConVar n, SOME (L'.PVar ("a", t), loc)), loc), 561 (((L'.PCon (dk, L'.PConVar n, SOME (L'.PVar ("a", t), loc)), loc),
550 (L'.EStrcat ((L'.EPrim (Prim.String (x ^ "/")), loc), 562 (L'.EStrcat ((L'.EPrim (Prim.String (x ^ "/")), loc),
551 arg), loc)), 563 arg), loc)),