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

signature REGEXP = 
  sig

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

    val acc : Reg -> string -> bool
  end


structure RegExp : REGEXP = 
  struct

    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 s k = B
 
        Invariant: 
        If   R is a regular expression
	and  s is string
        and  k is a continuation k
	 
        acc' R s k ==> true  if a prefix of s in L(R)
                             and the rest of s passed in k returns true.
	acc' R s k ==> 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 s k = false
       | acc' One s k = k s
       | acc' (Const c) nil k = false
       | acc' (Const c) (c' :: s') k = 
         if c = c' then k s' else false
       | acc' (Plus (R1, R2)) s k = 
	   acc' R1 s k orelse acc' R2 s k
       | acc' (Times (R1, R2)) s k = 
	   acc' R1 s (fn s' => acc' R2 s' k)
       | acc' (Star R) s k =
	   acc' (Plus (One, Times (R, Star R))) s k

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

     fun acc R s = acc' R (String.explode s) init
end

local 
  open RegExp
in
(* 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)))
end