comparison src/urweb.grm @ 1093:8d3aa6c7cee0

Make summary unification more conservative; infer implicit arguments after applications
author Adam Chlipala <adamc@hcoop.net>
date Sat, 26 Dec 2009 11:56:40 -0500
parents dcf98ae3c48d
children ce56795b2e5f
comparison
equal deleted inserted replaced
1092:6f4b05fc4361 1093:8d3aa6c7cee0
538 val loc = s (UNIQUEleft, tnamesright) 538 val loc = s (UNIQUEleft, tnamesright)
539 539
540 val e = (EVar (["Basis"], "unique", Infer), loc) 540 val e = (EVar (["Basis"], "unique", Infer), loc)
541 val e = (ECApp (e, #1 (#1 tnames)), loc) 541 val e = (ECApp (e, #1 (#1 tnames)), loc)
542 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc) 542 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
543 val e = (EDisjointApp e, loc) 543 in
544 in 544 e
545 (EDisjointApp e, loc)
546 end) 545 end)
547 546
548 | CHECK sqlexp (let 547 | CHECK sqlexp (let
549 val loc = s (CHECKleft, sqlexpright) 548 val loc = s (CHECKleft, sqlexpright)
550 in 549 in
560 (fn ((nm1, _), (nm2, _), mat) => 559 (fn ((nm1, _), (nm2, _), mat) =>
561 let 560 let
562 val e = (EVar (["Basis"], "mat_cons", Infer), loc) 561 val e = (EVar (["Basis"], "mat_cons", Infer), loc)
563 val e = (ECApp (e, nm1), loc) 562 val e = (ECApp (e, nm1), loc)
564 val e = (ECApp (e, nm2), loc) 563 val e = (ECApp (e, nm2), loc)
565 val e = (EDisjointApp e, loc)
566 val e = (EDisjointApp e, loc)
567 val e = (EApp (e, (EWild, loc)), loc)
568 in 564 in
569 (EApp (e, mat), loc) 565 (EApp (e, mat), loc)
570 end) 566 end)
571 (EVar (["Basis"], "mat_nil", Infer), loc) 567 (EVar (["Basis"], "mat_nil", Infer), loc)
572 (#1 tnames :: #2 tnames, #1 tnames' :: #2 tnames') 568 (#1 tnames :: #2 tnames, #1 tnames' :: #2 tnames')
632 628
633 pkopt : (EVar (["Basis"], "no_primary_key", Infer), dummy) 629 pkopt : (EVar (["Basis"], "no_primary_key", Infer), dummy)
634 | PRIMARY KEY tnames (let 630 | PRIMARY KEY tnames (let
635 val loc = s (PRIMARYleft, tnamesright) 631 val loc = s (PRIMARYleft, tnamesright)
636 632
637 val e = (EVar (["Basis"], "primary_key", Infer), loc) 633 val e = (EVar (["Basis"], "primary_key", TypesOnly), loc)
638 val e = (ECApp (e, #1 (#1 tnames)), loc) 634 val e = (ECApp (e, #1 (#1 tnames)), loc)
639 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc) 635 val e = (ECApp (e, (CRecord (#2 tnames), loc)), loc)
640 val e = (EDisjointApp e, loc) 636 val e = (EDisjointApp e, loc)
641 val e = (EDisjointApp e, loc) 637 val e = (EDisjointApp e, loc)
642 638
1190 (let 1186 (let
1191 val loc = s (LPARENleft, RPARENright) 1187 val loc = s (LPARENleft, RPARENright)
1192 1188
1193 val e = (EVar (["Basis"], "update", Infer), loc) 1189 val e = (EVar (["Basis"], "update", Infer), loc)
1194 val e = (ECApp (e, (CWild (KRecord (KType, loc), loc), loc)), loc) 1190 val e = (ECApp (e, (CWild (KRecord (KType, loc), loc), loc)), loc)
1195 val e = (EDisjointApp e, loc)
1196 val e = (EApp (e, (ERecord fsets, loc)), loc) 1191 val e = (EApp (e, (ERecord fsets, loc)), loc)
1197 val e = (EApp (e, texp), loc) 1192 val e = (EApp (e, texp), loc)
1198 in 1193 in
1199 (EApp (e, sqlexp), loc) 1194 (EApp (e, sqlexp), loc)
1200 end) 1195 end)
1333 in 1328 in
1334 if #1 (#1 tag) = et then 1329 if #1 (#1 tag) = et then
1335 if et = "form" then 1330 if et = "form" then
1336 (EApp ((EVar (["Basis"], "form", Infer), pos), 1331 (EApp ((EVar (["Basis"], "form", Infer), pos),
1337 xmlOpt), pos) 1332 xmlOpt), pos)
1338 else if et = "subform" then 1333 else if et = "subform" orelse et = "subforms" then
1339 (EApp ((EDisjointApp (#2 (#1 tag)), pos), 1334 (EApp (#2 (#1 tag),
1340 xmlOpt), pos)
1341 else if et = "subforms" then
1342 (EApp ((EDisjointApp (#2 (#1 tag)), pos),
1343 xmlOpt), pos) 1335 xmlOpt), pos)
1344 else if et = "entry" then 1336 else if et = "entry" then
1345 (EApp ((EVar (["Basis"], "entry", Infer), pos), 1337 (EApp ((EVar (["Basis"], "entry", Infer), pos),
1346 xmlOpt), pos) 1338 xmlOpt), pos)
1347 else 1339 else
1502 end 1494 end
1503 1495
1504 val e = (EVar (["Basis"], "sql_query1", Infer), loc) 1496 val e = (EVar (["Basis"], "sql_query1", Infer), loc)
1505 val e = (ECApp (e, (CRecord (map (fn nm => (nm, (CUnit, loc))) empties), 1497 val e = (ECApp (e, (CRecord (map (fn nm => (nm, (CUnit, loc))) empties),
1506 loc)), loc) 1498 loc)), loc)
1507 val e = (EDisjointApp e, loc)
1508 val re = (ERecord [((CName "Distinct", loc), 1499 val re = (ERecord [((CName "Distinct", loc),
1509 dopt), 1500 dopt),
1510 ((CName "From", loc), 1501 ((CName "From", loc),
1511 #2 tables), 1502 #2 tables),
1512 ((CName "Where", loc), 1503 ((CName "Where", loc),