Mercurial > urweb
comparison src/monoize.sml @ 308:72480e249130
First UPDATE works
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 07 Sep 2008 15:12:47 -0400 |
parents | 52d4c60518d4 |
children | ea62b15da922 |
comparison
equal
deleted
inserted
replaced
307:52d4c60518d4 | 308:72480e249130 |
---|---|
598 in | 598 in |
599 ((L'.EAbs ("_", un, un, | 599 ((L'.EAbs ("_", un, un, |
600 (L'.EDml (liftExpInExp 0 e), loc)), loc), | 600 (L'.EDml (liftExpInExp 0 e), loc)), loc), |
601 fm) | 601 fm) |
602 end | 602 end |
603 | |
603 | L.ECApp ((L.EFfi ("Basis", "insert"), _), fields) => | 604 | L.ECApp ((L.EFfi ("Basis", "insert"), _), fields) => |
604 (case monoType env (L.TRecord fields, loc) of | 605 (case monoType env (L.TRecord fields, loc) of |
605 (L'.TRecord fields, _) => | 606 (L'.TRecord fields, _) => |
606 let | 607 let |
607 val s = (L'.TFfi ("Basis", "string"), loc) | 608 val s = (L'.TFfi ("Basis", "string"), loc) |
618 sc ") VALUES (", | 619 sc ") VALUES (", |
619 strcatComma loc (map (fn (x, _) => | 620 strcatComma loc (map (fn (x, _) => |
620 (L'.EField ((L'.ERel 0, loc), | 621 (L'.EField ((L'.ERel 0, loc), |
621 x), loc)) fields), | 622 x), loc)) fields), |
622 sc ")"]), loc)), loc), | 623 sc ")"]), loc)), loc), |
624 fm) | |
625 end | |
626 | _ => poly ()) | |
627 | |
628 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "update"), _), changed), _), _) => | |
629 (case monoType env (L.TRecord changed, loc) of | |
630 (L'.TRecord changed, _) => | |
631 let | |
632 val s = (L'.TFfi ("Basis", "string"), loc) | |
633 val changed = map (fn (x, _) => (x, s)) changed | |
634 val rt = (L'.TRecord changed, loc) | |
635 fun sc s = (L'.EPrim (Prim.String s), loc) | |
636 in | |
637 ((L'.EAbs ("fs", rt, (L'.TFun (s, (L'.TFun (s, s), loc)), loc), | |
638 (L'.EAbs ("tab", s, (L'.TFun (s, s), loc), | |
639 (L'.EAbs ("e", s, s, | |
640 strcat loc [sc "UPDATE ", | |
641 (L'.ERel 1, loc), | |
642 sc " AS T SET ", | |
643 strcatComma loc (map (fn (x, _) => | |
644 strcat loc [sc ("lw_" ^ x | |
645 ^ " = "), | |
646 (L'.EField | |
647 ((L'.ERel 2, | |
648 loc), | |
649 x), loc)]) | |
650 changed), | |
651 sc " WHERE ", | |
652 (L'.ERel 0, loc)]), loc)), loc)), loc), | |
623 fm) | 653 fm) |
624 end | 654 end |
625 | _ => poly ()) | 655 | _ => poly ()) |
626 | 656 |
627 | L.ECApp ( | 657 | L.ECApp ( |