Mercurial > urweb
comparison src/monoize.sml @ 307:52d4c60518d4
First INSERT works
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 07 Sep 2008 15:05:52 -0400 |
parents | 59dc042629b9 |
children | 72480e249130 |
comparison
equal
deleted
inserted
replaced
306:99e4f39e820d | 307:52d4c60518d4 |
---|---|
588 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc), | 588 (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc), |
589 (L'.ERecord [], loc)), | 589 (L'.ERecord [], loc)), |
590 loc)), loc)), loc)), loc)), loc), | 590 loc)), loc)), loc)), loc)), loc), |
591 fm) | 591 fm) |
592 end | 592 end |
593 | |
594 | L.EFfiApp ("Basis", "dml", [e]) => | |
595 let | |
596 val (e, fm) = monoExp (env, st, fm) e | |
597 val un = (L'.TRecord [], loc) | |
598 in | |
599 ((L'.EAbs ("_", un, un, | |
600 (L'.EDml (liftExpInExp 0 e), loc)), loc), | |
601 fm) | |
602 end | |
603 | L.ECApp ((L.EFfi ("Basis", "insert"), _), fields) => | |
604 (case monoType env (L.TRecord fields, loc) of | |
605 (L'.TRecord fields, _) => | |
606 let | |
607 val s = (L'.TFfi ("Basis", "string"), loc) | |
608 val fields = map (fn (x, _) => (x, s)) fields | |
609 val rt = (L'.TRecord fields, loc) | |
610 fun sc s = (L'.EPrim (Prim.String s), loc) | |
611 in | |
612 ((L'.EAbs ("tab", s, (L'.TFun (rt, s), loc), | |
613 (L'.EAbs ("fs", rt, s, | |
614 strcat loc [sc "INSERT INTO ", | |
615 (L'.ERel 1, loc), | |
616 sc " (", | |
617 strcatComma loc (map (fn (x, _) => sc ("lw_" ^ x)) fields), | |
618 sc ") VALUES (", | |
619 strcatComma loc (map (fn (x, _) => | |
620 (L'.EField ((L'.ERel 0, loc), | |
621 x), loc)) fields), | |
622 sc ")"]), loc)), loc), | |
623 fm) | |
624 end | |
625 | _ => poly ()) | |
593 | 626 |
594 | L.ECApp ( | 627 | L.ECApp ( |
595 (L.ECApp ( | 628 (L.ECApp ( |
596 (L.ECApp ((L.EFfi ("Basis", "query"), _), (L.CRecord (_, tables), _)), _), | 629 (L.ECApp ((L.EFfi ("Basis", "query"), _), (L.CRecord (_, tables), _)), _), |
597 exps), _), | 630 exps), _), |