Mercurial > urweb

comparison src/iflow.sml @ 1206:772760df4c4c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Parsing more of WHERE
author Adam Chlipala <adamc@hcoop.net>
date Sun, 04 Apr 2010 17:44:12 -0400
parents 7cd11380cdf1
children ae3036773768
comparison
equal deleted inserted replaced
1205:7cd11380cdf1 1206:772760df4c4c
418 | _ => NONE 418 | _ => NONE
419 419
420 fun ws p = wrap (follow (skip (fn ch => ch = #" ")) 420 fun ws p = wrap (follow (skip (fn ch => ch = #" "))
421 (follow p (skip (fn ch => ch = #" ")))) (#1 o #2) 421 (follow p (skip (fn ch => ch = #" ")))) (#1 o #2)
422 422
423 val debug = ref false
424
423 fun log name p chs = 425 fun log name p chs =
424 (case chs of 426 (if !debug then
425 String s :: [] => print (name ^ ": " ^ s ^ "\n") 427 case chs of
426 | _ => print (name ^ ": blocked!\n"); 428 String s :: [] => print (name ^ ": " ^ s ^ "\n")
429 | _ => print (name ^ ": blocked!\n")
430 else
431 ();
427 p chs) 432 p chs)
428 433
429 fun list p chs = 434 fun list p chs =
430 (alt (wrap (follow p (follow (ws (const ",")) (list p))) 435 (alt (wrap (follow p (follow (ws (const ",")) (list p)))
431 (fn (v, ((), ls)) => v :: ls)) 436 (fn (v, ((), ls)) => v :: ls))
446 val sitem = wrap (follow t_ident 451 val sitem = wrap (follow t_ident
447 (follow (const ".") 452 (follow (const ".")
448 uw_ident)) 453 uw_ident))
449 (fn (t, ((), f)) => (t, f)) 454 (fn (t, ((), f)) => (t, f))
450 455
456 datatype Rel =
457 Exps of exp * exp -> prop
458 | Props of prop * prop -> prop
459
451 datatype sqexp = 460 datatype sqexp =
452 Field of string * string 461 SqConst of Prim.t
453 | Binop of string * sqexp * sqexp 462 | Field of string * string
454 463 | Binop of Rel * sqexp * sqexp
455 val sqbrel = wrap (const "=") (fn () => "=") 464
465 val sqbrel = alt (wrap (const "=") (fn () => Exps (fn (e1, e2) => Reln (Eq, [e1, e2]))))
466 (alt (wrap (const "AND") (fn () => Props And))
467 (wrap (const "OR") (fn () => Props Or)))
456 468
457 datatype ('a, 'b) sum = inl of 'a | inr of 'b 469 datatype ('a, 'b) sum = inl of 'a | inr of 'b
458 470
471 fun int chs =
472 case chs of
473 String s :: chs' =>
474 let
475 val (befor, after) = Substring.splitl Char.isDigit (Substring.full s)
476 in
477 if Substring.isEmpty befor then
478 NONE
479 else case Int64.fromString (Substring.string befor) of
480 NONE => NONE
481 | SOME n => SOME (n, if Substring.isEmpty after then
482 chs'
483 else
484 String (Substring.string after) :: chs')
485 end
486 | _ => NONE
487
488 val prim = wrap (follow (wrap int Prim.Int) (opt (const "::int8"))) #1
489
459 fun sqexp chs = 490 fun sqexp chs =
460 alt 491 log "sqexp"
461 (wrap (follow (ws (const "(")) 492 (alt
462 (follow (ws sqexp) 493 (wrap prim SqConst)
463 (ws (const ")")))) 494 (alt
464 (fn ((), (e, ())) => e)) 495 (wrap sitem Field)
465 (wrap 496 (wrap
466 (follow (wrap sitem Field) 497 (follow (ws (const "("))
467 (alt 498 (follow (wrap
468 (wrap 499 (follow sqexp
469 (follow (ws sqbrel) 500 (alt
470 (ws sqexp)) 501 (wrap
471 inl) 502 (follow (ws sqbrel)
472 (always (inr ())))) 503 (ws sqexp))
473 (fn (e1, sm) => 504 inl)
474 case sm of 505 (always (inr ()))))
475 inl (bo, e2) => Binop (bo, e1, e2) 506 (fn (e1, sm) =>
476 | inr () => e1)) 507 case sm of
477 chs 508 inl (bo, e2) => Binop (bo, e1, e2)
478 509 | inr () => e1))
510 (const ")")))
511 (fn ((), (e, ())) => e))))
512 chs
513
479 val select = wrap (follow (const "SELECT ") (list sitem)) 514 val select = wrap (follow (const "SELECT ") (list sitem))
480 (fn ((), ls) => ls) 515 (fn ((), ls) => ls)
481 516
482 val fitem = wrap (follow uw_ident 517 val fitem = wrap (follow uw_ident
483 (follow (const " AS ") 518 (follow (const " AS ")
509 fs) [] (#Select r))]))) 544 fs) [] (#Select r))])))
510 True (#From r) 545 True (#From r)
511 546
512 fun expIn e = 547 fun expIn e =
513 case e of 548 case e of
514 Field (v, f) => inl (Proj (Proj (Lvar rv, v), f)) 549 SqConst p => inl (Const p)
550 | Field (v, f) => inl (Proj (Proj (Lvar rv, v), f))
515 | Binop (bo, e1, e2) => 551 | Binop (bo, e1, e2) =>
516 (case (expIn e1, expIn e2) of 552 inr (case (bo, expIn e1, expIn e2) of
517 (inr _, _) => inr Unknown 553 (Exps f, inl e1, inl e2) => f (e1, e2)
518 | (_, inr _) => inr Unknown 554 | (Props f, inr p1, inr p2) => f (p1, p2)
519 | (inl e1, inl e2) => 555 | _ => Unknown)
520 let
521 val bo = case bo of
522 "=" => SOME Eq
523 | _ => NONE
524 in
525 case bo of
526 NONE => inr Unknown
527 | SOME bo => inr (Reln (bo, [e1, e2]))
528 end)
529 556
530 val p = case #Where r of 557 val p = case #Where r of
531 NONE => p 558 NONE => p
532 | SOME e => 559 | SOME e =>
533 case expIn e of 560 case expIn e of