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 (