Mercurial > urweb
comparison src/cjrize.sml @ 704:70cbdcf5989b
UNIQUE constraints
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 07 Apr 2009 12:24:31 -0400 |
parents | 500e93aa436f |
children | d8217b4cb617 |
comparison
equal
deleted
inserted
replaced
703:a5d8b470d7ca | 704:70cbdcf5989b |
---|---|
522 val (t, sm) = cifyTyp (t, sm) | 522 val (t, sm) = cifyTyp (t, sm) |
523 in | 523 in |
524 (NONE, SOME (ek, "/" ^ s, n, ts, t, L'.ServerAndPullAndPush), sm) | 524 (NONE, SOME (ek, "/" ^ s, n, ts, t, L'.ServerAndPullAndPush), sm) |
525 end | 525 end |
526 | 526 |
527 | L.DTable (s, xts) => | 527 | L.DTable (s, xts, e) => |
528 let | 528 let |
529 val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) => | 529 val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) => |
530 let | 530 let |
531 val (t, sm) = cifyTyp (t, sm) | 531 val (t, sm) = cifyTyp (t, sm) |
532 in | 532 in |
533 ((x, t), sm) | 533 ((x, t), sm) |
534 end) sm xts | 534 end) sm xts |
535 in | 535 |
536 (SOME (L'.DTable (s, xts), loc), NONE, sm) | 536 fun flatten e = |
537 case #1 e of | |
538 L.ERecord [] => [] | |
539 | L.ERecord [(x, (L.EPrim (Prim.String v), _), _)] => [(x, v)] | |
540 | L.EStrcat (e1, e2) => flatten e1 @ flatten e2 | |
541 | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined"; | |
542 Print.prefaces "Undetermined constraint" | |
543 [("e", MonoPrint.p_exp MonoEnv.empty e)]; | |
544 []) | |
545 in | |
546 (SOME (L'.DTable (s, xts, flatten e), loc), NONE, sm) | |
537 end | 547 end |
538 | L.DSequence s => | 548 | L.DSequence s => |
539 (SOME (L'.DSequence s, loc), NONE, sm) | 549 (SOME (L'.DSequence s, loc), NONE, sm) |
540 | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm) | 550 | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm) |
541 | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm) | 551 | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm) |