(* Lecture 23 *)
(* Functions, Pattern Matching, and Recursion in an Interpreter *)

(*
use "rational.sml";
*)

(* Adding functions and pattern matching *)
signature EVAL2 =
sig

  type ident = string

  datatype exp =
    Integer of int
  | Plus of exp * exp
  | Minus of exp * exp
  | Times of exp * exp
  | Divide of exp * exp
  | Neg of exp

  | True
  | False
  | IfThenElse of exp * exp * exp
  | Or of exp * exp
  | And of exp * exp

  | Equal of exp * exp
  | Less of exp * exp

  | Pair of exp * exp

  | Fun of match list
  | App of exp * exp

  | Let of decl list * exp
  | Var of ident

  and decl = Dec of pat * exp

  and match = Match of pat * exp

  and pat =
    VarPat of ident
  | PairPat of pat * pat
  | RatPat of Rat.rat
  | BoolPat of bool

  datatype value =
    Rational of Rat.rat
  | Boolean of bool
  | Product of value * value
  | Closure of env * exp (* must be Fun(matches) *)

  and env =
    Empty
  | Bind of env * (ident * value)

  val toString : value -> string

  exception Error of string
  val eval : env * exp -> value
  val eval' : env * decl list -> env
end;  (* signature EVAL2 *)

functor Eval2 () :> EVAL2 =
struct

  type ident = string

  datatype exp =
    Integer of int
  | Plus of exp * exp
  | Minus of exp * exp
  | Times of exp * exp
  | Divide of exp * exp
  | Neg of exp

  | True
  | False
  | IfThenElse of exp * exp * exp
  | Or of exp * exp
  | And of exp * exp

  | Equal of exp * exp
  | Less of exp * exp

  | Pair of exp * exp

  | Fun of match list
  | App of exp * exp

  | Let of decl list * exp
  | Var of ident

  and decl = Dec of pat * exp

  and match = Match of pat * exp

  and pat =
    VarPat of ident
  | PairPat of pat * pat
  | RatPat of Rat.rat
  | BoolPat of bool

  datatype value =
    Rational of Rat.rat
  | Boolean of bool
  | Product of value * value
  | Closure of env * exp (* must be Fun(matches) *)

  and env =
    Empty
  | Bind of env * (ident * value)

  exception Error of string

  fun intToString (p) =
      if p < 0 then "-" ^ Int.toString(~p) else Int.toString(p)
  fun toString' (p,1) = intToString p
    | toString' (p,q) = intToString p ^ "/" ^ intToString q
  fun toString (Rational(r)) = toString' (Rat.toInts r)
    | toString (Boolean(true)) = "true"
    | toString (Boolean(false)) = "false"
    | toString (Product(v1,v2)) = "(" ^ toString(v1) ^ "," ^ toString(v2) ^ ")"
    | toString (Closure(env,e)) = "_"

  fun lookup (x,env) =
      let fun lk (Empty) = raise Error ("Undeclared Variable")
	    | lk (Bind(env,(y,v))) = if (x = y) then v else lk env
      in lk env end

  fun theRat (Rational(r)) = r
    | theRat _ = raise Error ("Runtime Type Error")

  fun theBool (Boolean(b)) = b
    | theBool _ = raise Error ("Runtime Type Error")

  fun equal (Rational(r1),Rational(r2)) =
        (case Rat.compare(r1,r2) of EQUAL => true | _ => false)
    | equal (Boolean(b1),Boolean(b2)) = (b1 = b2)
    | equal (Closure _, Closure _) = raise Error ("Cannot pattern match functions")
    | equal _ = raise Error ("Pattern and value types disagree")

  fun evalExp (env, Integer(n)) = Rational (Rat.//(n,1))
    | evalExp (env, Plus es) = ratOp env Rat.+ es
    | evalExp (env, Minus es) = ratOp env Rat.- es
    | evalExp (env, Times es) = ratOp env Rat.* es
    | evalExp (env, Divide es) = ratOp env Rat./ es
    | evalExp (env, Neg e) = ratFun env Rat.~ e

    | evalExp (env, True) = Boolean (true)
    | evalExp (env, False) = Boolean (false)
    | evalExp (env, IfThenElse(e1,e2,e3)) =
      if theBool(evalExp(env, e1)) then evalExp (env, e2) else evalExp (env, e3)
    | evalExp (env, Or(e1,e2)) =
      Boolean (theBool(evalExp(env,e1)) orelse theBool(evalExp(env,e2)))
    | evalExp (env, And(e1,e2)) =
      Boolean (theBool(evalExp(env,e1)) andalso theBool(evalExp(env,e2)))

    | evalExp (env, Equal(e1,e2)) =
      Boolean (case Rat.compare (theRat (evalExp(env,e1)), theRat (evalExp(env,e2)))
		 of EQUAL => true
		  | _ => false)
    | evalExp (env, Less(e1,e2)) =
      Boolean (case Rat.compare (theRat (evalExp(env,e1)), theRat (evalExp(env,e2)))
		 of LESS => true
		  | _ => false)

    | evalExp (env, Pair(e1,e2)) = Product (evalExp(env,e1), evalExp(env,e2))

    | evalExp (env, e as Fun(matches)) = Closure (env, e)
    | evalExp (env, App(e1,e2)) =
      (case (evalExp(env,e1), evalExp(env,e2))
	 of (Closure(env',Fun(matches)), v2) => 
	       evalMatches (env', matches, v2)
          | _ => raise Error ("Runtime type error"))

    | evalExp (env, Let(decl,e)) =
        evalExp (evalDecl(env,decl), e)
    | evalExp (env, Var(x)) = lookup (x, env)

  (* val evalMatches : env * match list * value -> value *)
  and evalMatches (env, nil, v) = raise Error ("Unmatched value")
    | evalMatches (env, Match(pat,e)::matches, v) =
        (case matchPat(env,pat,v)
	   of NONE => evalMatches (env, matches, v)
	    | SOME(env') => evalExp (env', e))

  (* val matchPat : env * pat * value -> env option *)
  and matchPat (env,VarPat(x),v) = SOME(Bind(env,(x,v)))
    | matchPat (env,PairPat(p1,p2),Product(v1,v2)) =
        (case matchPat (env,p1,v1)
	   of NONE => NONE
	    | SOME(env') => matchPat (env',p2,v2))
    | matchPat (env,RatPat(r),Rational(r')) =
	(case Rat.compare(r,r')
	   of EQUAL => SOME(env)
	    | _ => NONE)
    | matchPat (env,BoolPat(b),Boolean(b')) =
	if b = b' then SOME(env) else NONE
    | matchPat _ = raise Error ("Runtime type error")

  (* val evalDecl : env * decl list -> env *)
  and evalDecl (env, nil) = env
    | evalDecl (env, Dec(p,e)::decls) =
      (case matchPat (env, p, evalExp (env, e))
	 of NONE => raise Error "Match failure"
	  | SOME(env') => evalDecl (env', decls))

  and ratOp env func (e1,e2) =
        Rational (func (theRat (evalExp (env,e1)), theRat (evalExp (env,e2))))

  and ratFun env func e = Rational (func (theRat (evalExp (env, e))))

  fun handleErrors func x = 
      (func x
       handle Div => raise Error ("Division by Zero")
	    | Overflow => raise Error ("Arithmetic Overflow"))

  fun eval (env, e) = handleErrors evalExp (env,e)

  fun eval' (env, decls) = handleErrors evalDecl (env, decls)

end;  (* functor Eval2 *)

structure Eval2 :> EVAL2 = Eval2 ();

(*
open Eval2;
val env1 = eval' (Empty, [Dec (VarPat("x"), Integer(3)),
			  Dec (VarPat("f"), Fun [Match(VarPat("y"),
						       Plus(Var("x"),
							    Var("y")))]),
			  Dec (VarPat("x"), Integer(4))]);
val seven = eval (env1, App(Var("f"),Var("x")));
*)

signature EVAL3 =
sig

  type ident = string

  datatype exp =
    Integer of int
  | Plus of exp * exp
  | Minus of exp * exp
  | Times of exp * exp
  | Divide of exp * exp
  | Neg of exp

  | True
  | False
  | IfThenElse of exp * exp * exp
  | Or of exp * exp
  | And of exp * exp

  | Equal of exp * exp
  | Less of exp * exp

  | Pair of exp * exp

  | Fun of match list
  | App of exp * exp

  | Let of decl list * exp
  | Var of ident

  and decl =
    Dec of pat * exp
  | Rec of ident * exp			(* new! *)

  and match = Match of pat * exp

  and pat =
    VarPat of ident
  | PairPat of pat * pat
  | RatPat of Rat.rat
  | BoolPat of bool

  datatype value =
    Rational of Rat.rat
  | Boolean of bool
  | Product of value * value
  | Closure of env * exp (* must be Fun(matches) *)

  and env =
    Empty
  | Bind of env * (ident * value)
  | RecBind of env * (ident * value)	(* new! *)

  val toString : value -> string

  exception Error of string
  val eval : env * exp -> value
  val eval' : env * decl list -> env
end;  (* signature EVAL3 *)

functor Eval3 () :> EVAL3 =
struct

  type ident = string

  datatype exp =
    Integer of int
  | Plus of exp * exp
  | Minus of exp * exp
  | Times of exp * exp
  | Divide of exp * exp
  | Neg of exp

  | True
  | False
  | IfThenElse of exp * exp * exp
  | Or of exp * exp
  | And of exp * exp

  | Equal of exp * exp
  | Less of exp * exp

  | Pair of exp * exp

  | Fun of match list
  | App of exp * exp

  | Let of decl list * exp
  | Var of ident

  and decl =
    Dec of pat * exp
  | Rec of ident * exp

  and match = Match of pat * exp

  and pat =
    VarPat of ident
  | PairPat of pat * pat
  | RatPat of Rat.rat
  | BoolPat of bool

  datatype value =
    Rational of Rat.rat
  | Boolean of bool
  | Product of value * value
  | Closure of env * exp (* must be Fun(matches) *)

  and env =
    Empty
  | Bind of env * (ident * value)
  | RecBind of env * (ident * value)

  exception Error of string

  fun intToString (p) =
      if p < 0 then "-" ^ Int.toString(~p) else Int.toString(p)
  fun toString' (p,1) = intToString p
    | toString' (p,q) = intToString p ^ "/" ^ intToString q
  fun toString (Rational(r)) = toString' (Rat.toInts r)
    | toString (Boolean(true)) = "true"
    | toString (Boolean(false)) = "false"
    | toString (Product(v1,v2)) = "(" ^ toString(v1) ^ "," ^ toString(v2) ^ ")"
    | toString (Closure(env,e)) = "_"

  fun lookup (x,env) =
      let fun lk (Empty) = raise Error ("Undeclared Variable")
	    | lk (Bind(env,(y,v))) = if (x = y) then v else lk env
	    | lk (RecBind(env, b as (y,Closure(env',f)))) =
	        (* recursively bound value must be a closure *)
	        (* here actually env = env', and f refers to y *)
	        if (x = y) then Closure(RecBind(env', b), f)
		else lk env
      in lk env end

  fun theRat (Rational(r)) = r
    | theRat _ = raise Error ("Runtime Type Error")

  fun theBool (Boolean(b)) = b
    | theBool _ = raise Error ("Runtime Type Error")

  fun equal (Rational(r1),Rational(r2)) =
        (case Rat.compare(r1,r2) of EQUAL => true | _ => false)
    | equal (Boolean(b1),Boolean(b2)) = (b1 = b2)
    | equal (Closure _, Closure _) = raise Error ("Cannot pattern match functions")
    | equal _ = raise Error ("Pattern and value types disagree")

  fun evalExp (env, Integer(n)) = Rational (Rat.//(n,1))
    | evalExp (env, Plus es) = ratOp env Rat.+ es
    | evalExp (env, Minus es) = ratOp env Rat.- es
    | evalExp (env, Times es) = ratOp env Rat.* es
    | evalExp (env, Divide es) = ratOp env Rat./ es
    | evalExp (env, Neg e) = ratFun env Rat.~ e

    | evalExp (env, True) = Boolean (true)
    | evalExp (env, False) = Boolean (false)
    | evalExp (env, IfThenElse(e1,e2,e3)) =
      if theBool(evalExp(env, e1)) then evalExp (env, e2) else evalExp (env, e3)
    | evalExp (env, Or(e1,e2)) =
      Boolean (theBool(evalExp(env,e1)) orelse theBool(evalExp(env,e2)))
    | evalExp (env, And(e1,e2)) =
      Boolean (theBool(evalExp(env,e1)) andalso theBool(evalExp(env,e2)))

    | evalExp (env, Equal(e1,e2)) =
      Boolean (case Rat.compare (theRat (evalExp(env,e1)), theRat (evalExp(env,e2)))
		 of EQUAL => true
		  | _ => false)
    | evalExp (env, Less(e1,e2)) =
      Boolean (case Rat.compare (theRat (evalExp(env,e1)), theRat (evalExp(env,e2)))
		 of LESS => true
		  | _ => false)

    | evalExp (env, Pair(e1,e2)) = Product (evalExp(env,e1), evalExp(env,e2))

    | evalExp (env, e as Fun(matches)) = Closure (env, e)
    | evalExp (env, App(e1,e2)) =
      (case (evalExp(env,e1), evalExp(env,e2))
	 of (Closure(env',Fun(matches)), v2) => 
	       evalMatches (env', matches, v2)
          | _ => raise Error ("Runtime type error"))

    | evalExp (env, Let(decl,e)) =
        evalExp (evalDecl(env,decl), e)
    | evalExp (env, Var(x)) = lookup (x, env)

  (* val evalMatches : env * match list * value -> value *)
  and evalMatches (env, nil, v) = raise Error ("Unmatched value")
    | evalMatches (env, Match(pat,e)::matches, v) =
        (case matchPat(env,pat,v)
	   of NONE => evalMatches (env, matches, v)
	    | SOME(env') => evalExp (env', e))

  (* val matchPat : env * pat * value -> env option *)
  and matchPat (env,VarPat(x),v) = SOME(Bind(env,(x,v)))
    | matchPat (env,PairPat(p1,p2),Product(v1,v2)) =
        (case matchPat (env,p1,v1)
	   of NONE => NONE
	    | SOME(env') => matchPat (env',p2,v2))
    | matchPat (env,RatPat(r),Rational(r')) =
	(case Rat.compare(r,r')
	   of EQUAL => SOME(env)
	    | _ => NONE)
    | matchPat (env,BoolPat(b),Boolean(b')) =
	if b = b' then SOME(env) else NONE
    | matchPat _ = raise Error ("Runtime type error")

  (* val evalDecl : env * decl list -> env *)
  and evalDecl (env, nil) = env
    | evalDecl (env, Dec(p,e)::decls) =
      (case matchPat (env, p, evalExp (env, e))
	 of NONE => raise Error "Match failure"
	  | SOME(env') => evalDecl (env', decls))
    | evalDecl (env, Rec(x,e as Fun(matches))::decls) =
        evalDecl (RecBind(env,(x,Closure(env,e))), decls)
    | evalDecl (env, Rec(x,e)::decls) =
	raise Error ("Recursive value not a function")

  and ratOp env func (e1,e2) =
        Rational (func (theRat (evalExp (env,e1)), theRat (evalExp (env,e2))))

  and ratFun env func e = Rational (func (theRat (evalExp (env, e))))

  fun handleErrors func x = 
      (func x
       handle Div => raise Error ("Division by Zero")
	    | Overflow => raise Error ("Arithmetic Overflow"))

  fun eval (env, e) = handleErrors evalExp (env,e)

  fun eval' (env, decls) = handleErrors evalDecl (env, decls)

end;  (* functor Eval3 *)

structure Eval3 :> EVAL3 = Eval3 ();

(*
open Eval3;

val env1 =
eval'
(Empty,
[Dec (VarPat("basis"),Integer(2)),
 Rec ("power",
      Fun [Match(RatPat(Rat.zero), Integer(1)),
	   Match(VarPat("x"),
		 Times(Var("basis"),
		       App(Var("power"),Minus(Var("x"), Integer(1)))))])]);

val k = eval (env1, App(Var("power"),Integer(10)));
val _ = print(toString(k) ^"\n");

*)