(****************************************************************)
(* Intel Syntax Tree *)
type segment = string (* SS, DS *)

type offset =
  | Reg of string (* EAX, EBX, ECX, EDX, ESI, EDI, EBP, ESP *)
  | Imm of int
  | RegImm of string * int
  | RegValue of string

type intelMem = segment * offset

type intelId = { id_name : Id.t; mem : intelMem; id_type : Type.t }

type closure = { entry : Id.l; actual_fv : intelId list }

type intel_st =
  | Unit
  | Int of int
  | Float of float * intelMem
  | Neg of intelId  
  | Add of intelId * intelId 
  | Sub of intelId * intelId 
  | FNeg of intelId 
  | FAdd of intelId * intelId 
  | FSub of intelId * intelId 
  | FMul of intelId * intelId 
  | FDiv of intelId * intelId 
  | IfEq of intelId * intelId * intel_st * intel_st
  | IfLE of intelId * intelId * intel_st * intel_st
  | Let of intelId * intel_st * intel_st
  | Var of intelId 
  | MakeCls of intelId * closure * intel_st
  | AppCls of intelId * intelId list
  | AppDir of Id.l * intelId list
  | Tuple of intelId list
  | LetTuple of intelId list * intelId * intel_st
  | Get of intelId * intelId
  | Put of intelId * intelId * intelId
  | ExtArray of Id.l


type fundef = { name : Id.l * Type.t;
		args : intelId list; (* argument variables *)
		formal_fv : intelId list; (* free variables*)
		cv :  intelId list; (* closed variables*)
		stacksize : int; (* size of stack for local variables *)
		body : intel_st }
		
type datadef = 
	FloatData of float * int
	(*| ArrayData of { init_value : int; size : int } * int*)

type prog = Prog of datadef list * (* data *)
					fundef list * (* funtions *)
					intel_st * (* main body *)
					int * (* stack size of main body *)
					intelId list (* local variables in main body *)

(****************************************************************)
(* debugging *)
let dbg msg = output_string stdout ("*** DEBUG: " ^ msg ^ "\n")

(****************************************************************)
(* data segment structure *)
let data = ref []
let data_offset = ref 0

(****************************************************************)
(* allocate place for float *)
let alloc_float x =
	data := (FloatData(x, !data_offset) :: (!data));
	let off = !data_offset in
	data_offset := !data_offset + 8;
	("DS", Reg("float_constant" ^ (string_of_int off)))

(****************************************************************)
(* returns size of some type *)
let get_size t = match t with
	| Type.Unit -> 0
	| Type.Float -> 8
	| _ -> 4

(****************************************************************)
(* counts size of argument list *)
let rec count_size = function
	| [] -> 0
	| (_, t)::y -> match t with
				| Type.Unit -> count_size y
				| Type.Float -> 8 + (count_size y)
				| _ -> 4 + (count_size y)

(****************************************************************)
(* calculate negative offsets for arguments on stack *)
let rec negative_offsets = function
	| [], _, _ -> []
	| (x, t)::y, m, offset -> 
		(* dbgdbg ("   allocate variable " ^ x); (* debug *) *)
		( { id_name = x; mem = m (offset - (get_size t)); id_type = t } ) :: (negative_offsets (y, m, offset - (get_size t)) )

(****************************************************************)
(* calculate negative offsets for arguments on stack *)
let rec positive_offsets = function
	| [], _, _ -> []
	| (x, t)::y, m, offset -> 
		(* dbg ("   allocate variable " ^ x); (* debug *) *)
		( { id_name = x; mem = m offset; id_type = t } ) :: (positive_offsets (y, m, offset + (get_size t)) )

(****************************************************************)
(* checks if id name is in the list *)
let rec has_id = function
	| [], y -> false
	| ({ id_name = x; mem = _; id_type = _ })::a, y -> if (x == y) then true else (has_id (a, y) )

(****************************************************************)
(* finds if memory allocation in the list *)
let rec find_mem = function
	| y, [] -> 	dbg ("*** DEBUG: can not find " ^ y); (* debug *)
				assert false
	| y, ({ id_name = x; mem = _; id_type = _ } as r)::a -> 
				(*dbg ("looking for " ^ y ^ " found:" ^ x); (* debug *)*)
				if (x == y) then r else (find_mem (y, a))
				
(****************************************************************)
(* finds lowest offset of variables *)
let rec find_lowest x = function
	| [] -> x
	| ({ id_name = _; mem = (_, RegImm(_, z)); id_type = _ })::y ->
		find_lowest (if z < x then z else x) y
	| _ -> 
		dbg "*** DEBUG: wrong type of Offset in IntelMem!"; (* debug *)
		assert false
(****************************************************************)
(* returns intelMem generating function *)
let intel_memory seg reg = function x -> (seg, RegImm(reg, x))

(****************************************************************)
(* returns all closed variables in expression *)
let rec get_cv = function
	| Closure.Let (x, e1, e2) -> 
		let (name, _) = x in (*dbg ("variable found: " ^ name);*)
		(x::(get_cv e1)) @ (get_cv e2)
	| Closure.LetTuple (xs, _, e) -> xs @ (get_cv e)
	| Closure.IfEq (_, _, e1, e2) -> (get_cv e1) @ (get_cv e2)
	| Closure.IfLE (_, _, e1, e2) -> (get_cv e1) @ (get_cv e2)
	| Closure.MakeCls (x, _, e) -> 
		let (name, _) = x in (*dbg ("closure found: " ^ name);*)
		x::(get_cv e)
	| _ -> []

(****************************************************************)
(* change variables inside syntax tree *)
let rec change_intel_variables memory = function
	| Closure.Unit -> Unit
	| Closure.Int(x) -> Int(x)
	| Closure.Float(x) -> Float(x, alloc_float(x))
	| Closure.Neg(x) -> Neg(find_mem (x, memory))
	| Closure.Add(x, y) -> Add(find_mem (x, memory), find_mem (y, memory))
	| Closure.Sub(x, y) -> Sub(find_mem (x, memory), find_mem (y, memory))
	| Closure.FNeg(x) -> FNeg(find_mem (x, memory))
	| Closure.FAdd(x, y) -> FAdd(find_mem (x, memory), find_mem (y, memory))
	| Closure.FSub(x, y) -> FSub(find_mem (x, memory), find_mem (y, memory))
	| Closure.FMul(x, y) -> FMul(find_mem (x, memory), find_mem (y, memory))
	| Closure.FDiv(x, y) -> FDiv(find_mem (x, memory), find_mem (y, memory))
	| Closure.IfEq(x, y, e1, e2) -> IfEq(find_mem (x, memory), find_mem (y, memory), 
						change_intel_variables memory e1,
						change_intel_variables memory e2)
	| Closure.IfLE(x, y, e1, e2) -> IfLE(find_mem (x, memory), find_mem (y, memory), 
						change_intel_variables memory e1,
						change_intel_variables memory e2)
	| Closure.Let((x, t), e1, e2) -> 
						(*dbg ("let " ^ x); (* debug*)*)
						Let(find_mem (x, memory),
						change_intel_variables memory e1,
						change_intel_variables memory e2)
	| Closure.Var(x) -> Var(find_mem (x, memory))
	| Closure.MakeCls((x, t), { Closure.entry = centry; Closure.actual_fv = cfv }, e) ->
						MakeCls(find_mem (x, memory),
						{ entry = centry; actual_fv = List.map (fun y -> find_mem (y, memory)) cfv },
						change_intel_variables memory e)
	| Closure.AppCls(x, args) -> 
						AppCls(find_mem (x, memory), List.map (fun y -> find_mem (y, memory)) args)
	| Closure.AppDir(x, args) -> 
						AppDir(x, List.map (fun y -> find_mem (y, memory)) args)
	| Closure.Tuple(args) -> 
						Tuple(List.map (fun y -> find_mem (y, memory)) args)
	| Closure.LetTuple(args, x, e) -> 
						LetTuple(List.map (fun (y, t) -> find_mem (y, memory)) args, 
						find_mem (x, memory), 
						change_intel_variables memory e)
	| Closure.Get(x, y) -> 
						Get(find_mem (x, memory), find_mem (y, memory))
	| Closure.Put(x, y, z) -> 
						Put(find_mem (x, memory), find_mem (y, memory), find_mem (z, memory))
	| Closure.ExtArray(x) -> ExtArray(x)

(****************************************************************)
(* allocate memory for functions *)
let allocFunctionMemory { Closure.name = cname; Closure.args = cargs; Closure.formal_fv = cformal_fv; Closure.body = cbody } =
	let (Id.L(fname),_) = cname in
	let full_ftype = Type.Fun (List.map (fun (x, t)->t) cargs, let (_,a) = cname in a) in
	
	(* dbg ("allocFunctioMemory " ^ (fname)); (* debug *) *)
	
	(* dbg ("allocate arguments:"); (* debug *)*)
	let arg_offsets = positive_offsets (cargs, (intel_memory "SS" "EBP"), 8 ) in
	
	(*dbg ("allocate free variables:"); (* debug *)*)
	let fv_offsets = positive_offsets (cformal_fv, (intel_memory "DS" "ESI"), 4 ) in
	
	(*dbg ("allocate local variables:"); (* debug *)*)
	let cv_offsets = negative_offsets ((get_cv cbody), (intel_memory "SS" "EBP"), 0 ) in
	
	let self_closure = { id_name = fname; id_type = full_ftype; mem = ("CS", RegValue("ESI"))} in	(* need self closure for self recursion *)
	
	let memory = arg_offsets @ fv_offsets @ cv_offsets @ [self_closure] in
	let new_body = change_intel_variables memory cbody 
	in { 
		name = cname; 
		args = arg_offsets;
		formal_fv = fv_offsets;
		cv = cv_offsets;
		stacksize = - (find_lowest 0 cv_offsets);
		body = new_body; }

(****************************************************************)
(* allocate memory for each variable *)
let rec addIntelVariables (Closure.Prog(fundefs, e)) =
	data := [];
	data_offset := 0;
	let intel_fundefs = List.map allocFunctionMemory fundefs in
	let cv = get_cv e in
	let cv_offsets = negative_offsets (cv, (intel_memory "SS" "EBP"), 0) in
	let new_body = change_intel_variables cv_offsets e in
	let stacksize = count_size cv in	
	Prog(!data, intel_fundefs, new_body, stacksize, cv_offsets)
