(* Compiler  Lambda -> Kombinatorlogik *)
datatype comb = I|K|S|B|C|Y|
                CONS|HD|TL|
                PLUS|MINUS|TIMES|DIV|
                IF|EQ|AND|OR|NOT|
                WAIT|WAIT1|COPY|
                PR|PAR|SET|
                DEF of string;
datatype value = int of int|
                 re of real|
                 bool of bool;
datatype snode = satom of value
                |scomb of comb
                |sapp of (snode*snode);
exception Doublebind
fun abs x (Free y) = Apply(Op "K",(Free y))
   |abs x (Bound y) = if x=y then Op("I") else Apply(Op "K",(Bound y))
   |abs x (Int y) = Apply(Op "K",Int y)
   |abs x (Op y) = Apply(Op "K",Op y)
   |abs x (Abs(y,body)) = abs x (abs y body)
   |abs x (Apply(a,b)) =
         Apply(Apply(Op "S",abs x a),
                    (abs x b));
fun mkComb "I" = I
   |mkComb "K" = K
   |mkComb "S" = S
   |mkComb "B" = B
   |mkComb "C" = C
   |mkComb "Y" = Y
   |mkComb "CONS" = CONS
   |mkComb "HD" = HD
   |mkComb "TL" = TL
   |mkComb "ADD" = PLUS
   |mkComb "SUB" = MINUS
   |mkComb "MUL" = TIMES
   |mkComb "DIV" = DIV
   |mkComb "IF" = IF
   |mkComb "EQ" = EQ
   |mkComb "AND" = AND
   |mkComb "OR" = OR
   |mkComb "NOT" = NOT
   |mkComb "PR" = PR
   |mkComb str = DEF str;
exception Compile;
fun c (Free a) = sapp(scomb(DEF a),satom(int 0))
   |c (Bound a) = raise Compile 
   |c (Int a) = satom(int a)
   |c (Op k) = scomb(mkComb k)
   |c (Apply(a,b)) = sapp(c a,c b)
   |c (Abs(x,body)) = c (abs x body);
fun opt (sapp(sapp(scomb S,sapp(scomb K,e)),scomb I)) = (e : snode)
   |opt (sapp(sapp(scomb S,sapp(scomb K,e1)),sapp(scomb K,e2))) =
       sapp(scomb K,sapp(e1,e2))
   |opt (sapp(sapp(scomb S,sapp(scomb K,e1)),e2)) =
       sapp(sapp(scomb B,e1),e2)
   |opt (sapp(sapp(scomb S,e1),sapp(scomb K,e2))) =
       sapp(sapp(scomb C,e1),e2)
   |opt (sapp(e1,e2)) = sapp(opt e1,opt e2)
   |opt x = x;
fun ropt x =
 let
  val y = opt x;
 in 
  if y=x then x
  else ropt y
 end;
 fun k2string I = "I"
   |k2string K = "K"
   |k2string S = "S"
   |k2string B = "B"
   |k2string C = "C"
   |k2string Y = "Y"
   |k2string CONS = "CONS"
   |k2string HD = "HD"
   |k2string TL = "TL"
   |k2string PLUS = "PLUS"
   |k2string MINUS = "MINUS"
   |k2string TIMES = "TIMES"
   |k2string DIV = "DIV"
   |k2string IF = "IF"
   |k2string EQ = "EQ"
   |k2string AND = "AND"
   |k2string OR = "OR"
   |k2string NOT = "NOT"
   |k2string WAIT = "WAIT"
   |k2string WAIT1 = "WAIT1"
   |k2string COPY = "COPY"
   |k2string PR = "PR"
   |k2string PAR = "SET"
   |k2string (DEF(name)) = name;
fun isapp (sapp _) = true
   |isapp _ = false;
fun show (satom (int n)) = makestring n
   |show (satom (re x)) =makestring x
   |show (satom (bool w)) = makestring w
   |show (scomb k) = k2string k
   |show (sapp (rator,rand)) = (show rator)^" "^(if (isapp rand) 
				then "("^(show rand)^")"
				else (show rand));