Mercurial > urweb
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 |