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