Mercurial > urweb
diff 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 |
line wrap: on
line diff
--- a/src/cjrize.sml Tue Apr 28 14:02:23 2009 -0400 +++ b/src/cjrize.sml Tue Apr 28 15:04:37 2009 -0400 @@ -562,6 +562,34 @@ end | L.DSequence s => (SOME (L'.DSequence s, loc), NONE, sm) + | L.DView (s, xts, e) => + let + val (xts, sm) = ListUtil.foldlMap (fn ((x, t), sm) => + let + val (t, sm) = cifyTyp (t, sm) + in + ((x, t), sm) + end) sm xts + + fun flatten e = + case #1 e of + L.ERecord [] => [] + | L.ERecord [(x, (L.EPrim (Prim.String v), _), _)] => [(x, v)] + | L.EStrcat (e1, e2) => flatten e1 @ flatten e2 + | _ => (ErrorMsg.errorAt loc "Constraint has not been fully determined"; + Print.prefaces "Undetermined constraint" + [("e", MonoPrint.p_exp MonoEnv.empty e)]; + []) + + val e = case #1 e of + L.EPrim (Prim.String s) => s + | _ => (ErrorMsg.errorAt loc "VIEW query has not been fully determined"; + Print.prefaces "Undetermined VIEW query" + [("e", MonoPrint.p_exp MonoEnv.empty e)]; + "") + in + (SOME (L'.DView (s, xts, e), loc), NONE, sm) + end | L.DDatabase s => (SOME (L'.DDatabase s, loc), NONE, sm) | L.DJavaScript s => (SOME (L'.DJavaScript s, loc), NONE, sm) | L.DCookie args => (SOME (L'.DCookie args, loc), NONE, sm)