structure LambdaAst : LAMBDA_AST = struct

  type var = string * int
  fun eqvar (_,i1) (_, i2) = i1 = i2


  (* Syntactic Constructs *)

  datatype binop =
    Plus
  | Times
  | Minus
  | Cons
  | And
  | Or

  datatype unop = 
    Head
  | Tail
  | ZeroP

  datatype expr =
    Var of var
  | True
  | False
  | Num of int
  | Binop of binop * expr * expr
  | Unop of unop * expr
  | If of expr * expr * expr
  | Lambda of var * expr
  | App of expr * expr
  | Letrec of var * expr  * expr  (* letrec (f (fn x => e1)) e2) *)
  | For of var * expr * expr
  | Yield of expr
  | Print of expr

  exception Bad
  val vctr = ref 0
  fun newvar s = let 
    val v = !vctr 
    val _ = vctr := v+1
  in
    (s, v)
  end

  exception LetrecNotFunction

  fun alpha_vary expr = 
    let
      fun add ctxt str i = (str, i)::ctxt
      fun lookup x [] = raise Bad
	| lookup x ((str, i)::rest) = if x = str then (str, i) else
	lookup x rest
      fun bindnew (str, _) ctxt=
	let val (_, i) = newvar str in
	  ((str, i), add ctxt str i)
	end

      fun alpha ctxt e =
	case e of
	  Var (str, i) => (Var(lookup str ctxt) handle Bad => Var(str, i))
	| If (e1, e2, e3) =>
	    If (alpha ctxt e1, alpha ctxt e2, alpha ctxt e3)
	| Lambda (v, e) => 
	    let val (v', ctxt') = bindnew v ctxt in
	      Lambda(v', alpha ctxt' e)
	    end
	| App (e1, e2) => App(alpha ctxt e1, alpha ctxt e2)
	| Letrec (v, (Lambda (x, e1)), e2) => 
	    let 
	      val (v', ctxt') = bindnew v ctxt
	    in
	      Letrec(v', alpha ctxt' (Lambda (x, e1)), alpha ctxt' e2)
	    end
	| Letrec _ => raise LetrecNotFunction
	| Binop (b, e1, e2) => Binop (b, alpha ctxt e1, alpha ctxt e2)
	| Unop (u, e) => Unop(u, alpha ctxt e)
	| For (v, e1, e2) => 
	    let
	      val (v', ctxt') = bindnew v ctxt
	    in
	      For (v', alpha ctxt e1, alpha ctxt' e2)
	    end
	| Yield e => Yield (alpha ctxt e)
	| Print e => Print (alpha ctxt e)
	| e => e
    in
      alpha [] expr
    end

end
