comparison src/lacweb.grm @ 234:82409ef72019

SELECTed expressions in ORDER BY
author Adam Chlipala <adamc@hcoop.net>
date Thu, 28 Aug 2008 11:49:38 -0400
parents c466678af854
children 0608a0cfd32a
comparison
equal deleted inserted replaced
233:c466678af854 234:82409ef72019
99 tabs 99 tabs
100 end 100 end
101 101
102 fun sql_inject (v, t, loc) = 102 fun sql_inject (v, t, loc) =
103 let 103 let
104 val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (v, loc)), loc) 104 val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (t, loc)), loc)
105 in 105 in
106 (EApp (e, (t, loc)), loc) 106 (EApp (e, (v, loc)), loc)
107 end 107 end
108 108
109 fun sql_compare (oper, sqlexp1, sqlexp2, loc) = 109 fun sql_compare (oper, sqlexp1, sqlexp2, loc) =
110 let 110 let
111 val e = (EVar (["Basis"], "sql_comparison"), loc) 111 val e = (EVar (["Basis"], "sql_comparison"), loc)
112 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc) 112 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc)
113 val e = (EApp (e, (EWild, loc)), loc)
113 val e = (EApp (e, sqlexp1), loc) 114 val e = (EApp (e, sqlexp1), loc)
114 val e = (EApp (e, sqlexp2), loc)
115 in 115 in
116 (EApp (e, (EWild, loc)), loc) 116 (EApp (e, sqlexp2), loc)
117 end 117 end
118 118
119 fun sql_binary (oper, sqlexp1, sqlexp2, loc) = 119 fun sql_binary (oper, sqlexp1, sqlexp2, loc) =
120 let 120 let
121 val e = (EVar (["Basis"], "sql_binary"), loc) 121 val e = (EVar (["Basis"], "sql_binary"), loc)
799 val e = (EVar (["Basis"], "sql_field"), loc) 799 val e = (EVar (["Basis"], "sql_field"), loc)
800 val e = (ECApp (e, tident), loc) 800 val e = (ECApp (e, tident), loc)
801 in 801 in
802 (ECApp (e, fident), loc) 802 (ECApp (e, fident), loc)
803 end) 803 end)
804 | CSYMBOL (let
805 val loc = s (CSYMBOLleft, CSYMBOLright)
806 val e = (EVar (["Basis"], "sql_exp"), loc)
807 in
808 (ECApp (e, (CName CSYMBOL, loc)), loc)
809 end)
804 810
805 | sqlexp EQ sqlexp (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 811 | sqlexp EQ sqlexp (sql_compare ("eq", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
806 | sqlexp NE sqlexp (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 812 | sqlexp NE sqlexp (sql_compare ("ne", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
807 | sqlexp LT sqlexp (sql_compare ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 813 | sqlexp LT sqlexp (sql_compare ("lt", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
808 | sqlexp LE sqlexp (sql_compare ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 814 | sqlexp LE sqlexp (sql_compare ("le", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
835 EVar (["Basis"], "sql_bool"), 841 EVar (["Basis"], "sql_bool"),
836 dummy)) 842 dummy))
837 | HAVING sqlexp (sqlexp) 843 | HAVING sqlexp (sqlexp)
838 844
839 obopt : (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), dummy), 845 obopt : (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), dummy),
840 (CWild (KRecord (KRecord (KType, dummy), dummy), dummy), dummy)), 846 (CWild (KRecord (KType, dummy), dummy), dummy)),
841 dummy) 847 dummy)
842 | ORDER BY obexps (obexps) 848 | ORDER BY obexps (obexps)
843 849
844 obexps : sqlexp (let 850 obexps : sqlexp (let
845 val loc = s (sqlexpleft, sqlexpright) 851 val loc = s (sqlexpleft, sqlexpright)
846 852
847 val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), loc), 853 val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), loc),
848 (CWild (KRecord (KRecord (KType, loc), loc), loc), loc)), 854 (CWild (KRecord (KType, loc), loc), loc)),
849 loc) 855 loc)
850 val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc), 856 val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc),
851 sqlexp), loc) 857 sqlexp), loc)
852 in 858 in
853 (EApp (e, e'), loc) 859 (EApp (e, e'), loc)