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), _),