Mercurial > urweb
comparison src/monoize.sml @ 1655:b694f9153faa
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)), |