
let indent = "   " 

let os = output_string 

let rec osl oc sep = function 
  | [] -> () 
  | [t] -> os oc t 
  | t :: rest -> (os oc t ; os oc sep; osl oc sep rest)


let rec output_type oc = function 
  | Type.Unit -> os oc "unit"
  | Type.Bool -> os oc "bool"
  | Type.Int -> os oc "int"
  | Type.Float -> os oc "float"
  | Type.Fun (tl, t) -> (os oc "("; output_type_list oc tl; os oc ") -> "; output_type oc t) 
  | Type.Tuple tl -> (os oc "("; output_type_list oc tl; os oc ")") 
  | Type.Array t -> (output_type oc t; os oc " array") 
  | Type.Var _ -> os oc "TYPE_VARIABLE"
and output_type_list oc = function 
  | [] -> () 
  | [t] -> output_type oc t 
  | t:: rest -> (output_type oc t; os oc ", "; output_type_list oc rest) 

let ot oc = function 
    | Type.Var _ -> () 
    | t -> (os oc " : "; output_type oc t) 

let rec spl oc sep = function 
  | [] -> () 
  | [(i, t)] -> (os oc i; ot oc t) 
  | (i, t)::rest -> (os oc i; ot oc t; os oc sep ; spl oc sep rest) 

let rec sa oc left = function 
  | Syntax.Unit -> os oc "()"
  | Syntax.Bool b -> os oc (string_of_bool b) 
  | Syntax.Int i -> os oc (string_of_int i) 
  | Syntax.Float f -> os oc (string_of_float f) 
  | Syntax.Not t -> (os oc "not("; sa oc left t; os oc ")") 
  | Syntax.Neg t -> (os oc "I.neg("; sa oc left t; os oc ")") 
  | Syntax.Add (t1, t2) -> (os oc "("; sa oc left t1; os oc " + ";  sa oc left t2; os oc ")")  
  | Syntax.Sub (t1, t2) -> (os oc "("; sa oc left t1; os oc " - ";  sa oc left t2; os oc ")")  
  | Syntax.FNeg t -> (os oc "F.neg("; sa oc left t; os oc ")") 
  | Syntax.FAdd (t1, t2) -> (os oc "("; sa oc left t1; os oc " +. ";  sa oc left t2; os oc")")  
  | Syntax.FSub (t1, t2) -> (os oc "("; sa oc left t1; os oc " -. ";  sa oc left t2; os oc ")")  
  | Syntax.FMul (t1, t2) -> (os oc "("; sa oc left t1; os oc " *. ";  sa oc left t2; os oc ")")  
  | Syntax.FDiv (t1, t2) -> (os oc "("; sa oc left t1; os oc " /. ";  sa oc left t2; os oc ")")  
  | Syntax.Eq (t1, t2) -> (os oc "("; sa oc left t1; os oc " = ";  sa oc left t2; os oc ")")  
  | Syntax.LE (t1, t2) -> (os oc "("; sa oc left t1; os oc " <= ";  sa oc left t2; os oc ")")  
  | Syntax.If (t1, t2, t3) -> 
     (os oc ("\n" ^ left ^ "if "); 
      sa oc left t1; 
      os oc ("\n" ^ left ^ "then "); 
      sa oc (indent ^ left) t2; 
      os oc ("\n" ^ left ^ "else "); 
      sa oc (indent ^ left) t3
     )
  | Syntax.Let ((i, t3), t1, t2) -> 
     (os oc ("\n" ^ left ^ "let " ^ i ^ " "); 
      ot oc t3; 
      os oc " = "; 
      sa oc left t1; 
      os oc ("\n" ^ left ^ "in "); 
      sa oc (indent ^ left) t2
     )
  | Syntax.Var i -> os oc i
  | Syntax.LetRec(fd, t) -> 
   let (i, ty) = fd.Syntax.name in 
     (os oc ("\n" ^ left ^ "let rec " ^ i ^ " "); 
      ot oc ty; 
      os oc " "; 
      spl oc " " fd.Syntax.args; 
      os oc " = "; 
      sa oc (indent ^ left) fd.Syntax.body; 
      os oc ("\n" ^ left ^ "in "); 
      sa oc (indent ^ left) t
     )
  | Syntax.App (t, tl) -> (os oc "("; sa oc left t; os oc " "; sal oc left " " tl; os oc ")") 
  | Syntax.Tuple tl -> (os oc "("; sal oc left ", " tl; os oc ")")  
  | Syntax.LetTuple (pl, t1, t2) -> 
     (os oc ("\n" ^ left ^ "let "); 
      spl oc ", " pl; 
      os oc " = "; 
      sa oc left t1; 
      os oc ("\n" ^ left ^ "in "); 
      sa oc (indent ^ left) t2
     )
  | Syntax.Array (t1, t2) -> (os oc "Array.create "; sa oc left t1; os oc " "; sa oc left t2) 
  | Syntax.Get (t1, t2) -> (sa oc left t1; os oc ".("; sa oc left t2; os oc ")") 
  | Syntax.Put (t1, t2, t3) -> (sa oc left t1; os oc ".("; sa oc left t2; os oc ") <- "; sa oc left t3) 
and sal oc left sep = function 
  | [] -> () 
  | [t] -> sa oc left t 
  | t :: rest -> (sa oc left t ; os oc sep; sal oc left sep rest)

(* 
val syntax : out_channel -> Syntax.t -> unit 
*) 
let syntax oc t = sa oc "" t 



(* 
val knormal : out_channel -> KNormal.t -> unit 
*) 


let rec ka oc nested left = function 
  | KNormal.Unit -> os oc "()"
  | KNormal.Int i -> os oc (string_of_int i) 
  | KNormal.Float f -> os oc (string_of_float f) 
  | KNormal.Neg i -> (os oc "I.neg("; os oc i; os oc ")") 
  | KNormal.Add (t1, t2) -> (os oc "("; os oc t1; os oc " + ";  os oc t2; os oc ")")  
  | KNormal.Sub (t1, t2) -> (os oc "("; os oc t1; os oc " - ";  os oc t2; os oc ")")  
  | KNormal.FNeg i -> (os oc "F.neg("; os oc i; os oc ")") 
  | KNormal.FAdd (t1, t2) -> (os oc "("; os oc t1; os oc " +. ";  os oc t2; os oc ")")  
  | KNormal.FSub (t1, t2) -> (os oc "("; os oc t1; os oc " -. ";  os oc t2; os oc ")")  
  | KNormal.FMul (t1, t2) -> (os oc "("; os oc t1; os oc " *. ";  os oc t2; os oc ")")  
  | KNormal.FDiv (t1, t2) -> (os oc "("; os oc t1; os oc " /. ";  os oc t2; os oc ")")  
  | KNormal.IfEq (i1, i2, t2, t3) -> 
     (os oc ("\n" ^ left ^ "if " ^ i1 ^ " = " ^ i2 ^ " "); 
      os oc ("\n" ^ left ^ "then "); 
      ka oc false (indent ^ left) t2; 
      os oc ("\n" ^ left ^ "else "); 
      ka oc false (indent ^ left) t3
     )
  | KNormal.IfLE (i1, i2, t2, t3) -> 
     (os oc ("\n" ^ left ^ "if " ^ i1 ^ " <= " ^ i2 ^ " "); 
      os oc ("\n" ^ left ^ "then "); 
      ka oc false (indent ^ left) t2; 
      os oc ("\n" ^ left ^ "else "); 
      ka oc false (indent ^ left) t3
     )
  | KNormal.Let((i, t3), t1, t2) -> 
     ((if nested then () else os oc ("\n" ^ left)); 
      os oc ("let " ^ i ^ " "); 
      ot oc t3; 
      os oc " = "; 
      ka oc true left t1; 
      os oc " in\n"; 
      os oc left ; 
      ka oc false left t2
     )
  | KNormal.Var i -> os oc i 
  | KNormal.LetRec(fd, t) -> 
   let (i, ty) = fd.KNormal.name in 
     (os oc ("\n" ^ left ^ "let " ^ i ^ " "); 
      ot oc ty; 
      spl oc " " fd.KNormal.args; 
      os oc " = "; 
      ka oc false (indent ^ left)  fd.KNormal.body; 
      os oc ("\n" ^ left ^ "in "); 
      ka oc false (indent ^ left) t
     )
  | KNormal.App (t, tl) -> (os oc "("; os oc t; os oc " "; osl oc " " tl; os oc ")") 
  | KNormal.Tuple tl -> (os oc "("; osl oc ", " tl; os oc ")") 
  | KNormal.LetTuple (pl, t1, t2) -> 
     ((if nested then () else os oc ("\n" ^ left)); 
      os oc "let "; 
      spl oc ", " pl; 
      os oc " = "; 
      os oc t1; 
      os oc " in\n"; 
      os oc left ; 
      ka oc false (indent ^ left) t2

     )
  | KNormal.Get (t1, t2) -> (os oc t1; os oc ".("; os oc t2; os oc ")") 
  | KNormal.Put (t1, t2, t3) -> (os oc t1; os oc ".("; os oc t2; os oc ") <- "; os oc t3) 
  | KNormal.ExtArray i -> (os oc "ARRAY?("; os oc i; os oc ")") 
  | KNormal.ExtFunApp (t, tl) -> (os oc "EXTERN("; os oc t; os oc " "; osl oc " " tl; os oc ")") 

let knormal oc t = ka oc false "" t 

(* 
val closure : out_channel -> Closure.prog -> unit 

*) 

let ol oc = function | Id.L i -> os oc ("LABEL(" ^ i ^ ")")

let rec ca oc nested left = function 
  | Closure.Unit -> os oc "()"
  | Closure.Int i -> os oc (string_of_int i) 
  | Closure.Float f -> os oc (string_of_float f)  
  | Closure.Neg  i -> (os oc "I.neg("; os oc i; os oc ")") 
  | Closure.Add (t1, t2) -> (os oc "("; os oc t1; os oc " + ";  os oc t2; os oc ")")  
  | Closure.Sub (t1, t2) -> (os oc "("; os oc t1; os oc " - ";  os oc t2; os oc ")")  
  | Closure.FNeg i -> (os oc "F.neg("; os oc i; os oc ")")  
  | Closure.FAdd (t1, t2) -> (os oc "("; os oc t1; os oc " +. ";  os oc t2; os oc ")")  
  | Closure.FSub (t1, t2) -> (os oc "("; os oc t1; os oc " -. ";  os oc t2; os oc ")")  
  | Closure.FMul (t1, t2) -> (os oc "("; os oc t1; os oc " *. ";  os oc t2; os oc ")")  
  | Closure.FDiv (t1, t2) -> (os oc "("; os oc t1; os oc " /. ";  os oc t2; os oc ")")  
  | Closure.IfEq (i1, i2, t2, t3) -> 
     (os oc ("\n" ^ left ^ "if " ^ i1 ^ " = " ^ i2 ^ " "); 
      os oc ("\n" ^ left ^ "then "); 
      ca oc false (indent ^ left) t2; 
      os oc ("\n" ^ left ^ "else "); 
      ca oc false (indent ^ left) t3
     )
  | Closure.IfLE (i1, i2, t2, t3) -> 
     (os oc ("\n" ^ left ^ "if " ^ i1 ^ " <= " ^ i2 ^ " "); 
      os oc ("\n" ^ left ^ "then "); 
      ca oc false (indent ^ left) t2; 
      os oc ("\n" ^ left ^ "else "); 
      ca oc false (indent ^ left) t3
     )
  | Closure.Let((i, t3), t1, t2) -> 
     ((if nested then () else os oc ("\n" ^ left)); 
      os oc ("let " ^ i ^ " "); 
      ot oc t3; 
      os oc " = "; 
      ca oc true left t1; 
      os oc " in\n"; 
      os oc left ; 
      ca oc false left t2
     )
  | Closure.Var i -> os oc i 
  | Closure.MakeCls ((i, ty), cl, t) -> 
     (os oc ("\n" ^ left ^ "let closure " ^ i ^ " "); 
      ot oc ty; 
      os oc " = ( "; 
      ol oc cl.Closure.entry; 
      os oc "; "; 
      os oc "["; 
      osl oc ", " cl.Closure.actual_fv; 
      os oc "]"; 
      os oc " )"; 
      os oc ("\n" ^ left ^ "in "); 
      ca oc false (indent ^ left) t
     )
  | Closure.AppCls (t, tl) -> (os oc "APPLY_CLOSURE("; os oc t; os oc " "; osl oc " " tl; os oc ")") 
  | Closure.AppDir (l, tl) -> (os oc "APPLY_DIRECT("; ol oc l; os oc " "; osl oc " " tl; os oc ")") 
  | Closure.Tuple tl -> (os oc "("; osl oc ", " tl; os oc ")") 
  | Closure.LetTuple (pl, t1, t2) -> 
     (os oc ("\n" ^ left ^ "let "); 
      spl oc ", " pl; 
      os oc " = "; 
      os oc t1; 
      os oc " in\n"; 
      os oc left ; 
      ca oc false left t2
     )
  | Closure.Get (t1, t2) -> (os oc t1; os oc ".("; os oc t2; os oc ")") 
  | Closure.Put (t1, t2, t3) -> (os oc t1; os oc ".("; os oc t2; os oc ") <- "; os oc t3) 
  | Closure.ExtArray i -> (os oc "ARRAY?("; ol oc i; os oc ")") 
and ofd oc fd = 
   let (l, ty) = fd.Closure.name
   in let al = fd.Closure.args
   in let fl = fd.Closure.formal_fv
   in let t = fd.Closure.body 
   in (os oc "let "; 
       ol oc l; 
       os oc " " ; 
       os oc "[";
       spl oc ", " fl; 
       os oc "] ";
(* 
       ot oc ty; 
       os oc " " ; 
*) 
       spl oc ", " al; 
       os oc " = "; 
       ca oc false indent t; 
       os oc "\nin\n"; 
      )

let rec ofdl oc = function 
  | [] -> () 
  | [fd] -> ofd oc fd 
  | fd :: rest -> (ofd oc fd; os oc "\n"; ofdl oc rest)

let closure oc (Closure.Prog(fdl, t)) = (ofdl oc fdl; ca oc false "" t) 

(* 
val abs_asm : out_channel -> AbstractAsm.prog -> unit 
*) 

let oidm oc = function | SparcAsm.V id -> os oc id | SparcAsm.C i -> os oc (string_of_int i)

let rec tsa oc left = function 
  | SparcAsm.Ans exp -> 
    (os oc ("\n" ^ left ^ "ANSWER("); 
     ssa oc (indent ^ left) exp; 
     os oc ")"
    )
  | SparcAsm.Let ((id, ty), exp, t) -> 
      (os oc ("\n" ^ left ^ "LET("); 
       os oc id; 
       os oc ", "; 
       ssa oc (indent ^ left) exp; 
       os oc ", "; 
       tsa oc (indent ^ left) t; 
       os oc ")"
      )
  | SparcAsm.Forget (id, t) -> 
      (os oc ("\n" ^ left ^ "FORGET("); 
       os oc id; 
       os oc ", "; 
       tsa oc (indent ^ left) t; 
       os oc ")"
    )

and ssa oc left = function 
  | SparcAsm.Nop -> os oc "nop"; 
  | SparcAsm.Set i -> os oc ("set(" ^ (string_of_int i) ^ ")")
  | SparcAsm.SetL l -> (os oc "set("; ol oc l; os oc ")")
  | SparcAsm.Mov id -> os oc ("mov(" ^ id ^ ")")
  | SparcAsm.Neg id -> os oc ("neg(" ^ id ^ ")")
  | SparcAsm.Add (id, idm) -> (os oc "add("; os oc id; os oc ", "; oidm oc idm; os oc ")")
  | SparcAsm.Sub (id, idm) -> (os oc "sub("; os oc id; os oc ", "; oidm oc idm; os oc ")")
  | SparcAsm.SLL (id, idm) -> (os oc "sub("; os oc id; os oc ", "; oidm oc idm; os oc ")")
  | SparcAsm.Ld (id, idm) -> (os oc "ld("; os oc id; os oc ", "; oidm oc idm; os oc ")")
  | SparcAsm.St (id1, id2, idm) -> (os oc "st("; os oc id1; os oc ", "; os oc id2; os oc ", "; oidm oc idm; os oc ")")
  | SparcAsm.FMovD id -> os oc ("fmovd(" ^ id ^ ")")
  | SparcAsm.FNegD id -> os oc ("fnegd(" ^ id ^ ")")
  | SparcAsm.FAddD (id1, id2) -> (os oc "fadd("; os oc id1; os oc ", "; os oc id2; os oc ")")
  | SparcAsm.FSubD (id1, id2) -> (os oc "fsub("; os oc id1; os oc ", "; os oc id2; os oc ")")
  | SparcAsm.FMulD (id1, id2) -> (os oc "fmul("; os oc id1; os oc ", "; os oc id2; os oc ")")
  | SparcAsm.FDivD (id1, id2) -> (os oc "fdiv("; os oc id1; os oc ", "; os oc id2; os oc ")")
  | SparcAsm.LdDF (id, idm) -> (os oc "LdDF("; os oc id; os oc ", "; oidm oc idm; os oc ")")
  | SparcAsm.StDF (id1, id2, idm) -> (os oc "StDF("; os oc id1; os oc ", "; os oc id2; os oc ", "; oidm oc idm; os oc ")")
  | SparcAsm.Comment s -> os oc ("   ! " ^ s ^ "\n")
  (* virtual instructions *)
  | SparcAsm.IfEq (id, idm, t1, t2) -> 
      (os oc ("\n" ^ left ^ "IfEq("); 
       os oc id; 
       os oc ", "; 
       oidm oc idm; 
       os oc ", "; 
       tsa oc (indent ^ left) t1; 
       os oc ", "; 
       tsa oc (indent ^ left) t2; 
       os oc ")"
     ) 
  | SparcAsm.IfLE (id, idm, t1, t2) -> 
      (os oc ("\n" ^ left ^ "IfLE("); 
       os oc id; 
       os oc ", "; 
       oidm oc idm; 
       os oc ", "; 
       tsa oc (indent ^ left) t1; 
       os oc ", "; 
       tsa oc (indent ^ left) t2; 
       os oc ")"
     )
  | SparcAsm.IfGE (id, idm, t1, t2) -> 
      (os oc ("\n" ^ left ^ "IfGE("); 
       os oc id; 
       os oc ", "; 
       oidm oc idm; 
       os oc ", "; 
       tsa oc (indent ^ left) t1; 
       os oc ", "; 
       tsa oc (indent ^ left) t2; 
       os oc ")"
     )
  | SparcAsm.IfFEq (id1, id2, t1, t2) -> 
      (os oc ("\n" ^ left ^ "IfFEq("); 
       os oc id1; 
       os oc ", "; 
       os oc id2; 
       os oc ", "; 
       tsa oc (indent ^ left) t1; 
       os oc ", "; 
       tsa oc (indent ^ left) t2; 
       os oc ")"
     )
  | SparcAsm.IfFLE (id1, id2, t1, t2) -> 
      (os oc ("\n" ^ left ^ "IfFLE("); 
       os oc id1; 
       os oc ", "; 
       os oc id2; 
       os oc ", "; 
       tsa oc (indent ^ left)t1; 
       os oc ", "; 
       tsa oc (indent ^ left) t2; 
       os oc ")"
     )
  (* closure address, integer arguments, and float arguments *)
  | SparcAsm.CallCls (id, idl1, idl2) -> 
      (os oc "CallClosure("; 
       os oc id; 
       os oc ", "; 
       os oc "args=("; 
       osl oc ", " idl1; 
       os oc ")"; 
       os oc ", "; 
       os oc "farg=("; 
       osl oc ", " idl2; 
       os oc "))"
       )
  | SparcAsm.CallDir (l, idl1, idl2) -> 
      (os oc "CallDirect("; 
       ol oc l; 
       os oc ", "; 
       os oc "args=("; 
       osl oc ", " idl1; 
       os oc ")"; 
       os oc ", "; 
       os oc "farg=("; 
       osl oc ", " idl2; 
       os oc "))"
       )
  | SparcAsm.Save (id1, id2) -> (os oc "save("; os oc id1; os oc ", "; os oc id2; os oc ")")
  | SparcAsm.Restore id -> os oc ("restore(" ^ id ^ ")")

and ofundef oc fundef = 
      (os oc "\n"; 
       ol oc fundef.SparcAsm.name; 
(* 
       os oc "\n"; 
       os oc "return type = "; 
       ot oc fundef.SparcAsm.ret; 
       os oc "\n"; 
*) 
       os oc " (arg=("; 
       osl oc ", " fundef.SparcAsm.args; 
       os oc "), farg=("; 
       osl oc ", " fundef.SparcAsm.fargs; 
       os oc "))\n"; 
       tsa oc "" fundef.SparcAsm.body; 
       os oc "\n"
       )

external gethi : float -> int32 = "gethi"
external getlo : float -> int32 = "getlo"

let abs_asm oc (SparcAsm.Prog(data, fundefl, a)) = 
  os oc "==== Data Segment =======\n"; 
  List.iter
    (fun (Id.L(x), d) ->
      Printf.fprintf oc "%s:\t! %f\n" x d;
      Printf.fprintf oc "\t.long\t0x%lx\n" (gethi d);
      Printf.fprintf oc "\t.long\t0x%lx\n" (getlo d))
    data;
  os oc "==== Function Declarations =======\n"; 
  List.iter (fun fundef -> ofundef oc fundef) fundefl;
  os oc "==== Expression =======\n"; 
  tsa oc "" a;
  os oc "\n"
