(* Regular expression acceptor *)
(* Author: Carsten Schuermann    (following Robert Harper) *)

datatype Reg 
  = Zero
  | One
  | Const of char
  | Plus of Reg * Reg
  | Times of Reg * Reg
  | Star of Reg

(* acc : Reg -> ((char list * (char list -> bool)) -> bool) 
   acc R = B
 
   Invariant: 
   If   R is a regular expression
   the  B is a function that takes two arguments
        1) a string s
        2) a continuation k
        s.t.  B returns true if a prefix of s in L(R)
                             and the rest of s passed in k returns true.
              B returns false if no prefix of s in L(R)
	                      or for any prefix of s that is in L(R)
			      the rest of the string passed to k returns false.
*)

fun acc Zero = (fn (s, k) => false)
  | acc One  = (fn (s, k) => k s)
  | acc (Const c) = (fn (c' :: s', k) => if c = c' then k s' else false)
  | acc (Plus (R1, R2)) =
    let
      val f1 = acc R1
      val f2 = acc R2
    in
      fn (s, k) => f1 (s, k) orelse f2 (s, k)
    end
  | acc (Times (R1, R2)) = 
    let 
      val f1 = acc R1
      val f2 = acc R2
    in
      fn (s, k) => f1 (s, fn s' => f2 (s', k))
    end
  | acc (Star R) = 
    (fn (s, k) => acc (Plus (One, Times (R, Star R))) (s, k))

(* Initial continuation *)
fun init [] = true
  | init _ = false     

(* Helper function to generate Regular expressions  *)
fun alternative' nil = Zero
  | alternative' (c :: s) = Plus (Const c, alternative' s)
and alternative s = alternative' (String.explode s)

val digit      = alternative "0123456789"
val lowercase  = alternative "abcdefghijklmnopqrstuvwxyz"
val uppercase  = alternative "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
val letter     = Plus (lowercase, uppercase)
val character  = Plus (letter, digit)
val ident      = Times (letter, Star character)
val integer    = Times (digit, Star digit)
val signed     = Plus (integer, Times (Const #"~", integer))
val real       = Times (signed, Times(Const #".", integer))
val signedreal = Plus (real, Times(Const #"~", real))
val scientific = Plus (signedreal, 
                       Times (signedreal, Times (Const #"E",signed)))