Mercurial > urweb

comparison src/urweb.grm @ 403:8084fa9216de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
New implicit argument handling
author Adam Chlipala <adamc@hcoop.net>
date Tue, 21 Oct 2008 16:41:11 -0400
parents fe8f75f7e130
children c471345f5165
comparison
equal deleted inserted replaced
402:ebf27030ae3b 403:8084fa9216de
114 ErrorMsg.errorAt loc "Select of field from unbound table"; 114 ErrorMsg.errorAt loc "Select of field from unbound table";
115 115
116 tabs 116 tabs
117 end 117 end
118 118
119 fun sql_inject (v, t, loc) = 119 fun sql_inject (v, loc) =
120 let 120 (EApp ((EVar (["Basis"], "sql_inject", Infer), loc), (v, loc)), loc)
121 val e = (EApp ((EVar (["Basis"], "sql_inject"), loc), (t, loc)), loc)
122 in
123 (EApp (e, (v, loc)), loc)
124 end
125 121
126 fun sql_compare (oper, sqlexp1, sqlexp2, loc) = 122 fun sql_compare (oper, sqlexp1, sqlexp2, loc) =
127 let 123 let
128 val e = (EVar (["Basis"], "sql_comparison"), loc) 124 val e = (EVar (["Basis"], "sql_comparison", Infer), loc)
129 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc) 125 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
130 val e = (EApp (e, sqlexp1), loc) 126 val e = (EApp (e, sqlexp1), loc)
131 in 127 in
132 (EApp (e, sqlexp2), loc) 128 (EApp (e, sqlexp2), loc)
133 end 129 end
134 130
135 fun sql_binary (oper, sqlexp1, sqlexp2, loc) = 131 fun sql_binary (oper, sqlexp1, sqlexp2, loc) =
136 let 132 let
137 val e = (EVar (["Basis"], "sql_binary"), loc) 133 val e = (EVar (["Basis"], "sql_binary", Infer), loc)
138 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc) 134 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
139 val e = (EApp (e, sqlexp1), loc) 135 val e = (EApp (e, sqlexp1), loc)
140 in 136 in
141 (EApp (e, sqlexp2), loc) 137 (EApp (e, sqlexp2), loc)
142 end 138 end
143 139
144 fun sql_unary (oper, sqlexp, loc) = 140 fun sql_unary (oper, sqlexp, loc) =
145 let 141 let
146 val e = (EVar (["Basis"], "sql_unary"), loc) 142 val e = (EVar (["Basis"], "sql_unary", Infer), loc)
147 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc) 143 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
148 in 144 in
149 (EApp (e, sqlexp), loc) 145 (EApp (e, sqlexp), loc)
150 end 146 end
151 147
152 fun sql_relop (oper, sqlexp1, sqlexp2, loc) = 148 fun sql_relop (oper, sqlexp1, sqlexp2, loc) =
153 let 149 let
154 val e = (EVar (["Basis"], "sql_relop"), loc) 150 val e = (EVar (["Basis"], "sql_relop", Infer), loc)
155 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper), loc)), loc) 151 val e = (EApp (e, (EVar (["Basis"], "sql_" ^ oper, Infer), loc)), loc)
156 val e = (EApp (e, sqlexp1), loc) 152 val e = (EApp (e, sqlexp1), loc)
157 in 153 in
158 (EApp (e, sqlexp2), loc) 154 (EApp (e, sqlexp2), loc)
159 end 155 end
160 156
161 fun native_unop (oper, e1, loc) = 157 fun native_unop (oper, e1, loc) =
162 let 158 let
163 val e = (EVar (["Basis"], oper), loc) 159 val e = (EVar (["Basis"], oper, Infer), loc)
164 val e = (EApp (e, (EWild, loc)), loc)
165 in 160 in
166 (EApp (e, e1), loc) 161 (EApp (e, e1), loc)
167 end 162 end
168 163
169 fun native_op (oper, e1, e2, loc) = 164 fun native_op (oper, e1, e2, loc) =
170 let 165 let
171 val e = (EVar (["Basis"], oper), loc) 166 val e = (EVar (["Basis"], oper, Infer), loc)
172 val e = (EApp (e, (EWild, loc)), loc)
173 val e = (EApp (e, e1), loc) 167 val e = (EApp (e, e1), loc)
174 in 168 in
175 (EApp (e, e2), loc) 169 (EApp (e, e2), loc)
176 end 170 end
177 171
189 EOF 183 EOF
190 | STRING of string | INT of Int64.int | FLOAT of Real64.real 184 | STRING of string | INT of Int64.int | FLOAT of Real64.real
191 | SYMBOL of string | CSYMBOL of string 185 | SYMBOL of string | CSYMBOL of string
192 | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE 186 | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
193 | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR 187 | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH | UNDER | UNDERUNDER | BAR
194 | PLUS | MINUS | DIVIDE | DOTDOTDOT | MOD 188 | PLUS | MINUS | DIVIDE | DOTDOTDOT | MOD | AT
195 | CON | LTYPE | VAL | REC | AND | FUN | FOLD | UNIT | KUNIT | CLASS 189 | CON | LTYPE | VAL | REC | AND | FUN | FOLD | UNIT | KUNIT | CLASS
196 | DATATYPE | OF 190 | DATATYPE | OF
197 | TYPE | NAME 191 | TYPE | NAME
198 | ARROW | LARROW | DARROW | STAR | SEMI 192 | ARROW | LARROW | DARROW | STAR | SEMI
199 | FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE 193 | FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE
674 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2), 668 (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2),
675 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc) 669 ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc)
676 end) 670 end)
677 | SYMBOL LARROW eexp SEMI eexp (let 671 | SYMBOL LARROW eexp SEMI eexp (let
678 val loc = s (SYMBOLleft, eexp2right) 672 val loc = s (SYMBOLleft, eexp2right)
679 val e = (EVar (["Basis"], "bind"), loc) 673 val e = (EVar (["Basis"], "bind", Infer), loc)
680 val e = (EApp (e, eexp1), loc) 674 val e = (EApp (e, eexp1), loc)
681 in 675 in
682 (EApp (e, (EAbs (SYMBOL, NONE, eexp2), loc)), loc) 676 (EApp (e, (EAbs (SYMBOL, NONE, eexp2), loc)), loc)
683 end) 677 end)
684 | UNIT LARROW eexp SEMI eexp (let 678 | UNIT LARROW eexp SEMI eexp (let
685 val loc = s (UNITleft, eexp2right) 679 val loc = s (UNITleft, eexp2right)
686 val e = (EVar (["Basis"], "bind"), loc) 680 val e = (EVar (["Basis"], "bind", Infer), loc)
687 val e = (EApp (e, eexp1), loc) 681 val e = (EApp (e, eexp1), loc)
688 val t = (TRecord (CRecord [], loc), loc) 682 val t = (TRecord (CRecord [], loc), loc)
689 in 683 in
690 (EApp (e, (EAbs ("_", SOME t, eexp2), loc)), loc) 684 (EApp (e, (EAbs ("_", SOME t, eexp2), loc)), loc)
691 end) 685 end)
802 (ERecord (ListUtil.mapi (fn (i, e) => 796 (ERecord (ListUtil.mapi (fn (i, e) =>
803 ((CName (Int.toString (i + 1)), loc), 797 ((CName (Int.toString (i + 1)), loc),
804 e)) etuple), loc) 798 e)) etuple), loc)
805 end) 799 end)
806 800
807 | path (EVar path, s (pathleft, pathright)) 801 | path (EVar (#1 path, #2 path, Infer), s (pathleft, pathright))
808 | cpath (EVar cpath, s (cpathleft, cpathright)) 802 | cpath (EVar (#1 cpath, #2 cpath, Infer), s (cpathleft, cpathright))
803 | AT path (EVar (#1 path, #2 path, TypesOnly), s (ATleft, pathright))
804 | AT AT path (EVar (#1 path, #2 path, DontInfer), s (AT1left, pathright))
805 | AT cpath (EVar (#1 cpath, #2 cpath, TypesOnly), s (ATleft, cpathright))
806 | AT AT cpath (EVar (#1 cpath, #2 cpath, DontInfer), s (AT1left, cpathright))
809 | LBRACE rexp RBRACE (ERecord rexp, s (LBRACEleft, RBRACEright)) 807 | LBRACE rexp RBRACE (ERecord rexp, s (LBRACEleft, RBRACEright))
810 | UNIT (ERecord [], s (UNITleft, UNITright)) 808 | UNIT (ERecord [], s (UNITleft, UNITright))
811 809
812 | INT (EPrim (Prim.Int INT), s (INTleft, INTright)) 810 | INT (EPrim (Prim.Int INT), s (INTleft, INTright))
813 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) 811 | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright))
816 | path DOT idents (let 814 | path DOT idents (let
817 val loc = s (pathleft, identsright) 815 val loc = s (pathleft, identsright)
818 in 816 in
819 foldl (fn (ident, e) => 817 foldl (fn (ident, e) =>
820 (EField (e, ident), loc)) 818 (EField (e, ident), loc))
821 (EVar path, s (pathleft, pathright)) idents 819 (EVar (#1 path, #2 path, Infer), s (pathleft, pathright)) idents
820 end)
821 | AT path DOT idents (let
822 val loc = s (ATleft, identsright)
823 in
824 foldl (fn (ident, e) =>
825 (EField (e, ident), loc))
826 (EVar (#1 path, #2 path, TypesOnly), s (pathleft, pathright)) idents
827 end)
828 | AT AT path DOT idents (let
829 val loc = s (AT1left, identsright)
830 in
831 foldl (fn (ident, e) =>
832 (EField (e, ident), loc))
833 (EVar (#1 path, #2 path, DontInfer), s (pathleft, pathright)) idents
822 end) 834 end)
823 | FOLD (EFold, s (FOLDleft, FOLDright)) 835 | FOLD (EFold, s (FOLDleft, FOLDright))
824 836
825 | XML_BEGIN xml XML_END (let 837 | XML_BEGIN xml XML_END (let
826 val loc = s (XML_BEGINleft, XML_ENDright) 838 val loc = s (XML_BEGINleft, XML_ENDright)
836 in 848 in
837 if XML_BEGIN = "xml" then 849 if XML_BEGIN = "xml" then
838 () 850 ()
839 else 851 else
840 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; 852 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
841 (EApp ((EVar (["Basis"], "cdata"), loc), 853 (EApp ((EVar (["Basis"], "cdata", Infer), loc),
842 (EPrim (Prim.String ""), loc)), 854 (EPrim (Prim.String ""), loc)),
843 loc) 855 loc)
844 end) 856 end)
845 | XML_BEGIN_END (let 857 | XML_BEGIN_END (let
846 val loc = s (XML_BEGIN_ENDleft, XML_BEGIN_ENDright) 858 val loc = s (XML_BEGIN_ENDleft, XML_BEGIN_ENDright)
847 in 859 in
848 if XML_BEGIN_END = "xml" then 860 if XML_BEGIN_END = "xml" then
849 () 861 ()
850 else 862 else
851 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; 863 ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\".";
852 (EApp ((EVar (["Basis"], "cdata"), loc), 864 (EApp ((EVar (["Basis"], "cdata", Infer), loc),
853 (EPrim (Prim.String ""), loc)), 865 (EPrim (Prim.String ""), loc)),
854 loc) 866 loc)
855 end) 867 end)
856 868
857 | LPAREN query RPAREN (query) 869 | LPAREN query RPAREN (query)
860 872
861 | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN 873 | LPAREN INSERT INTO texp LPAREN fields RPAREN VALUES LPAREN sqlexps RPAREN RPAREN
862 (let 874 (let
863 val loc = s (LPAREN1left, RPAREN3right) 875 val loc = s (LPAREN1left, RPAREN3right)
864 876
865 val e = (EVar (["Basis"], "insert"), loc) 877 val e = (EVar (["Basis"], "insert", Infer), loc)
866 val e = (EApp (e, texp), loc) 878 val e = (EApp (e, texp), loc)
867 in 879 in
868 if length fields <> length sqlexps then 880 if length fields <> length sqlexps then
869 ErrorMsg.errorAt loc "Length mismatch in INSERT field specification" 881 ErrorMsg.errorAt loc "Length mismatch in INSERT field specification"
870 else 882 else
873 end) 885 end)
874 | LPAREN enterDml UPDATE texp SET fsets CWHERE sqlexp leaveDml RPAREN 886 | LPAREN enterDml UPDATE texp SET fsets CWHERE sqlexp leaveDml RPAREN
875 (let 887 (let
876 val loc = s (LPARENleft, RPARENright) 888 val loc = s (LPARENleft, RPARENright)
877 889
878 val e = (EVar (["Basis"], "update"), loc) 890 val e = (EVar (["Basis"], "update", Infer), loc)
879 val e = (ECApp (e, (CWild (KRecord (KType, loc), loc), loc)), loc) 891 val e = (ECApp (e, (CWild (KRecord (KType, loc), loc), loc)), loc)
880 val e = (EApp (e, (ERecord fsets, loc)), loc) 892 val e = (EApp (e, (ERecord fsets, loc)), loc)
881 val e = (EApp (e, texp), loc) 893 val e = (EApp (e, texp), loc)
882 in 894 in
883 (EApp (e, sqlexp), loc) 895 (EApp (e, sqlexp), loc)
884 end) 896 end)
885 | LPAREN enterDml DELETE FROM texp CWHERE sqlexp leaveDml RPAREN 897 | LPAREN enterDml DELETE FROM texp CWHERE sqlexp leaveDml RPAREN
886 (let 898 (let
887 val loc = s (LPARENleft, RPARENright) 899 val loc = s (LPARENleft, RPARENright)
888 900
889 val e = (EVar (["Basis"], "delete"), loc) 901 val e = (EVar (["Basis"], "delete", Infer), loc)
890 val e = (EApp (e, texp), loc) 902 val e = (EApp (e, texp), loc)
891 in 903 in
892 (EApp (e, sqlexp), loc) 904 (EApp (e, sqlexp), loc)
893 end) 905 end)
894 906
895 | UNDER (EWild, s (UNDERleft, UNDERright)) 907 | UNDER (EWild, s (UNDERleft, UNDERright))
896 908
897 enterDml : (inDml := true) 909 enterDml : (inDml := true)
898 leaveDml : (inDml := false) 910 leaveDml : (inDml := false)
899 911
900 texp : SYMBOL (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright)) 912 texp : SYMBOL (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright))
901 | LBRACE LBRACE eexp RBRACE RBRACE (eexp) 913 | LBRACE LBRACE eexp RBRACE RBRACE (eexp)
902 914
903 fields : fident ([fident]) 915 fields : fident ([fident])
904 | fident COMMA fields (fident :: fields) 916 | fident COMMA fields (fident :: fields)
905 917
951 963
952 xml : xmlOne xml (let 964 xml : xmlOne xml (let
953 val pos = s (xmlOneleft, xmlright) 965 val pos = s (xmlOneleft, xmlright)
954 in 966 in
955 (EApp ((EApp ( 967 (EApp ((EApp (
956 (EVar (["Basis"], "join"), pos), 968 (EVar (["Basis"], "join", Infer), pos),
957 xmlOne), pos), 969 xmlOne), pos),
958 xml), pos) 970 xml), pos)
959 end) 971 end)
960 | xmlOne (xmlOne) 972 | xmlOne (xmlOne)
961 973
962 xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata"), s (NOTAGSleft, NOTAGSright)), 974 xmlOne : NOTAGS (EApp ((EVar (["Basis"], "cdata", Infer), s (NOTAGSleft, NOTAGSright)),
963 (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))), 975 (EPrim (Prim.String NOTAGS), s (NOTAGSleft, NOTAGSright))),
964 s (NOTAGSleft, NOTAGSright)) 976 s (NOTAGSleft, NOTAGSright))
965 | tag DIVIDE GT (let 977 | tag DIVIDE GT (let
966 val pos = s (tagleft, GTright) 978 val pos = s (tagleft, GTright)
967 in 979 in
968 (EApp (#2 tag, 980 (EApp (#2 tag,
969 (EApp ((EVar (["Basis"], "cdata"), pos), 981 (EApp ((EVar (["Basis"], "cdata", Infer), pos),
970 (EPrim (Prim.String ""), pos)), 982 (EPrim (Prim.String ""), pos)),
971 pos)), pos) 983 pos)), pos)
972 end) 984 end)
973 985
974 | tag GT xml END_TAG (let 986 | tag GT xml END_TAG (let
975 val pos = s (tagleft, GTright) 987 val pos = s (tagleft, GTright)
976 val et = tagIn END_TAG 988 val et = tagIn END_TAG
977 in 989 in
978 if #1 tag = et then 990 if #1 tag = et then
979 if et = "form" then 991 if et = "form" then
980 (EApp ((EVar (["Basis"], "form"), pos), 992 (EApp ((EVar (["Basis"], "form", Infer), pos),
981 xml), pos) 993 xml), pos)
982 else 994 else
983 (EApp (#2 tag, xml), pos) 995 (EApp (#2 tag, xml), pos)
984 else 996 else
985 (if ErrorMsg.anyErrors () then 997 (if ErrorMsg.anyErrors () then
989 (EFold, pos)) 1001 (EFold, pos))
990 end) 1002 end)
991 | LBRACE eexp RBRACE (eexp) 1003 | LBRACE eexp RBRACE (eexp)
992 | LBRACE LBRACK eexp RBRACK RBRACE (let 1004 | LBRACE LBRACK eexp RBRACK RBRACE (let
993 val loc = s (LBRACEleft, RBRACEright) 1005 val loc = s (LBRACEleft, RBRACEright)
994 val e = (EVar (["Top"], "txt"), loc) 1006 val e = (EVar (["Top"], "txt", Infer), loc)
995 val e = (EApp (e, (EWild, loc)), loc)
996 in 1007 in
997 (EApp (e, eexp), loc) 1008 (EApp (e, eexp), loc)
998 end) 1009 end)
999 1010
1000 tag : tagHead attrs (let 1011 tag : tagHead attrs (let
1001 val pos = s (tagHeadleft, attrsright) 1012 val pos = s (tagHeadleft, attrsright)
1002 in 1013 in
1003 (#1 tagHead, 1014 (#1 tagHead,
1004 (EApp ((EApp ((EVar (["Basis"], "tag"), pos), 1015 (EApp ((EApp ((EVar (["Basis"], "tag", Infer), pos),
1005 (ERecord attrs, pos)), pos), 1016 (ERecord attrs, pos)), pos),
1006 (EApp (#2 tagHead, 1017 (EApp (#2 tagHead,
1007 (ERecord [], pos)), pos)), 1018 (ERecord [], pos)), pos)),
1008 pos)) 1019 pos))
1009 end) 1020 end)
1011 tagHead: BEGIN_TAG (let 1022 tagHead: BEGIN_TAG (let
1012 val bt = tagIn BEGIN_TAG 1023 val bt = tagIn BEGIN_TAG
1013 val pos = s (BEGIN_TAGleft, BEGIN_TAGright) 1024 val pos = s (BEGIN_TAGleft, BEGIN_TAGright)
1014 in 1025 in
1015 (bt, 1026 (bt,
1016 (EVar ([], bt), pos)) 1027 (EVar ([], bt, Infer), pos))
1017 end) 1028 end)
1018 | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright))) 1029 | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright)))
1019 1030
1020 attrs : ([]) 1031 attrs : ([])
1021 | attr attrs (attr :: attrs) 1032 | attr attrs (attr :: attrs)
1037 ((CName "Limit", loc), 1048 ((CName "Limit", loc),
1038 lopt), 1049 lopt),
1039 ((CName "Offset", loc), 1050 ((CName "Offset", loc),
1040 ofopt)], loc) 1051 ofopt)], loc)
1041 in 1052 in
1042 (EApp ((EVar (["Basis"], "sql_query"), loc), re), loc) 1053 (EApp ((EVar (["Basis"], "sql_query", Infer), loc), re), loc)
1043 end) 1054 end)
1044 1055
1045 query1 : SELECT select FROM tables wopt gopt hopt 1056 query1 : SELECT select FROM tables wopt gopt hopt
1046 (let 1057 (let
1047 val loc = s (SELECTleft, tablesright) 1058 val loc = s (SELECTleft, tablesright)
1067 end 1078 end
1068 1079
1069 val sel = (CRecord sel, loc) 1080 val sel = (CRecord sel, loc)
1070 1081
1071 val grp = case gopt of 1082 val grp = case gopt of
1072 NONE => (ECApp ((EVar (["Basis"], "sql_subset_all"), loc), 1083 NONE => (ECApp ((EVar (["Basis"], "sql_subset_all",
1084 Infer), loc),
1073 (CWild (KRecord (KRecord (KType, loc), loc), 1085 (CWild (KRecord (KRecord (KType, loc), loc),
1074 loc), loc)), loc) 1086 loc), loc)), loc)
1075 | SOME gis => 1087 | SOME gis =>
1076 let 1088 let
1077 val tabs = map (fn (nm, _) => 1089 val tabs = map (fn (nm, _) =>
1083 (CTuple [c, 1095 (CTuple [c,
1084 (CWild (KRecord (KType, loc), 1096 (CWild (KRecord (KType, loc),
1085 loc), 1097 loc),
1086 loc)], loc))) tabs 1098 loc)], loc))) tabs
1087 in 1099 in
1088 (ECApp ((EVar (["Basis"], "sql_subset"), loc), 1100 (ECApp ((EVar (["Basis"], "sql_subset", Infer), loc),
1089 (CRecord tabs, loc)), loc) 1101 (CRecord tabs, loc)), loc)
1090 end 1102 end
1091 1103
1092 val e = (EVar (["Basis"], "sql_query1"), loc) 1104 val e = (EVar (["Basis"], "sql_query1", Infer), loc)
1093 val re = (ERecord [((CName "From", loc), 1105 val re = (ERecord [((CName "From", loc),
1094 (ERecord tables, loc)), 1106 (ERecord tables, loc)),
1095 ((CName "Where", loc), 1107 ((CName "Where", loc),
1096 wopt), 1108 wopt),
1097 ((CName "GroupBy", loc), 1109 ((CName "GroupBy", loc),
1098 grp), 1110 grp),
1099 ((CName "Having", loc), 1111 ((CName "Having", loc),
1100 hopt), 1112 hopt),
1101 ((CName "SelectFields", loc), 1113 ((CName "SelectFields", loc),
1102 (ECApp ((EVar (["Basis"], "sql_subset"), loc), 1114 (ECApp ((EVar (["Basis"], "sql_subset", Infer), loc),
1103 sel), loc)), 1115 sel), loc)),
1104 ((CName "SelectExps", loc), 1116 ((CName "SelectExps", loc),
1105 (ERecord exps, loc))], loc) 1117 (ERecord exps, loc))], loc)
1106 1118
1107 val e = (EApp (e, re), loc) 1119 val e = (EApp (e, re), loc)
1117 1129
1118 tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) 1130 tname : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
1119 | LBRACE cexp RBRACE (cexp) 1131 | LBRACE cexp RBRACE (cexp)
1120 1132
1121 table : SYMBOL ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)), 1133 table : SYMBOL ((CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)),
1122 (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright))) 1134 (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
1123 | SYMBOL AS tname (tname, (EVar ([], SYMBOL), s (SYMBOLleft, SYMBOLright))) 1135 | SYMBOL AS tname (tname, (EVar ([], SYMBOL, Infer), s (SYMBOLleft, SYMBOLright)))
1124 | LBRACE LBRACE eexp RBRACE RBRACE AS tname (tname, eexp) 1136 | LBRACE LBRACE eexp RBRACE RBRACE AS tname (tname, eexp)
1125 1137
1126 tident : SYMBOL (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright)) 1138 tident : SYMBOL (CName (capitalize SYMBOL), s (SYMBOLleft, SYMBOLright))
1127 | CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) 1139 | CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
1128 | LBRACE LBRACE cexp RBRACE RBRACE (cexp) 1140 | LBRACE LBRACE cexp RBRACE RBRACE (cexp)
1138 | seli COMMA selis (seli :: selis) 1150 | seli COMMA selis (seli :: selis)
1139 1151
1140 select : STAR (Star) 1152 select : STAR (Star)
1141 | selis (Items selis) 1153 | selis (Items selis)
1142 1154
1143 sqlexp : TRUE (sql_inject (EVar (["Basis"], "True"), 1155 sqlexp : TRUE (sql_inject (EVar (["Basis"], "True", Infer),
1144 EVar (["Basis"], "sql_bool"),
1145 s (TRUEleft, TRUEright))) 1156 s (TRUEleft, TRUEright)))
1146 | FALSE (sql_inject (EVar (["Basis"], "False"), 1157 | FALSE (sql_inject (EVar (["Basis"], "False", Infer),
1147 EVar (["Basis"], "sql_bool"),
1148 s (FALSEleft, FALSEright))) 1158 s (FALSEleft, FALSEright)))
1149 1159
1150 | INT (sql_inject (EPrim (Prim.Int INT), 1160 | INT (sql_inject (EPrim (Prim.Int INT),
1151 EVar (["Basis"], "sql_int"),
1152 s (INTleft, INTright))) 1161 s (INTleft, INTright)))
1153 | FLOAT (sql_inject (EPrim (Prim.Float FLOAT), 1162 | FLOAT (sql_inject (EPrim (Prim.Float FLOAT),
1154 EVar (["Basis"], "sql_float"),
1155 s (FLOATleft, FLOATright))) 1163 s (FLOATleft, FLOATright)))
1156 | STRING (sql_inject (EPrim (Prim.String STRING), 1164 | STRING (sql_inject (EPrim (Prim.String STRING),
1157 EVar (["Basis"], "sql_string"),
1158 s (STRINGleft, STRINGright))) 1165 s (STRINGleft, STRINGright)))
1159 1166
1160 | tident DOT fident (let 1167 | tident DOT fident (let
1161 val loc = s (tidentleft, fidentright) 1168 val loc = s (tidentleft, fidentright)
1162 val e = (EVar (["Basis"], "sql_field"), loc) 1169 val e = (EVar (["Basis"], "sql_field", Infer), loc)
1163 val e = (ECApp (e, tident), loc) 1170 val e = (ECApp (e, tident), loc)
1164 in 1171 in
1165 (ECApp (e, fident), loc) 1172 (ECApp (e, fident), loc)
1166 end) 1173 end)
1167 | CSYMBOL (let 1174 | CSYMBOL (let
1168 val loc = s (CSYMBOLleft, CSYMBOLright) 1175 val loc = s (CSYMBOLleft, CSYMBOLright)
1169 in 1176 in
1170 if !inDml then 1177 if !inDml then
1171 let 1178 let
1172 val e = (EVar (["Basis"], "sql_field"), loc) 1179 val e = (EVar (["Basis"], "sql_field", Infer), loc)
1173 val e = (ECApp (e, (CName "T", loc)), loc) 1180 val e = (ECApp (e, (CName "T", loc)), loc)
1174 in 1181 in
1175 (ECApp (e, (CName CSYMBOL, loc)), loc) 1182 (ECApp (e, (CName CSYMBOL, loc)), loc)
1176 end 1183 end
1177 else 1184 else
1178 let 1185 let
1179 val e = (EVar (["Basis"], "sql_exp"), loc) 1186 val e = (EVar (["Basis"], "sql_exp", Infer), loc)
1180 in 1187 in
1181 (ECApp (e, (CName CSYMBOL, loc)), loc) 1188 (ECApp (e, (CName CSYMBOL, loc)), loc)
1182 end 1189 end
1183 end) 1190 end)
1184 1191
1192 | sqlexp CAND sqlexp (sql_binary ("and", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1199 | sqlexp CAND sqlexp (sql_binary ("and", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1193 | sqlexp OR sqlexp (sql_binary ("or", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right))) 1200 | sqlexp OR sqlexp (sql_binary ("or", sqlexp1, sqlexp2, s (sqlexp1left, sqlexp2right)))
1194 | NOT sqlexp (sql_unary ("not", sqlexp, s (NOTleft, sqlexpright))) 1201 | NOT sqlexp (sql_unary ("not", sqlexp, s (NOTleft, sqlexpright)))
1195 1202
1196 | LBRACE eexp RBRACE (sql_inject (#1 eexp, 1203 | LBRACE eexp RBRACE (sql_inject (#1 eexp,
1197 EWild,
1198 s (LBRACEleft, RBRACEright))) 1204 s (LBRACEleft, RBRACEright)))
1199 | LPAREN sqlexp RPAREN (sqlexp) 1205 | LPAREN sqlexp RPAREN (sqlexp)
1200 1206
1201 | COUNT LPAREN STAR RPAREN (let 1207 | COUNT LPAREN STAR RPAREN (let
1202 val loc = s (COUNTleft, RPARENright) 1208 val loc = s (COUNTleft, RPARENright)
1203 in 1209 in
1204 (EApp ((EVar (["Basis"], "sql_count"), loc), 1210 (EApp ((EVar (["Basis"], "sql_count", Infer), loc),
1205 (ERecord [], loc)), loc) 1211 (ERecord [], loc)), loc)
1206 end) 1212 end)
1207 | sqlagg LPAREN sqlexp RPAREN (let 1213 | sqlagg LPAREN sqlexp RPAREN (let
1208 val loc = s (sqlaggleft, RPARENright) 1214 val loc = s (sqlaggleft, RPARENright)
1209 1215
1210 val e = (EApp ((EVar (["Basis"], "sql_" ^ sqlagg), loc), 1216 val e = (EVar (["Basis"], "sql_" ^ sqlagg, Infer), loc)
1211 (EWild, loc)), loc) 1217 val e = (EApp ((EVar (["Basis"], "sql_aggregate", Infer), loc),
1212 val e = (EApp ((EVar (["Basis"], "sql_aggregate"), loc),
1213 e), loc) 1218 e), loc)
1214 in 1219 in
1215 (EApp (e, sqlexp), loc) 1220 (EApp (e, sqlexp), loc)
1216 end) 1221 end)
1217 1222
1218 wopt : (sql_inject (EVar (["Basis"], "True"), 1223 wopt : (sql_inject (EVar (["Basis"], "True", Infer),
1219 EVar (["Basis"], "sql_bool"),
1220 dummy)) 1224 dummy))
1221 | CWHERE sqlexp (sqlexp) 1225 | CWHERE sqlexp (sqlexp)
1222 1226
1223 groupi : tident DOT fident (GField (tident, fident)) 1227 groupi : tident DOT fident (GField (tident, fident))
1224 1228
1226 | groupi COMMA groupis (groupi :: groupis) 1230 | groupi COMMA groupis (groupi :: groupis)
1227 1231
1228 gopt : (NONE) 1232 gopt : (NONE)
1229 | GROUP BY groupis (SOME groupis) 1233 | GROUP BY groupis (SOME groupis)
1230 1234
1231 hopt : (sql_inject (EVar (["Basis"], "True"), 1235 hopt : (sql_inject (EVar (["Basis"], "True", Infer),
1232 EVar (["Basis"], "sql_bool"),
1233 dummy)) 1236 dummy))
1234 | HAVING sqlexp (sqlexp) 1237 | HAVING sqlexp (sqlexp)
1235 1238
1236 obopt : (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), dummy), 1239 obopt : (ECApp ((EVar (["Basis"], "sql_order_by_Nil", Infer), dummy),
1237 (CWild (KRecord (KType, dummy), dummy), dummy)), 1240 (CWild (KRecord (KType, dummy), dummy), dummy)),
1238 dummy) 1241 dummy)
1239 | ORDER BY obexps (obexps) 1242 | ORDER BY obexps (obexps)
1240 1243
1241 obitem : sqlexp diropt (sqlexp, diropt) 1244 obitem : sqlexp diropt (sqlexp, diropt)
1242 1245
1243 obexps : obitem (let 1246 obexps : obitem (let
1244 val loc = s (obitemleft, obitemright) 1247 val loc = s (obitemleft, obitemright)
1245 1248
1246 val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil"), loc), 1249 val e' = (ECApp ((EVar (["Basis"], "sql_order_by_Nil", Infer), loc),
1247 (CWild (KRecord (KType, loc), loc), loc)), 1250 (CWild (KRecord (KType, loc), loc), loc)),
1248 loc) 1251 loc)
1249 val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc), 1252 val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons", Infer), loc),
1250 #1 obitem), loc) 1253 #1 obitem), loc)
1251 val e = (EApp (e, #2 obitem), loc) 1254 val e = (EApp (e, #2 obitem), loc)
1252 in 1255 in
1253 (EApp (e, e'), loc) 1256 (EApp (e, e'), loc)
1254 end) 1257 end)
1255 | obitem COMMA obexps (let 1258 | obitem COMMA obexps (let
1256 val loc = s (obitemleft, obexpsright) 1259 val loc = s (obitemleft, obexpsright)
1257 1260
1258 val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons"), loc), 1261 val e = (EApp ((EVar (["Basis"], "sql_order_by_Cons", Infer), loc),
1259 #1 obitem), loc) 1262 #1 obitem), loc)
1260 val e = (EApp (e, #2 obitem), loc) 1263 val e = (EApp (e, #2 obitem), loc)
1261 in 1264 in
1262 (EApp (e, obexps), loc) 1265 (EApp (e, obexps), loc)
1263 end) 1266 end)
1264 1267
1265 diropt : (EVar (["Basis"], "sql_asc"), dummy) 1268 diropt : (EVar (["Basis"], "sql_asc", Infer), dummy)
1266 | ASC (EVar (["Basis"], "sql_asc"), s (ASCleft, ASCright)) 1269 | ASC (EVar (["Basis"], "sql_asc", Infer), s (ASCleft, ASCright))
1267 | DESC (EVar (["Basis"], "sql_desc"), s (DESCleft, DESCright)) 1270 | DESC (EVar (["Basis"], "sql_desc", Infer), s (DESCleft, DESCright))
1268 1271
1269 lopt : (EVar (["Basis"], "sql_no_limit"), dummy) 1272 lopt : (EVar (["Basis"], "sql_no_limit", Infer), dummy)
1270 | LIMIT ALL (EVar (["Basis"], "sql_no_limit"), dummy) 1273 | LIMIT ALL (EVar (["Basis"], "sql_no_limit", Infer), dummy)
1271 | LIMIT sqlint (let 1274 | LIMIT sqlint (let
1272 val loc = s (LIMITleft, sqlintright) 1275 val loc = s (LIMITleft, sqlintright)
1273 in 1276 in
1274 (EApp ((EVar (["Basis"], "sql_limit"), loc), sqlint), loc) 1277 (EApp ((EVar (["Basis"], "sql_limit", Infer), loc), sqlint), loc)
1275 end) 1278 end)
1276 1279
1277 ofopt : (EVar (["Basis"], "sql_no_offset"), dummy) 1280 ofopt : (EVar (["Basis"], "sql_no_offset", Infer), dummy)
1278 | OFFSET sqlint (let 1281 | OFFSET sqlint (let
1279 val loc = s (OFFSETleft, sqlintright) 1282 val loc = s (OFFSETleft, sqlintright)
1280 in 1283 in
1281 (EApp ((EVar (["Basis"], "sql_offset"), loc), sqlint), loc) 1284 (EApp ((EVar (["Basis"], "sql_offset", Infer), loc), sqlint), loc)
1282 end) 1285 end)
1283 1286
1284 sqlint : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) 1287 sqlint : INT (EPrim (Prim.Int INT), s (INTleft, INTright))
1285 | LBRACE eexp RBRACE (eexp) 1288 | LBRACE eexp RBRACE (eexp)
1286 1289