comparison src/cjrize.sml @ 754:8688e01ae469

A view query works
author Adam Chlipala <adamc@hcoop.net>
date Tue, 28 Apr 2009 15:04:37 -0400
parents f7e2026dd5ae
children fa2019a63ea4
comparison
equal deleted inserted replaced
753:d484df4e841a 754:8688e01ae469
560 in 560 in
561 (SOME (L'.DTable (s, xts, pe, flatten ce), loc), NONE, sm) 561 (SOME (L'.DTable (s, xts, pe, flatten ce), loc), NONE, sm)
562 end 562 end
563 | L.DSequence s => 563 | L.DSequence s =>
564 (SOME (L'.DSequence s, loc), NONE, sm) 564 (SOME (L'.DSequence s, loc), NONE, sm)
565 | L.DView (s, xts, e) =>
566 let
567 val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) =>
568 let
569 val (t, sm) = cifyTyp (t, sm)
570 in
571 ((x, t), sm)
572 end) sm xts
573
574 fun flatten e =
575 case #1 e of
576 L.ERecord [] => []
577 | L.ERecord [(x, (L.EPrim (Prim.String v), _), _)] => [(x, v)]
578 | L.EStrcat (e1, e2) => flatten e1 @ flatten e2
579 | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined";
580 Print.prefaces "Undetermined constraint"
581 [("e", MonoPrint.p_exp MonoEnv.empty e)];
582 [])
583
584 val e = case #1 e of
585 L.EPrim (Prim.String s) => s
586 | _ => (ErrorMsg.errorAt loc "VIEW query has not been fully determined";
587 Print.prefaces "Undetermined VIEW query"
588 [("e", MonoPrint.p_exp MonoEnv.empty e)];
589 "")
590 in
591 (SOME (L'.DView (s, xts, e), loc), NONE, sm)
592 end
565 | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm) 593 | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm)
566 | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm) 594 | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm)
567 | L.DCookie args => (SOME (L'.DCookie args, loc), NONE, sm) 595 | L.DCookie args => (SOME (L'.DCookie args, loc), NONE, sm)
568 | L.DStyle args => (SOME (L'.DStyle args, loc), NONE, sm) 596 | L.DStyle args => (SOME (L'.DStyle args, loc), NONE, sm)
569 597