(*****************************************************************)
(*    MiniML.sml                                                 *)
(*****************************************************************)
Compiler.Control.Print.printDepth := 50;
Compiler.Control.Print.printLength:= 1000;
Compiler.Control.Print.stringDepth:= 200;
(*****************************************************************)
(*    Error handler                                              *)
(*****************************************************************)
exception Error of string;
(*****************************************************************)
(*    Scanner                                                    *)
(*****************************************************************)
datatype token = 
	 LPAR | RPAR | EQ | GT | DOT 
       | LAZY | LAM | REC | LET | IN | END 
       | ID of string | NUM of int;
  
local
fun scanchar nil = nil
  | scanchar (c::s) = 
    if (Char.isAlpha c) then scanid s (Char.toString c) else 
    if (Char.isDigit c) then scannum s (Char.toString c) else 
    if (Char.isSpace c) then scanchar s
    else (scanspec s c)
and scanid nil st = [(makeid st)]
  | scanid (c::s) st =
    if (Char.isAlphaNum c) 
    then (scanid s (st^(Char.toString c)))
    else (makeid st)::(scanchar (c::s))
and makeid "lambda" = LAM
  | makeid "lazy" = LAZY
  | makeid "rec" = REC
  | makeid "let" = LET
  | makeid "in" = IN
  | makeid "end" = END
  | makeid s = (ID s)
and scannum nil st = [(makenum st)]
  | scannum (c::s) st = 
    if (Char.isDigit c) 
    then (scannum s (st^(Char.toString c)))
    else (makenum st)::(scanchar (c::s))
and makenum st =
	case (Int.fromString st) of 
	    NONE => raise Error "Lex: cannot happen in lex\n"
	  | SOME i => (NUM i)
and scanspec s #"(" = LPAR::(scanchar s)
  | scanspec s #")" = RPAR::(scanchar s)
  | scanspec s #"." = DOT::(scanchar s)
  | scanspec s #"=" = EQ::(scanchar s)
  | scanspec s #">" = GT::(scanchar s)
  | scanspec s c = raise Error ("Lex: unknown token '"^(Char.toString c)^"'\n")
in
fun scan s = (scanchar (explode s))
end
;

(*****************************************************************)
(*    Parser                                                     *)
(*                                                               *)
(*      E ::= Id | NUM | (E E)                                   *)
(*         |  lambda id.E | lazy id.E                            *)
(*         |  rec id.E | let id=E in E end                       *)
(*                                                               *)
(* fun parse    takes list of tokens and builds abst syntax tree *)
(* fun ppast    pretty prints an abstract syntax tree            *)
(*****************************************************************)

(*****************************************************************)
(*    Typechecker                                                *)
(*                                                               *)
(*      T ::= int | bool | Id | (T -> T) | t-var                 *)
(*                                                               *)
(* fun inftype takes an abst syntax tree and determines          *)
(*                                           its principal type  *)
(* fun pptp    pretty prints a (tree representation of a) type   *)
(*****************************************************************)

(*****************************************************************)
(*    Evaluator                                                  *)
(*                                                               *)
(*      E ::= Id | NUM | (E E)                                   *)
(*         |  lambda id.E | lazy id.E                            *)
(*         |  rec id.E | let id=E in E end                       *)
(*                                                               *)
(* fun evaluate  evaluates a valid ast to a vlaue (still ast)    *)
(*****************************************************************)

(*****************************************************************)
(*    Main (example)                                             *)
(*      you may need to change this to                           *)
(*              suit your parser/typechecker/evaluator           *)
(*****************************************************************)
exception EOF;
local
fun getchar s = 
    let val d = (TextIO.input1 s) in
	case d of NONE => raise EOF
		| SOME c => c
    end
in
fun rdstmt st = 
    let val c = (getchar st) in
	if (c=(#";")) then "" else (implode [c])^(rdstmt st)
    end
end;

(* mail interpreter: string -> unit (output via "print" sideeffect) *)
fun evalit s = let val e = (parse (scan s)) in 
		   let  val tp = (inftype e) in 
			   print ((ppast (evaluate e))^":"^(pptp tp)^"\n")
	      end end handle (Error s) => (print s)
;

(* main read-eval-print-loop *)
fun repl s = 
    let val _ = (evalit (rdstmt s)) 
    in (repl s) handle EOF => () end;