Mercurial > urweb

comparison src/iflow.sml @ 1239:30f789d5e2ad

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Parsing ORDER BY
author Adam Chlipala <adamc@hcoop.net>
date Thu, 15 Apr 2010 08:48:41 -0400
parents d6938ab3b5ae
children 58f5ac1bb849
comparison
equal deleted inserted replaced
1238:d6938ab3b5ae 1239:30f789d5e2ad
950 | Props of prop * prop -> prop 950 | Props of prop * prop -> prop
951 951
952 datatype sqexp = 952 datatype sqexp =
953 SqConst of Prim.t 953 SqConst of Prim.t
954 | Field of string * string 954 | Field of string * string
955 | Computed of string
955 | Binop of Rel * sqexp * sqexp 956 | Binop of Rel * sqexp * sqexp
956 | SqKnown of sqexp 957 | SqKnown of sqexp
957 | Inj of Mono.exp 958 | Inj of Mono.exp
958 | SqFunc of string * sqexp 959 | SqFunc of string * sqexp
959 | Count 960 | Count
1032 1033
1033 fun sqexp chs = 1034 fun sqexp chs =
1034 log "sqexp" 1035 log "sqexp"
1035 (altL [wrap prim SqConst, 1036 (altL [wrap prim SqConst,
1036 wrap field Field, 1037 wrap field Field,
1038 wrap uw_ident Computed,
1037 wrap known SqKnown, 1039 wrap known SqKnown,
1038 wrap func SqFunc, 1040 wrap func SqFunc,
1039 wrap (const "COUNT(*)") (fn () => Count), 1041 wrap (const "COUNT(*)") (fn () => Count),
1040 wrap sqlify Inj, 1042 wrap sqlify Inj,
1041 wrap (follow (const "COALESCE(") (follow sqexp (follow (const ",") 1043 wrap (follow (const "COALESCE(") (follow sqexp (follow (const ",")
1066 1068
1067 datatype sitem = 1069 datatype sitem =
1068 SqField of string * string 1070 SqField of string * string
1069 | SqExp of sqexp * string 1071 | SqExp of sqexp * string
1070 1072
1071 val sitem = alt (wrap field SqField) 1073 val sitem = alt (wrap (follow sqexp (follow (const " AS ") uw_ident))
1072 (wrap (follow sqexp (follow (const " AS ") uw_ident)) 1074 (fn (e, ((), s)) => SqExp (e, s)))
1073 (fn (e, ((), s)) => SqExp (e, s))) 1075 (wrap field SqField)
1074 1076
1075 val select = log "select" 1077 val select = log "select"
1076 (wrap (follow (const "SELECT ") (list sitem)) 1078 (wrap (follow (const "SELECT ") (list sitem))
1077 (fn ((), ls) => ls)) 1079 (fn ((), ls) => ls))
1078 1080
1098 1100
1099 datatype query = 1101 datatype query =
1100 Query1 of query1 1102 Query1 of query1
1101 | Union of query * query 1103 | Union of query * query
1102 1104
1105 val orderby = log "orderby"
1106 (wrap (follow (ws (const "ORDER BY "))
1107 (list sqexp))
1108 ignore)
1109
1103 fun query chs = log "query" 1110 fun query chs = log "query"
1104 (alt (wrap (follow (const "((") 1111 (wrap
1105 (follow query 1112 (follow
1106 (follow (const ") UNION (") 1113 (alt (wrap (follow (const "((")
1107 (follow query (const "))"))))) 1114 (follow query
1108 (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2))) 1115 (follow (const ") UNION (")
1109 (wrap query1 Query1)) 1116 (follow query (const "))")))))
1117 (fn ((), (q1, ((), (q2, ())))) => Union (q1, q2)))
1118 (wrap query1 Query1))
1119 (opt orderby))
1120 #1)
1110 chs 1121 chs
1111 1122
1112 datatype dml = 1123 datatype dml =
1113 Insert of string * (string * sqexp) list 1124 Insert of string * (string * sqexp) list
1114 | Delete of string * sqexp 1125 | Delete of string * sqexp
1453 fun default () = inl (rv ()) 1464 fun default () = inl (rv ())
1454 in 1465 in
1455 case e of 1466 case e of
1456 SqConst p => inl (Const p) 1467 SqConst p => inl (Const p)
1457 | Field (v, f) => inl (Proj (rvOf v, f)) 1468 | Field (v, f) => inl (Proj (rvOf v, f))
1469 | Computed _ => default ()
1458 | Binop (bo, e1, e2) => 1470 | Binop (bo, e1, e2) =>
1459 let 1471 let
1460 val e1 = expIn e1 1472 val e1 = expIn e1
1461 val e2 = expIn e2 1473 val e2 = expIn e2
1462 in 1474 in
1565 1577
1566 fun usedFields e = 1578 fun usedFields e =
1567 case e of 1579 case e of
1568 SqConst _ => [] 1580 SqConst _ => []
1569 | Field (v, f) => [(v, f)] 1581 | Field (v, f) => [(v, f)]
1582 | Computed _ => []
1570 | Binop (_, e1, e2) => removeDups (usedFields e1 @ usedFields e2) 1583 | Binop (_, e1, e2) => removeDups (usedFields e1 @ usedFields e2)
1571 | SqKnown _ => [] 1584 | SqKnown _ => []
1572 | Inj _ => [] 1585 | Inj _ => []
1573 | SqFunc (_, e) => usedFields e 1586 | SqFunc (_, e) => usedFields e
1574 | Count => [] 1587 | Count => []