Mercurial > urweb

comparison src/iflow.sml @ 1204:7af5e2af64f4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Parsed a WHERE clause
author Adam Chlipala <adamc@hcoop.net>
date Sun, 04 Apr 2010 17:11:22 -0400
parents a75c66dd2aeb
children 7cd11380cdf1
comparison
equal deleted inserted replaced
1203:a75c66dd2aeb 1204:7af5e2af64f4
383 fun alt p1 p2 chs = 383 fun alt p1 p2 chs =
384 case p1 chs of 384 case p1 chs of
385 NONE => p2 chs 385 NONE => p2 chs
386 | v => v 386 | v => v
387 387
388 fun opt p chs =
389 case p chs of
390 NONE => SOME (NONE, chs)
391 | SOME (v, chs) => SOME (SOME v, chs)
392
388 fun skip cp chs = 393 fun skip cp chs =
389 case chs of 394 case chs of
390 String "" :: chs => skip cp chs 395 String "" :: chs => skip cp chs
391 | String s :: chs' => if cp (String.sub (s, 0)) then 396 | String s :: chs' => if cp (String.sub (s, 0)) then
392 skip cp (String (String.extract (s, 1, NONE)) :: chs') 397 skip cp (String (String.extract (s, 1, NONE)) :: chs')
410 else 415 else
411 String (Substring.string after) :: chs') 416 String (Substring.string after) :: chs')
412 end 417 end
413 | _ => NONE 418 | _ => NONE
414 419
415 fun ws p = wrap (follow p (skip (fn ch => ch = #" "))) #1 420 fun ws p = wrap (follow (skip (fn ch => ch = #" "))
421 (follow p (skip (fn ch => ch = #" ")))) (#1 o #2)
422
423 fun log name p chs =
424 (case chs of
425 String s :: [] => print (name ^ ": " ^ s ^ "\n")
426 | _ => print (name ^ ": blocked!\n");
427 p chs)
416 428
417 fun list p chs = 429 fun list p chs =
418 (alt (wrap (follow p (follow (ws (const ",")) (list p))) 430 (alt (wrap (follow p (follow (ws (const ",")) (list p)))
419 (fn (v, ((), ls)) => v :: ls)) 431 (fn (v, ((), ls)) => v :: ls))
420 (alt (wrap (ws p) (fn v => [v])) 432 (alt (wrap (ws p) (fn v => [v]))
434 val sitem = wrap (follow t_ident 446 val sitem = wrap (follow t_ident
435 (follow (const ".") 447 (follow (const ".")
436 uw_ident)) 448 uw_ident))
437 (fn (t, ((), f)) => (t, f)) 449 (fn (t, ((), f)) => (t, f))
438 450
451 datatype sqexp =
452 Field of string * string
453 | Binop of string * sqexp * sqexp
454
455 val sqbrel = wrap (const "=") (fn () => "=")
456
457 datatype ('a, 'b) sum = inl of 'a | inr of 'b
458
459 fun sqexp chs =
460 alt
461 (wrap (follow (ws (const "("))
462 (follow (ws sqexp)
463 (ws (const ")"))))
464 (fn ((), (e, ())) => e))
465 (wrap
466 (follow (wrap sitem Field)
467 (alt
468 (wrap
469 (follow (ws sqbrel)
470 (ws sqexp))
471 inl)
472 (always (inr ()))))
473 (fn (e1, sm) =>
474 case sm of
475 inl (bo, e2) => Binop (bo, e1, e2)
476 | inr () => e1))
477 chs
478
439 val select = wrap (follow (const "SELECT ") (list sitem)) 479 val select = wrap (follow (const "SELECT ") (list sitem))
440 (fn ((), ls) => ls) 480 (fn ((), ls) => ls)
441 481
442 val fitem = wrap (follow uw_ident 482 val fitem = wrap (follow uw_ident
443 (follow (const " AS ") 483 (follow (const " AS ")
445 (fn (t, ((), f)) => (t, f)) 485 (fn (t, ((), f)) => (t, f))
446 486
447 val from = wrap (follow (const "FROM ") (list fitem)) 487 val from = wrap (follow (const "FROM ") (list fitem))
448 (fn ((), ls) => ls) 488 (fn ((), ls) => ls)
449 489
450 val query = wrap (follow select from) 490 val wher = wrap (follow (ws (const "WHERE ")) sqexp)
451 (fn (fs, ts) => {Select = fs, From = ts}) 491 (fn ((), ls) => ls)
492
493 val query = wrap (follow (follow select from) (opt wher))
494 (fn ((fs, ts), wher) => {Select = fs, From = ts, Where = wher})
452 495
453 fun queryProp rv oe e = 496 fun queryProp rv oe e =
454 case parse query e of 497 case parse query e of
455 NONE => Unknown 498 NONE => (print "Crap\n"; Unknown)
456 | SOME r => 499 | SOME r =>
457 let 500 let
458 val p = 501 val p =
459 foldl (fn ((t, v), p) => 502 foldl (fn ((t, v), p) =>
460 And (p, 503 And (p,