structure Lambda = struct

    structure LambdaAst = LambdaAst
    structure PP = PPrint(LambdaAst)

    exception RuntimeError of string

    local open LambdaAst in

    datatype value =
      BoolV of bool
    | NumV of int
    | ConsV of value * value
    | ContV of Cont
    | FunctionV of Cont -> Cont -> value -> value
      
    and Cont =  K of value -> value
      
    type Env = var -> value
    type Computation = Cont -> Cont -> Env -> value

    (* rho0 is the initial environment *)
    val rho0 = fn (s, _) => raise (RuntimeError ("Variable: "^s^" not bound."))

    (* K0 is the initial continuation *)
    val K0 = K (fn v => v)

    (* Kco is the initial coroutine *)
    val Kco = K (fn v => raise (RuntimeError ("Yield called outside of for")))

    (* extend : Env -> var -> value -> Env *)
    fun extend (rho : Env) (x : var) (v : value) =
      fn x' => if eqvar x x' then v else (rho x')
      
    fun evalBinop Plus  (NumV n1) (NumV n2) = NumV(n1 + n2)
      | evalBinop Times (NumV n1) (NumV n2) = NumV(n1 * n2)
      | evalBinop Minus (NumV n1) (NumV n2) = NumV(n1 - n2)
      | evalBinop Cons  v1 v2 = ConsV(v1, v2)
      | evalBinop And   (BoolV b1) (BoolV b2) = BoolV(b1 andalso b2)
      | evalBinop Or    (BoolV b1) (BoolV b2) = BoolV(b1 orelse b2)
      | evalBinop _ _ _ = raise (RuntimeError "BinOp applied to bad args.")

    fun unopToString Head = "hd"
      | unopToString Tail = "tl"
      | unopToString ZeroP = "zero?"

    fun evalUnop Head (ConsV(v1, v2)) = v1
      | evalUnop Tail (ConsV(v1, v2)) = v2
      | evalUnop ZeroP (NumV n) = BoolV(n = 0)
      | evalUnop ZeroP _ = BoolV(false)
      | evalUnop uop _ = raise (RuntimeError ("Unop "^(unopToString uop)^
					    " applied to bad args."))

    fun printVal v retn = 
      ((case v of 
	BoolV b => if b then print "#t" else print "#f"
      | NumV n => print (Int.toString n)
      | ConsV (v1, v2) => (print "(cons ";
			   printVal v1 false;
			   print " ";
			   printVal v2 false;
			   print ")")
      | _ => print "?");
      if retn then print "\n" else ())

    val yieldVar = newvar "yield"

    (* fix : (('a -> 'b) -> ('a -> 'b)) -> ('a -> 'b) *)
    fun fix f = fn x => f (fix f) x

    (* C : LambdaAst.expr -> Computation *)
    fun C e (K k) Kco rho = 
      raise (RuntimeError "Unimplemented")

    (* M : LambdaAst.expr -> value *)
    fun M e = C e K0 Kco rho0
      
    end
end



