Mercurial > urweb

comparison src/urweb.grm @ 1194:601a77af0477

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
'AS' clauses for expression columns may be omitted
author Adam Chlipala <adamc@hcoop.net>
date Thu, 25 Mar 2010 16:41:51 -0400
parents 9c82548c97e9
children c316ca3c9ec6
comparison
equal deleted inserted replaced
1193:1da49fd79e20 1194:601a77af0477
40 TRecord c => c 40 TRecord c => c
41 | _ => t 41 | _ => t
42 42
43 datatype select_item = 43 datatype select_item =
44 Field of con * con 44 Field of con * con
45 | Exp of con * exp 45 | Exp of con option * exp
46 | Fields of con * con 46 | Fields of con * con
47 47
48 datatype select = 48 datatype select =
49 Star 49 Star
50 | Items of select_item list 50 | Items of select_item list
56 case (c1, c2) of 56 case (c1, c2) of
57 (CVar (ms1, x1), CVar (ms2, x2)) => ms1 = ms2 andalso x1 = x2 57 (CVar (ms1, x1), CVar (ms2, x2)) => ms1 = ms2 andalso x1 = x2
58 | (CName x1, CName x2) => x1 = x2 58 | (CName x1, CName x2) => x1 = x2
59 | _ => false 59 | _ => false
60 60
61 fun amend_select loc (si, (tabs, exps)) = 61 fun amend_select loc (si, (count, tabs, exps)) =
62 case si of 62 case si of
63 Field (tx, fx) => 63 Field (tx, fx) =>
64 let 64 let
65 val c = (CRecord ([(fx, (CWild (KType, loc), loc))]), loc) 65 val c = (CRecord ([(fx, (CWild (KType, loc), loc))]), loc)
66 66
74 if found then 74 if found then
75 () 75 ()
76 else 76 else
77 ErrorMsg.errorAt loc "Select of field from unbound table"; 77 ErrorMsg.errorAt loc "Select of field from unbound table";
78 78
79 (tabs, exps) 79 (count, tabs, exps)
80 end 80 end
81 | Fields (tx, fs) => 81 | Fields (tx, fs) =>
82 let 82 let
83 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) => 83 val (tabs, found) = ListUtil.foldlMap (fn ((tx', c'), found) =>
84 if eqTnames (tx, tx') then 84 if eqTnames (tx, tx') then
90 if found then 90 if found then
91 () 91 ()
92 else 92 else
93 ErrorMsg.errorAt loc "Select of field from unbound table"; 93 ErrorMsg.errorAt loc "Select of field from unbound table";
94 94
95 (tabs, exps) 95 (count, tabs, exps)
96 end 96 end
97 | Exp (c, e) => (tabs, (c, e) :: exps) 97 | Exp (SOME c, e) => (count, tabs, (c, e) :: exps)
98 | Exp (NONE, e) => (count+1, tabs, ((CName (Int.toString count), loc), e) :: exps)
98 99
99 fun amend_group loc (gi, tabs) = 100 fun amend_group loc (gi, tabs) =
100 let 101 let
101 val (tx, c) = case gi of 102 val (tx, c) = case gi of
102 GField (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc)) 103 GField (tx, fx) => (tx, (CRecord ([(fx, (CWild (KType, loc), loc))]), loc))
1458 loc))) (#1 tables), 1459 loc))) (#1 tables),
1459 []) 1460 [])
1460 | Items sis => 1461 | Items sis =>
1461 let 1462 let
1462 val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables) 1463 val tabs = map (fn nm => (nm, (CRecord [], loc))) (#1 tables)
1463 val (tabs, exps) = foldl (amend_select loc) (tabs, []) sis 1464 val (_, tabs, exps) = foldl (amend_select loc)
1465 (1, tabs, []) sis
1464 val empties = List.mapPartial (fn (nm, (CRecord [], _)) => 1466 val empties = List.mapPartial (fn (nm, (CRecord [], _)) =>
1465 SOME nm 1467 SOME nm
1466 | _ => NONE) tabs 1468 | _ => NONE) tabs
1467 in 1469 in
1468 (empties, 1470 (empties,
1660 1662
1661 fident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright)) 1663 fident : CSYMBOL (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
1662 | LBRACE cexp RBRACE (cexp) 1664 | LBRACE cexp RBRACE (cexp)
1663 1665
1664 seli : tident DOT fident (Field (tident, fident)) 1666 seli : tident DOT fident (Field (tident, fident))
1665 | sqlexp AS fident (Exp (fident, sqlexp)) 1667 | sqlexp (Exp (NONE, sqlexp))
1668 | sqlexp AS fident (Exp (SOME fident, sqlexp))
1666 | tident DOT LBRACE LBRACE cexp RBRACE RBRACE (Fields (tident, cexp)) 1669 | tident DOT LBRACE LBRACE cexp RBRACE RBRACE (Fields (tident, cexp))
1667 1670
1668 selis : seli ([seli]) 1671 selis : seli ([seli])
1669 | seli COMMA selis (seli :: selis) 1672 | seli COMMA selis (seli :: selis)
1670 1673