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

exception Error of string

fun acc' Zero s k = raise Error "Zero encountered"
  | acc' One s k = k s
  | acc' (Const c) nil k = raise Error "Character expected, nothing found"
  | acc' (Const c) (c' :: s) k =
      if c = c' then (k s)
      else raise Error "Unexpected character found"
  | acc' (Plus (R1, R2)) s k = 
      ((acc' R1 s k) handle Error _ => 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 (Times (R, Star R), One)) s k

and acc R s k = acc' R (String.explode s) k

fun keyword' nil = One
  | keyword' (c :: s) = Times (Const c, keyword' s)
and keyword s = keyword' (String.explode s)

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",signedreal)))




datatype Token
  = INTEGER of int
  | REAL of real
  | PLUS
  | MINUS
  | DIV
  | TIMES
  | LPAREN
  | RPAREN


fun convertInt s = 
    (case (Int.fromString s) 
      of NONE => raise Error "Cannot convert integer" 
       | SOME x => INTEGER x)


fun convertReal s = 
    (case (Real.fromString s) 
      of NONE => raise Error "Cannot convert real" 
       | SOME x => REAL x)


val lextable = [(keyword " ", NONE),
		(keyword "\t", NONE),
		(keyword "\n", NONE),
		(keyword "(", SOME (fn _ => LPAREN)),
		(keyword ")", SOME (fn _ => RPAREN)),
		(keyword "+", SOME (fn _ => PLUS)),
		(keyword "-", SOME (fn _ => MINUS)),
		(keyword "/", SOME (fn _ => DIV)),
		(keyword "*", SOME (fn _ => TIMES)),
		(signed, SOME (fn s => convertInt (String.implode s))),
		(signedreal, SOME (fn s => convertReal (String.implode s)))]


fun apply NONE s ts = ts
  | apply (SOME f) s ts = (f s) :: ts

fun loop' m [] k = k nil
  | loop' m s k =
    let 
      
      fun loop'' [] s' k' = raise Error "Token not found"
        | loop'' ((R', token') :: m') s' k' = 
	(acc' (R') s' (fn s'' => (loop' m s''
				  (fn ts => k' (apply
						token' 
						(List.take  
						 ( s', List.length s' - 
						  List.length s'')) 
						ts))))
	 handle Error _ => loop'' m' s' k')
    in 
      loop'' m s k
    end
and loop m s k = loop' m (String.explode s) k

fun lexer s = loop lextable s (fn tokens => tokens)