Mercurial > urweb

comparison src/elab_util.sml @ 338:e976b187d73a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
SQL sequences
author Adam Chlipala <adamc@hcoop.net>
date Sun, 14 Sep 2008 11:02:18 -0400
parents 9601c717d2f3
children 075b36dbb1a4
comparison
equal deleted inserted replaced
337:18d5affa790d 338:e976b187d73a
463 (SgiConstraint (c1', c2'), loc))) 463 (SgiConstraint (c1', c2'), loc)))
464 | SgiTable (tn, x, n, c) => 464 | SgiTable (tn, x, n, c) =>
465 S.map2 (con ctx c, 465 S.map2 (con ctx c,
466 fn c' => 466 fn c' =>
467 (SgiTable (tn, x, n, c'), loc)) 467 (SgiTable (tn, x, n, c'), loc))
468 | SgiSequence _ => S.return2 siAll
468 | SgiClassAbs _ => S.return2 siAll 469 | SgiClassAbs _ => S.return2 siAll
469 | SgiClass (x, n, c) => 470 | SgiClass (x, n, c) =>
470 S.map2 (con ctx c, 471 S.map2 (con ctx c,
471 fn c' => 472 fn c' =>
472 (SgiClass (x, n, c'), loc)) 473 (SgiClass (x, n, c'), loc))
492 bind (ctx, Str (x, sgn)) 493 bind (ctx, Str (x, sgn))
493 | SgiSgn (x, _, sgn) => 494 | SgiSgn (x, _, sgn) =>
494 bind (ctx, Sgn (x, sgn)) 495 bind (ctx, Sgn (x, sgn))
495 | SgiConstraint _ => ctx 496 | SgiConstraint _ => ctx
496 | SgiTable _ => ctx 497 | SgiTable _ => ctx
498 | SgiSequence _ => ctx
497 | SgiClassAbs (x, n) => 499 | SgiClassAbs (x, n) =>
498 bind (ctx, NamedC (x, n, (KArrow ((KType, loc), (KType, loc)), loc))) 500 bind (ctx, NamedC (x, n, (KArrow ((KType, loc), (KType, loc)), loc)))
499 | SgiClass (x, n, _) => 501 | SgiClass (x, n, _) =>
500 bind (ctx, NamedC (x, n, (KArrow ((KType, loc), (KType, loc)), loc))), 502 bind (ctx, NamedC (x, n, (KArrow ((KType, loc), (KType, loc)), loc))),
501 sgi ctx si)) ctx sgis, 503 sgi ctx si)) ctx sgis,
633 | DFfiStr (x, _, sgn) => 635 | DFfiStr (x, _, sgn) =>
634 bind (ctx, Str (x, sgn)) 636 bind (ctx, Str (x, sgn))
635 | DConstraint _ => ctx 637 | DConstraint _ => ctx
636 | DExport _ => ctx 638 | DExport _ => ctx
637 | DTable (tn, x, n, c) => 639 | DTable (tn, x, n, c) =>
638 bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "table"), loc), 640 bind (ctx, NamedE (x, (CApp ((CModProj (n, [], "sql_table"), loc),
639 c), loc))) 641 c), loc)))
642 | DSequence (tn, x, n) =>
643 bind (ctx, NamedE (x, (CModProj (n, [], "sql_sequence"), loc)))
640 | DClass (x, n, _) => 644 | DClass (x, n, _) =>
641 bind (ctx, NamedC (x, n, (KArrow ((KType, loc), (KType, loc)), loc))) 645 bind (ctx, NamedC (x, n, (KArrow ((KType, loc), (KType, loc)), loc)))
642 | DDatabase _ => ctx, 646 | DDatabase _ => ctx,
643 mfd ctx d)) ctx ds, 647 mfd ctx d)) ctx ds,
644 fn ds' => (StrConst ds', loc)) 648 fn ds' => (StrConst ds', loc))
729 733
730 | DTable (tn, x, n, c) => 734 | DTable (tn, x, n, c) =>
731 S.map2 (mfc ctx c, 735 S.map2 (mfc ctx c,
732 fn c' => 736 fn c' =>
733 (DTable (tn, x, n, c'), loc)) 737 (DTable (tn, x, n, c'), loc))
734 738 | DSequence _ => S.return2 dAll
735 | DClass (x, n, c) => 739
740 | DClass (x, n, c) =>
736 S.map2 (mfc ctx c, 741 S.map2 (mfc ctx c,
737 fn c' => 742 fn c' =>
738 (DClass (x, n, c'), loc)) 743 (DClass (x, n, c'), loc))
739 744
740 | DDatabase _ => S.return2 dAll 745 | DDatabase _ => S.return2 dAll
741 746
742 and mfvi ctx (x, n, c, e) = 747 and mfvi ctx (x, n, c, e) =
743 S.bind2 (mfc ctx c, 748 S.bind2 (mfc ctx c,
744 fn c' => 749 fn c' =>
745 S.map2 (mfe ctx e, 750 S.map2 (mfe ctx e,