(* Code generation: translate takes a semantically checked AST and
produces LLVM IR

LLVM tutorial: Make sure to read the OCaml version of the tutorial

http://llvm.org/docs/tutorial/index.html

Detailed documentation on the OCaml LLVM library:

http://llvm.moe/
http://llvm.moe/ocaml/

*)

exception TODO of string
exception COMPILE_ERROR of string

module L = Llvm
module A = Ast
module S = Sast
module Sm = Semant
open Stack


type 'a vi = Free of 'a | Bound of 'a
type tensordim = Recurse of L.llvalue * (tensordim list) | Base of L.llvalue


module StringMap = Map.Make(String)
module IntMap = Map.Make(struct type t = int let compare = compare end)

type typv_wrapper = Primitive of L.lltype | Complex of int


module FoldStack = 
   struct
	type 'a t = { mutable c : 'a list; mutable len : int; }
	exception Empty
	let create () = { c = []; len = 0; }
	let clear s = s.c <- []; s.len <- 0
	let copy s = { c = s.c; len = s.len; }
	let push x s = s.c <- x :: s.c; s.len <- s.len + 1
	let pop s =
	  match s.c with
	  | hd::tl -> s.c <- tl; s.len <- s.len - 1; hd
	  | []     -> raise Empty
	let top s =
	  match s.c with
	  | hd::_ -> hd
	  | []     -> raise Empty
	let is_empty s = (s.c = [])
	let length s = s.len
	let iter f s = List.iter f s.c
	let fold f acc s = List.fold_left f acc s.c
   end ;;





let rec get_free_spec_list cntr =
    match cntr with
       0 -> []
      | _  -> (Free 0)::get_free_spec_list (cntr - 1)

let rec typify_as_int_access strs =
   match strs with
      x::xs -> (S.Id ("", S.Int, x))::typify_as_int_access xs
     |[] -> []

let rec add_with_identity l1 m =
    match l1 with
        x::xs -> if StringMap.mem x m then add_with_identity xs m
	         else add_with_identity xs (StringMap.add x 1 m)
       | [] -> m

let diff l1 l2 = List.filter (fun x -> not (List.mem x l2)) l1

let rec add_with_count l1 m =
    match l1 with
        x::xs -> if StringMap.mem x m then add_with_count xs (StringMap.add x ((StringMap.find x m)+1) m)
	         else add_with_count xs (StringMap.add x 1 m)
       | [] -> m

let remove_dups sl1 sl2 =
    let m = add_with_identity sl1 StringMap.empty in
    let m = add_with_identity sl2 m in

    List.map (fun (x,y) -> x) (StringMap.bindings (StringMap.filter (fun y x -> x == 1) m))

let remove_dups_eqone sl1 sl2 =
    let m = add_with_count sl1 StringMap.empty in
    let m = add_with_count sl2 m in

    List.map (fun (x,y) -> x) (StringMap.bindings (StringMap.filter (fun y x -> x == 1) m))

let rec extract_strings slist =
    match slist with
       [] -> []
      |x::xs -> (match x with S.Id (_, _, s) -> s::extract_strings xs | _ -> extract_strings xs)

let rec extract_tmult_info_helper e1 =
    match e1 with
        S.TensorId (_, _, _, sq) -> extract_strings sq
      | S.TensorAssign (_, _, _, sq, _) -> extract_strings sq
      | S.Binop (_, _, l, Ast.Mult, r) -> let (ls, rs) = extract_tmult_info l r in
            remove_dups_eqone ls rs
      | _ -> raise (Exceptions.CodegenException)
and
extract_tmult_info e1 e2 =
    let left = extract_tmult_info_helper e1 in
    let right = extract_tmult_info_helper e2 in

    (left, right)


let rec make_slice_idx_copy_map vis sctr dctr map =
    match vis with
        Free _::xs -> let newmap = (IntMap.add sctr dctr map) in
	               make_slice_idx_copy_map xs (sctr + 1) (dctr + 1) newmap
       |Bound _::xs -> make_slice_idx_copy_map xs sctr (dctr+1) map
       |[] -> map

let all_free xs =
    List.for_all (fun x -> match x with Free _ -> true | _ -> false) xs

let all_bound xs =
    List.for_all (fun x -> match x with Bound _ -> true | _ -> false) xs

let num_free xs =
    List.length (List.filter (fun x -> match x with Free _ -> true | _ -> false) xs)

let strip_vis xs =
    List.map (fun x -> match x with Bound y -> y | Free y -> y) xs

let get_free xs =
    strip_vis (List.filter (fun x -> match x with Free _ -> true | _ -> false) xs)

let rec add_vis xs vis =
    match (xs, vis) with
        (x::xs, y::ys) -> 
            (match y with Bound _ -> (Bound x)::(add_vis xs ys) |
              Free _ -> (Free x)::(add_vis xs ys))
      | ([], []) -> []
      | _ -> raise (Exceptions.CodegenException)

let get_first xs =
    match xs with
       x::xs -> x 
     | [] -> raise (COMPILE_ERROR "argument list empty")

let get_dim t =
    match t with 
        S.Tensor x -> x
       |_ -> raise (COMPILE_ERROR "Not a tensor?")

let rec get_vis_dummy_slist dim = 
    match dim with
       0 -> []
     |_ -> (S.Id ("", S.Int, "_DONOTUSE_WOW_"))::get_vis_dummy_slist (dim-1)

let translate program =
  let context = L.global_context () in
  let the_module = L.create_module context "LaTenS"
  and i32_t  = L.i32_type  context
  and i8_t   = L.i8_type   context
  and i1_t   = L.i1_type   context
  and i64_t  = L.i64_type context
  and void_t = L.void_type context
  and f64_t = L.double_type context
  and cstr_t = L.pointer_type (L.i8_type context)
  and i64p_t = L.pointer_type (L.i64_type context)
  and f64p_t = L.pointer_type (L.double_type context) in
  (* We need special building types for the tensor stuff. but this
     wrapper function currently gets us the primitive types we support
     at this moment *)

	let rec gen_pointer_map hdr acc uniq m cntr =
	    match acc with
		[] -> m
	       |x::xs -> if not (StringMap.mem x uniq) then 
		 gen_pointer_map hdr xs uniq m (cntr + 1)
		 else
		 gen_pointer_map hdr xs uniq ((L.build_add hdr (L.const_int i64_t (8 * (cntr + 1))) "hdrcpycalc")::m) (cntr + 1) in

	let gen_pointer_map_wrap hdr1 hdr2 acc1 acc2 uniq =
	    let pmap1 = List.rev (gen_pointer_map hdr1 acc1 uniq [] 0) in
	    let pmap2 = List.rev (gen_pointer_map hdr2 acc2 uniq [] 0) in
	    pmap1@pmap2 in
	
	let rec filter_sizes_by_pmap acc sizes uniq =
	    match (acc, sizes) with 
	         ([], []) -> []
	       | (x::xs, y::ys) -> if StringMap.mem x uniq then
	           filter_sizes_by_pmap xs ys uniq
		else
		    y::(filter_sizes_by_pmap xs ys uniq) in


  let rec copy_header_static_internal src dst vis builder =
      match vis with
        [] -> ()
      | Bound _::xs ->
          let sintp1 = L.build_add src (L.const_int i64_t 8) "srcint" builder in
          copy_header_static_internal sintp1 dst xs builder
      | Free _::xs -> 
          let sptr = L.build_inttoptr src i64p_t "srcptr" builder in
          let tptr = L.build_inttoptr dst i64p_t "dstptr" builder in
          let sv = L.build_load sptr "memload" builder in
          let ign = L.build_store sv tptr builder in
          let sintp1 = L.build_add src (L.const_int i64_t 8) "srcint" builder in
          let tintp1 = L.build_add dst (L.const_int i64_t 8) "dstint" builder in
          copy_header_static_internal sintp1 tintp1 xs builder
  in
  let copy_header_static src dst vis builder =
    let sint = (L.build_ptrtoint src i64_t "srcint" builder) in
    let dint = (L.build_ptrtoint dst i64_t "dstint" builder) in
    let sintp1 = (L.build_add sint (L.const_int i64_t 8) "sintp1" builder) in
    let dintp1 = (L.build_add dint (L.const_int i64_t 8) "dintp1" builder) in
    copy_header_static_internal sintp1 dintp1 vis builder
  in 
  let ltype_of_typ = function
    | S.Int -> Primitive i64_t
    | S.Float -> Primitive f64_t
    | S.String -> Primitive (L.pointer_type i8_t)
    | S.Tensor dim -> Complex dim
    | S.Void -> Primitive void_t
  in
  let ltype_of_typ_wrapper v =
      let wrapped = ltype_of_typ v in 
      match wrapped with
          Primitive x -> x
        | Complex 0 -> f64_t
        | Complex _ -> i64p_t
  in
  let build_tensor_header i name builder =
      let pntr = L.build_array_malloc i64_t (L.const_int i64_t (i+2)) name builder in
      ignore (L.build_store (L.const_int i64_t i) pntr builder);
      pntr
  in
  let access_ith_true arr i builder sizeof =
      let cast = L.build_ptrtoint arr i64_t "intcast" builder in
      let offset = L.build_mul i sizeof "offsetcalc" builder in
      let added = L.build_add cast offset "pmath" builder in
      L.build_inttoptr added (L.pointer_type i64_t) "pointercast" builder
  in
  let access_ith arr i builder sizeof = 
      let iconst = L.const_int i64_t i in
      let sof = L.const_int i64_t sizeof in
      access_ith_true arr iconst builder sof
  in
  
  let rec assign_header hdr dims builder offset =
      match dims with 
          | x::xs -> let access = access_ith hdr (offset+1) builder 8 in
	     ignore (L.build_store x access builder);
	     assign_header hdr xs builder (offset + 1)
	  | [] -> ()
  in
  let assign_header_static hdr dims builder offset =
     let dimsconsts = List.map (fun x -> L.const_int i64_t x) dims in
     assign_header hdr dimsconsts builder offset
  in
  let rec next_nobounds_internal vis builder =
      match vis with 
          (Bound x):: xs -> (Bound x)::next_nobounds_internal xs builder
	 | (Free x)::xs -> 
	 let tmpplace = L.build_load x "nextitload" builder in
	 let newval = L.build_add tmpplace (L.const_int i64_t 1) "iter_it" builder in
	 ignore (L.build_store newval tmpplace builder);
	  (Free x)::xs
	 | [] -> []
  in
  let next_nobounds vis builder =
     next_nobounds_internal vis builder
  in
  (*
  let rec static_memcpy_internal src dst cnt builder =
      if cnt = 0 then () else
          let sptr = L.build_inttoptr src i64p_t "srcptr" builder in
          let tptr = L.build_inttoptr dst i64p_t "dstptr" builder in
          let sv = L.build_load sptr "memload" builder in
          ignore (L.build_store sv tptr "memstor" builder);
          let sintp1 = L.build_add src (L.const_int i64_t 8) "srcint" builder in
          let tintp1 = L.build_add dst (L.const_int i64_t 8) "dstint" builder in
          static_memcpy_internal sintp1 tintp1 (cnt-1) builder
  in
  let static_memcpy src dst cnt builder =
      static_memcpy_internal (L.build_ptrtoint src i64_t "srcint" builder) 
        (L.build_ptrtoint dst i64_t "dstint" builder) cnt builder
  in *)

  let rec static_memcpy_frompmap pmap dst cntr builder =
      match pmap with
        [] -> ()
       |x::xs -> let sint = x builder in
                 let tint = L.build_ptrtoint dst i64_t "dstint" builder in
		 let tintoffset = L.build_add tint (L.const_int i64_t (cntr*8)) "tintoffset" builder in
		 let sptr = L.build_inttoptr sint i64p_t "srcptr" builder in
		 let tptr = L.build_inttoptr tintoffset i64p_t "dstptr" builder in
		 let sv = L.build_load sptr "memload" builder in
		 ignore (L.build_store sv tptr builder);
		 static_memcpy_frompmap xs dst (cntr + 1) builder
  in
		 

  (* Declare each global variable; remember its value in a map *)
  let global_vars = 
    let global_var m vdecl =
    	let ltype = vdecl.S.vtyp in
	let lname = vdecl.S.sname in
	let lexpr = vdecl.S.vexpr in
	let lval = (match ltype with
	    S.String -> 
	    	(match lexpr with
		S.Sliteral (l,_,s) -> let ta = L.const_string context s in L.define_global lname ta the_module |
		_ -> raise (TODO "Uhh buddy you gave me a non string here"))
	   | S.Int -> (match lexpr with
	   	S.Iliteral (l,_,i) -> let ta = L.const_int i64_t i in L.define_global lname ta the_module |
		_ -> raise (TODO "Expected int"))
	   | S.Float -> (match lexpr with
	        S.Fliteral (l,_,f) -> let ta =  L.const_float f64_t f in L.define_global lname ta the_module |
		_ -> raise (TODO "Expected float"))
	   | S.Void -> raise (COMPILE_ERROR "I'm sorry, I can't let you do that Dave") 
	   | S.Tensor _ -> raise (TODO "Dave, what have you been smoking?"))
	in StringMap.add lname lval m in
    	
    (* let global_var m (t, n) =
      let init = L.const_int (ltype_of_typv t) 0
      in StringMap.add n (L.define_global n init the_module) m in *)
    List.fold_left global_var StringMap.empty program.S.globals in

  (* Declare printf(), which the print built-in function will call *)
  let printf_t = L.var_arg_function_type i64_t [| L.pointer_type i8_t |] in
  let printf_func = L.declare_function "printf" printf_t the_module in

  let strlen_t = L.function_type i32_t [|L.pointer_type i8_t|] in
  let strlen_func = L.declare_function "strlen" strlen_t the_module in

  let sprintf_t = L.var_arg_function_type i64_t [| L.pointer_type i8_t; L.pointer_type i8_t |] in
  let sprintf_func = L.declare_function "sprintf" sprintf_t the_module in

  let atoi_t = L.function_type i64_t [| L.pointer_type i8_t|] in
  let atoi_func = L.declare_function "atoi" atoi_t the_module in

  let atof_t = L.function_type f64_t [| L.pointer_type i8_t|] in
  let atof_func = L.declare_function "atof" atof_t the_module in

  let fopen_t = L.function_type i64_t [| L.pointer_type i8_t; L.pointer_type i8_t|] in
  let fopen_func = L.declare_function "fopen" fopen_t the_module in

  let fclose_t = L.function_type i64_t [| i64_t|] in
  let fclose_func = L.declare_function "fclose" fclose_t the_module in

  let fread_t = L.function_type i32_t [| i64p_t; i32_t; i32_t; i64p_t|] in 
  let fread_func = L.declare_function "fread" fread_t the_module in

  let fwrite_t = L.function_type i64_t [| i64p_t; i32_t; i32_t; i64p_t|] in 
  let fwrite_func = L.declare_function "fwrite" fwrite_t the_module in

  let sqrt_t = L.function_type f64_t [| f64_t|] in 
  let sqrt_func = L.declare_function "sqrt" sqrt_t the_module in


  
  (* Define each function (arguments and return type) so we can call it *)
  let function_decls =
    let function_decl m fdecl =
      let name = fdecl.S.sfname
      and formal_types = 
	Array.of_list (List.map (fun (t,_) -> ltype_of_typ_wrapper t) fdecl.S.sformals)
      in let ftype = L.function_type (ltype_of_typ_wrapper fdecl.S.ftyp) formal_types in
      StringMap.add name (L.define_function name ftype the_module, fdecl) m in
    List.fold_left function_decl StringMap.empty program.S.functions in
  
  (* Fill in the body of the given function *)
  let build_function_body fdecl =
    let the_scope = FoldStack.create () in FoldStack.push global_vars the_scope;
    let (the_function, _) = StringMap.find fdecl.S.sfname function_decls in
    let builder = L.builder_at_end context (L.entry_block the_function) in
    let builder_ref = ref builder in

    let int_format_str = L.build_global_stringptr "%d\n" "fmt" builder in
    let flt_format_str = L.build_global_stringptr "%.6f\n" "fmt2" builder in
    let fltcomma_format_str = L.build_global_stringptr "%.6f, " "fmt3" builder in
    let concat_format_str = L.build_global_stringptr "%s%s" "concatfmt" builder in		 
    let int_to_string_format_str = L.build_global_stringptr "%d" "itosfmt"  builder in
    let newline_str = L.build_global_stringptr "\n" "nlstr" builder in
    let float_to_string_format_str = L.build_global_stringptr "%.6f" "ftosfmt"  builder in
    

    let rec gen_free_vars_from_names lst builder =
        match lst with
	   [] -> ()
	  |x::xs -> let local = L.build_alloca i64_t x builder in
	   ignore (L.build_store (L.const_int i64_t 0) local);
	      	let curr_stringmap = FoldStack.pop the_scope in
		let strmap2 = StringMap.add x local curr_stringmap in
		ignore (FoldStack.push strmap2 the_scope);
		gen_free_vars_from_names xs builder
    in

    let rec gen_free_vars prefix cnt builder =
        let nm = prefix ^ (string_of_int cnt) in
        if cnt = 0 then [] else
	   let local = L.build_alloca i64_t nm builder in
	   ignore (L.build_store (L.const_int i64_t 0) local);
		let curr_stringmap = FoldStack.pop the_scope in
		let strmap2 = StringMap.add nm local curr_stringmap in
		ignore (FoldStack.push strmap2 the_scope);
		nm::(gen_free_vars prefix (cnt - 1)) builder in
	   
    (* Construct the function's "locals": formal arguments and locally
       declared variables.  Allocate each on the stack, initialize their
       value, if appropriate, and remember their values in the "locals" map *)
     let add_formal (t, n) p = L.set_value_name n p;
	let local = L.build_alloca (ltype_of_typ_wrapper t) n builder in
	ignore (L.build_store p local builder);
	let curr_stringmap = FoldStack.pop the_scope in
	let strmap2 = StringMap.add n local curr_stringmap in
	FoldStack.push strmap2 the_scope in

     List.iter2 add_formal fdecl.S.sformals
       (Array.to_list (L.params the_function));
    (* Return the value for a variable or formal argument *)
    (* let lookup n = StringMap.find n.S.sname local_vars *)
    let lookup_simple the_key already_found curr_map =
    	match already_found with
		Some x -> Some x |
		None -> if StringMap.mem the_key curr_map then Some (StringMap.find the_key curr_map)
		        else None
    in
    let lookup n ms =
        let answer = FoldStack.fold (lookup_simple n) None ms in
	match answer with 
	    None -> raise (COMPILE_ERROR "query lookup on variable failed")
	  | Some x -> x
    in
    (* Construct code for an expression; return its value *)
  let rec assign_tensor_floats pntr innerexprs offset builder = 
      match innerexprs with
          [] -> ()
          | x::xs -> let exprvalue = L.build_sitofp (expr builder x) f64_t "floattmp" builder in
	             let access = access_ith pntr offset builder 8 in
                     let fpmem = L.build_malloc f64_t "factual" builder in
                     let fpmemcast = L.build_ptrtoint fpmem i64_t "ptwtointforfpstorage" builder in
		     ignore (L.build_store exprvalue fpmem builder);
                     ignore (L.build_store fpmemcast access builder);
		     assign_tensor_floats pntr xs (offset + 1) builder
  and
  get_vis slist builder =
     (* TODO MAYBE FIX IF WE LET slicing work twice *)
      match slist with 
          (S.Id (l, t, s))::xs -> (try (let e = expr builder (S.Id (l,t,s)) in
	                                let sto = L.build_alloca i64_t "free_alloc" builder in
					ignore (L.build_store e sto builder);
					(Bound sto)::(get_vis xs builder)) with _ -> 
		        (let sto = L.build_alloca i64_t "free_alloc" builder in
			ignore (L.build_store (L.const_int i64_t 0) sto builder);
			(Free sto)::(get_vis xs builder)))
         | x::xs -> let e = expr builder x in 
                       (let sto = L.build_alloca i64_t "bnd_alloc" builder in
                       ignore (L.build_store e sto builder);
                        (Bound sto)::(get_vis xs builder))
         |_ -> []
  and

  assign_tensor placetowrite i builder =
      match i with 
         x::xs ->
	 (match x with
         S.SExprDim(k, innerexprs) ->
		let pntr = L.build_array_malloc i64_t 
	        (L.const_int i64_t (List.length innerexprs)) "fstorage" builder in
		ignore (assign_tensor_floats pntr innerexprs 0 builder);
		let ptrtoint = (L.build_ptrtoint pntr i64_t "ptrtointfornlstorage" builder) in
		ignore (L.build_store ptrtoint placetowrite builder);
		let ptwint = (L.build_ptrtoint placetowrite i64_t "ptwtointfornlstorage" builder) in
		let next = L.build_add ptwint (L.const_int i64_t 8) "nextptr" builder in
		let nextptr = L.build_inttoptr next (L.pointer_type i64_t) "nextptrptr" builder in
		ignore (assign_tensor nextptr xs builder);
		()
	| S.STenDim(_,l) ->
	        let pntr = L.build_array_malloc i64_t
		           (L.const_int i64_t (List.length l)) "fstarstorage" builder in 
	        ignore (assign_tensor pntr l builder);
		let ptrtoint = (L.build_ptrtoint pntr i64_t "ptrtointfornlstarstorage" builder) in
		ignore (L.build_store ptrtoint placetowrite builder);
		let ptwint = (L.build_ptrtoint placetowrite i64_t "ptwtointfornlstorage" builder) in
		let next = L.build_add ptwint (L.const_int i64_t 8) "nextptr" builder in
		let nextptr = L.build_inttoptr next (L.pointer_type i64_t) "nextptrptr" builder in
		ignore (assign_tensor nextptr xs builder);
		()
	)

	| [] -> ()
  and
  access_index_internal base exprlist builder = 
      match exprlist with
          x::xs -> let ex = x in
	      let sof = L.const_int i64_t 8 in
	      let next = access_ith_true base ex builder sof in
              let deref = L.build_load next "deref" builder in
              let deref_pntr = L.build_inttoptr deref i64p_t "derefpntr" builder in
	      access_index_internal deref_pntr xs builder
        (*
         | x::xs -> let ex = x in
	      let sof = L.const_int i64_t 8 in
	      let next = access_ith_true base ex builder sof in
	      access_index_internal next xs builder *)
	 |[]    -> base
  and
  access_index hdr exprs builder = 
      let offset = L.build_load hdr "offsetload" builder in
      let offsetp1 = L.build_add offset (L.const_int i64_t 1) "plus1" builder in
      let sof = L.const_int i64_t 8 in
      let root = access_ith_true hdr offsetp1 builder sof in
      let rootload = L.build_load root "rootload" builder in
      access_index_internal rootload exprs builder
  and
  access_loc_internal base exprlist builder = 
      match exprlist with
          x::xs -> let ex = x in
              let deref = L.build_load base "deref" builder in
              let sof = L.const_int i64_t 8 in
              let next = access_ith_true deref ex builder sof in
              let next_pntr = L.build_inttoptr next i64p_t "nextpntr" builder in
	      access_loc_internal next_pntr xs builder
       | [] -> base  
  and
  access_loc hdr exprs builder =
      let offset = L.build_load hdr "offsetload" builder in
      let offsetp1 = L.build_add offset (L.const_int i64_t 1) "plus1" builder in
      let sof = L.const_int i64_t 8 in
      let root = access_ith_true hdr offsetp1 builder sof in
      access_loc_internal root exprs builder
  and
  to_sexpr_from_strlist_force xs = 
      List.map (fun x -> S.Sliteral ("TODO", S.String, x)) xs

  and
  rebound_internal clist builder carry the_function = 
      match clist with 
          (Free c,l)::xs ->
	      let l1load = L.build_load c "fiterload" builder in
	      let l2load = L.build_load l "siterload" builder in
	      let added = L.build_add l1load
                  (L.build_bitcast carry i8_t "bc_fb" builder) "iteradd" builder in
	      (* Need to decrement to old value if overflow *)
	      let carrynew = L.build_icmp L.Icmp.Sge added l2load "itercmp" builder in
              let merge_bb = L.append_block context "itermrg" the_function in
              let then_bb = L.append_block context "iterthen" the_function in
              let bldatthen = L.builder_at_end context then_bb in
	      ignore (L.build_store added c bldatthen);
              ignore (L.build_br merge_bb bldatthen);
              ignore (L.build_cond_br carrynew merge_bb then_bb builder);
	      rebound_internal xs (L.builder_at_end context merge_bb) carrynew the_function
         | (Bound c, l)::xs -> rebound_internal xs builder carry the_function
	 | [] -> carry
  and rebound vis ls builder = 
      let clist = List.combine vis ls in
      rebound_internal clist builder (L.const_int i8_t 0)
  and
  (*
  next_it ii builder the_function = 
      let curr = List.rev ii.current in
      let limits = List.rev ii.limits in
      ignore (next_nobounds ii.current builder);
      let carryflag = rebound curr limits builder the_function in
      ignore (L.build_cond_br carryflag ii.termination_branch ii.redo_branch builder)
  and *)
  malloc_callback base size offsets builder =
      let loc = access_loc base offsets builder in
      let arr = L.build_array_malloc i64_t size "mcarr" builder in
      let arrint = L.build_ptrtoint arr i64_t "mcarrptrtoint" builder in
      ignore (L.build_store arrint loc builder)
  and
  copy_callback sname soffname tname toffname builder =
      
      let soffsets = typify_as_int_access soffname in
      let toffsets = typify_as_int_access toffname in

      let e = S.TensorId("", (S.Tensor 0), sname, soffsets) in
      let e2 = S.TensorAssign("", (S.Tensor 0), tname, toffsets, e) in
      ignore (expr builder e2); builder

  and gen_names prefix cntr vals =
      match vals with 
          [] -> []
	 |x::xs -> let stint = string_of_int cntr in
	    let name = (prefix ^ stint) in
	    let curr_stringmap = FoldStack.pop the_scope in
	    let strmap2 = StringMap.add name x curr_stringmap in
	    FoldStack.push strmap2 the_scope; name::(gen_names prefix (cntr + 1) xs)
  and
  gen_loads ptrs builder =
      match ptrs with
          x::xs -> (L.build_load (lookup x the_scope) "gl" builder)::gen_loads xs builder
        | [] -> []
  and
  gen_loads_raw ptrs builder =
      match ptrs with 
          x::xs -> (L.build_load x "glr" builder)::gen_loads_raw xs builder
	 | [] -> []
  and
  gen_sizes hdr cntr dim builder =
      if cntr < dim then
         let loc = access_ith hdr (cntr + 1) builder 8 in
         (loc)::gen_sizes hdr (cntr + 1) dim builder
      else []
  and
  get_last_in_list lst =
      match lst with
          x::y::rest -> get_last_in_list (y::rest)
        | x::xs -> x
        | [] -> raise (COMPILE_ERROR "Given empty list to get_last")
  and
  gen_cc_builderk sname dname names_access_src names_access_dst builder =
      copy_callback sname names_access_src dname names_access_dst
  and
  gen_binop_callback tgt s1 s2 op names builder =
      let laccess = S.TensorId("", S.Float, s1, (typify_as_int_access names)) in
      let raccess = S.TensorId("", S.Float, s2, (typify_as_int_access names)) in
      let bop = S.Binop ("", S.Float, laccess, op, raccess) in
      let assign = S.TensorAssign("", S.Float, tgt, (typify_as_int_access names), bop) in
      ignore (expr builder (assign));
      builder
  and
  
  gen_tmult_binop_callback tgt s1 s2 tgtaccess_ s1access_ s2access_ builder =
      let s1access = S.TensorId("", S.Float, s1, (typify_as_int_access s1access_)) in
      let s2access = S.TensorId("", S.Float, s2, (typify_as_int_access s2access_)) in
      let tgtaccess = S.TensorId("", S.Float, tgt, (typify_as_int_access tgtaccess_)) in
      let bop = S.Binop("", S.Float, s1access, Ast.Mult, s2access) in
      let bopadd = S.Binop("", S.Float, tgtaccess, Ast.Add, bop) in
      let assign = S.TensorAssign("", S.Float, tgt, (typify_as_int_access tgtaccess_), bopadd) in

      ignore (expr builder (assign));
      builder
  and
  gen_tmult_callback_internal k free_var_names free_var_sizes builder =
      match (free_var_names, free_var_sizes) with
          ([], []) -> k builder
	 |(x::xs, y::ys) -> let cb = gen_tmult_callback_internal k xs ys in
		    let e1 = S.Assign ("", S.Int, x, S.Iliteral("",S.Int, 0)) in
		    let e2 = S.Binop ("", S.Int, S.Id("", S.Int, x), A.Less, S.Id("", S.Int, y)) in
		    let e3 = S.Assign ("", S.Int, x, S.Binop("", S.Int, S.Iliteral("", S.Int, 1), A.Add,
			     S.Id("", S.Int, x))) in
		    let body = S.Callback cb in
		    stmt builder (S.For (e1, e2, e3, body))

  and
  gen_tmult_callback k tgtname free_var_names free_var_sizes names builder =
      let accumacc = S.TensorAssign("", S.Float, tgtname, (typify_as_int_access names), (S.Fliteral ("", S.Float, 0.0))) in
      ignore (expr builder accumacc);
      gen_tmult_callback_internal k free_var_names free_var_sizes builder
  and
  gen_print_float_llval llval builder =
      ignore (L.build_call printf_func [| fltcomma_format_str; llval |] "printf_ignore" builder);
      builder;
  and
  gen_printnewline_cb builder =
      ignore (L.build_call printf_func [| newline_str |] "printf_ignore" builder);
      builder;
  and
  gen_printf_ten tgt names names_done cntr builder =
      match names with
          x::xs -> 
	      let loads_at_this_lvl = gen_loads (List.rev names_done) builder in
	      let sizes = gen_sizes tgt 0 (cntr + 1) builder in
	      let size = get_last_in_list sizes in
	      let sname_list = gen_names "_slicesize_" (List.length names_done) [size] in
	      let sname = get_first sname_list in
	    let kcall = 
            gen_printf_ten tgt (xs) (x::names_done) (cntr + 1) in
            let e1 = S.Assign ("", S.Int, x, S.Iliteral("",S.Int, 0)) in
            let e2 = S.Binop ("", S.Int, S.Id("", S.Int, x), A.Less, S.Id("", S.Int, sname)) in
            let e3 = S.Assign ("", S.Int, x, S.Binop("", S.Int, S.Iliteral("", S.Int, 1), A.Add,
                     S.Id("", S.Int, x))) in

            let body = S.Callback kcall in
            stmt builder (S.SBlock [S.For (e1,e2,e3,body); S.Callback gen_printnewline_cb])
        | [] -> 
	       let loads_at_this_lvl = gen_loads (List.rev names_done) builder in
	       let fptr = access_index tgt loads_at_this_lvl builder in
	       let fptrcast = L.build_bitcast fptr f64p_t "fpaccess" builder in
               let fpval = L.build_load fptrcast "fpret" builder in
               gen_print_float_llval fpval builder
  and
  gen_tensor_binop tgt k names names_done cntr builder =
      match names with
          x::xs -> 
	      let loads_at_this_lvl = gen_loads (List.rev names_done) builder in
	      let sizes = gen_sizes tgt 0 (cntr + 1) builder in
	      let size = get_last_in_list sizes in
	      let mc = (malloc_callback tgt (L.build_load size "slicesizeload" builder)
                 loads_at_this_lvl builder) in
	      let sname_list = gen_names "_slicesize_" (List.length names_done) [size] in
	      let sname = get_first sname_list in
	    let kcall = 
            gen_tensor_binop tgt k (xs) (x::names_done) (cntr + 1) in
            let e1 = S.Assign ("", S.Int, x, S.Iliteral("",S.Int, 0)) in
            let e2 = S.Binop ("", S.Int, S.Id("", S.Int, x), A.Less, S.Id("", S.Int, sname)) in
            let e3 = S.Assign ("", S.Int, x, S.Binop("", S.Int, S.Iliteral("", S.Int, 1), A.Add,
                     S.Id("", S.Int, x))) in
            let body = S.Callback kcall in
            stmt builder (S.For (e1,e2,e3,body))
        | [] ->
	       let loads_at_this_lvl = gen_loads (List.rev names_done) builder in
	       let loc = access_loc tgt loads_at_this_lvl builder in
	       let ptr = L.build_malloc i64_t "abldrk" builder in
	       let ptrint = L.build_ptrtoint ptr i64_t "abldrkcast" builder in 
	       ignore (L.build_store ptrint loc builder);
               k (List.rev names_done) builder
  and
  gen_alloc_builderk names names_done base cntr builder =
      match names with
          x::xs -> 
	      let loads_at_this_lvl = gen_loads (List.rev names_done) builder in
	      let sizes = gen_sizes base 0 (cntr + 1) builder in
	      let size = get_last_in_list sizes in
	      let mc = (malloc_callback base (L.build_load size "slicesizeload" builder)
                 loads_at_this_lvl builder) in
	      let sname_list = gen_names "_slicesize_" (List.length names_done) [size] in
	      let sname = get_first sname_list in
	    let kcall = 
            gen_alloc_builderk (xs) (x::names_done) base (cntr + 1) in
            let e1 = S.Assign ("", S.Int, x, S.Iliteral("",S.Int, 0)) in
            let e2 = S.Binop ("", S.Int, S.Id("", S.Int, x), A.Less, S.Id("", S.Int, sname)) in
            let e3 = S.Assign ("", S.Int, x, S.Binop("", S.Int, S.Iliteral("", S.Int, 1), A.Add,
                     S.Id("", S.Int, x))) in
            let body = S.Callback kcall in
            stmt builder (S.For (e1,e2,e3,body))
        | [] ->
	       let loads_at_this_lvl = gen_loads (List.rev names_done) builder in
	       let loc = access_loc base loads_at_this_lvl builder in
	       let ptr = L.build_malloc i64_t "abldrk" builder in
	       let ptrint = L.build_ptrtoint ptr i64_t "abldrkcast" builder in 
	       ignore (L.build_store ptrint loc builder);
	       builder
  and
  gen_slice_builderk im names_todo names_done src dst k builder =
      match names_todo with
          x::xs -> 

	      let loads_at_this_lvl = gen_loads (List.rev names_done) builder in

	      let cntr = IntMap.find (List.length names_done) im in
	      let sizes = gen_sizes src 0 (cntr + 1) builder in
	      let size = get_last_in_list sizes in
	      let mc = (malloc_callback dst (L.build_load size "slicesizeload" builder)
                 loads_at_this_lvl builder) in
	      let sname_list = gen_names "_slicesize_" (List.length names_done) [size] in
	      let sname = get_first sname_list in
	    let kcall = 
            gen_slice_builderk im (xs) (x::names_done) src dst k in
            let e1 = S.Assign ("", S.Int, x, S.Iliteral("",S.Int, 0)) in
            let e2 = S.Binop ("", S.Int, S.Id("", S.Int, x), A.Less, S.Id("", S.Int, sname)) in
            let e3 = S.Assign ("", S.Int, x, S.Binop("", S.Int, S.Iliteral("", S.Int, 1), A.Add,
                     S.Id("", S.Int, x))) in
            let body = S.Callback kcall in
            stmt builder (S.For (e1,e2,e3,body))
        | [] -> 
	       let cc = k (List.rev names_done) builder in
	       stmt builder (S.Callback cc)
  and
  
  expr builder2 e = 
      builder_ref := builder2;
      (expr2 e)
  and
  expr2 x=
    match x with
      | S.Noexpr _ -> L.const_int i64_t 0
      | S.Id (line,t,s) -> L.build_load (lookup s the_scope) s !builder_ref
      | S.Binop (line, t, e1, op, e2) ->
	       let e1' = expr !builder_ref e1
	       and e2' = expr !builder_ref e2 in
               (match t with
	       S.Int ->
	         (match op with
	           A.Add     -> L.build_add e1' e2' "tmp" !builder_ref
	         | A.Sub     -> L.build_sub e1' e2' "tmp" !builder_ref
	         | A.Mult    -> L.build_mul e1' e2' "tmp" !builder_ref
                 | A.Div     -> L.build_sdiv e1' e2' "tmp" !builder_ref
	         | A.And     -> let b1 = (match L.type_of e1' with 
                                   i64_t -> L.build_icmp L.Icmp.Ne e1' (L.const_int i64_t 0) "booltmp" !builder_ref
                                  |i1_t -> e1')  in
                                let b2 = (match L.type_of e2' with 
                                   i64_t -> L.build_icmp L.Icmp.Ne e2' (L.const_int i64_t 0) "booltmp" !builder_ref
                                  |i1_t -> e2')  in
                                L.build_and b1 b2  "tmp" !builder_ref
	         | A.Or      -> let b1 = (match L.type_of e1' with 
                                   i64_t -> L.build_icmp L.Icmp.Ne e1' (L.const_int i64_t 0) "booltmp" !builder_ref
                                  |i1_t -> e1')  in
                                let b2 = (match L.type_of e2' with 
                                   i64_t -> L.build_icmp L.Icmp.Ne e2' (L.const_int i64_t 0) "booltmp" !builder_ref
                                  |i1_t -> e2')  in
                                L.build_or b1 b2  "tmp" !builder_ref
	         | A.Equal   -> L.build_icmp L.Icmp.Eq e1' e2' "tmp" !builder_ref
	         | A.Neq     -> L.build_icmp L.Icmp.Ne e1' e2' "tmp" !builder_ref
	         | A.Less    -> L.build_fcmp L.Fcmp.Olt (L.build_sitofp e1' f64_t "ftmp" !builder_ref) (L.build_sitofp e2' f64_t "ftmp" !builder_ref) "tmp" !builder_ref
	         | A.Leq     -> L.build_fcmp L.Fcmp.Ole (L.build_sitofp e1' f64_t "ftmp" !builder_ref) (L.build_sitofp e2' f64_t "ftmp" !builder_ref) "tmp" !builder_ref
	         | A.Greater -> L.build_fcmp L.Fcmp.Ogt (L.build_sitofp e1' f64_t "ftmp" !builder_ref) (L.build_sitofp e2' f64_t "ftmp" !builder_ref) "tmp" !builder_ref
	         | A.Geq     -> L.build_fcmp L.Fcmp.Oge (L.build_sitofp e1' f64_t "ftmp" !builder_ref) (L.build_sitofp e2' f64_t "ftmp" !builder_ref) "tmp" !builder_ref
	         )
	        | S.Float ->
		 let e1f = L.build_fpcast (L.build_sitofp e1' f64_t "cast_tmp" !builder_ref) f64_t "fpcast_eo" !builder_ref in
		 let e2f = L.build_fpcast (L.build_sitofp e2' f64_t "cast2_tmp" !builder_ref) f64_t "fpcast_eo" !builder_ref in
		 (match op with
	           A.Add     -> L.build_fadd
	         | A.Sub     -> L.build_fsub
	         | A.Mult    -> L.build_fmul
                 | A.Div     -> L.build_fdiv
	         | _         -> raise(Failure("This operation shouldn't return a float, something is wrong"))
	           )
		 e1f e2f "tmp" !builder_ref 
	        | S.String ->
		  (match op with
		   A.Concat -> 
			let l1 = L.build_call strlen_func [|e1'|] "strlen1" !builder_ref in
			let l2 = L.build_call strlen_func [|e2'|] "strlen2" !builder_ref in
			let sum = (L.build_add (L.build_add l1 l2 "add_tmp" !builder_ref) (L.const_int i32_t 1) "add_tmp" !builder_ref) in
			let mem = L.build_array_malloc i8_t sum "malloc_tmp" !builder_ref in
			ignore(L.build_call sprintf_func [| mem; concat_format_str; e1'; e2' |] "sprintf_tmp" !builder_ref);
			mem
		 |  _ -> raise(Failure("Can't use this operation on strings, something is wrong"))
		 )
                | S.Tensor dim ->
		  (match op with Ast.Mult -> let (luse, ruse) = 
		   extract_tmult_info e1 e2 in
		   let tuse = remove_dups_eqone luse ruse in
		   let tmap = List.fold_left (fun m e -> StringMap.add e () m) StringMap.empty tuse in
                   let s1dim = get_dim (Sm.extract_type e1) in
		   let sizesformult = gen_sizes (e1') 0 s1dim !builder_ref in
		   let sizesfiltered = filter_sizes_by_pmap luse sizesformult tmap in

		   let thdr = (
		   if List.length tuse > 0 then
		   let thdr = build_tensor_header dim "static_ten" !builder_ref in
		   let shdr1int = L.build_ptrtoint e1' i64_t "hdrint" !builder_ref in
		   let shdr2int = L.build_ptrtoint e2' i64_t "hdrint2" !builder_ref in
		   


		   let pmap = gen_pointer_map_wrap shdr1int shdr2int luse ruse tmap in
		   static_memcpy_frompmap pmap thdr 1 !builder_ref;
		   thdr
		   else
		   (L.const_float f64_t 0.0)) in
		   

		  let hdraddr = L.build_alloca (L.type_of thdr) "tgt_header" !builder_ref in
		  let s1addr = L.build_alloca (L.type_of e1') "s1_header" !builder_ref in
		  let s2addr = L.build_alloca (L.type_of e2') "s2_header" !builder_ref in 
		  ignore (L.build_store thdr hdraddr !builder_ref);
		  ignore (L.build_store e1' s1addr !builder_ref);
		  ignore (L.build_store e2' s2addr !builder_ref);
		  
		  let sm = StringMap.empty in
		  let sm2 = StringMap.add "_tgt_header_" hdraddr sm in
		  let sm3 = StringMap.add "_s1_header_" s1addr sm2 in
		  let sm4 = StringMap.add "_s2_header_" s2addr sm3 in


		  FoldStack.push sm4 the_scope;
		  gen_free_vars_from_names tuse !builder_ref;
		  gen_free_vars_from_names (diff luse tuse) !builder_ref;
		  let sizenames = gen_names "_tmult_size_inner_" 0 sizesfiltered in
		  let lcb = gen_tmult_binop_callback "_tgt_header_" "_s1_header_" "_s2_header_" tuse luse ruse in
		  let cb = gen_tmult_callback lcb "_tgt_header_" (diff luse tuse) sizenames in


		  let newbuilder = (
		  if List.length tuse > 0 then
		      gen_tensor_binop thdr cb tuse [] 0 !builder_ref
		  else
		      cb [] !builder_ref) in 

		  builder_ref := newbuilder;
		  FoldStack.pop the_scope;

		  L.build_load hdraddr "hdraddr_load" newbuilder
		  | _ -> 
		  let hdr = build_tensor_header dim "static_ten" !builder_ref in
		  let frees = get_free_spec_list (dim) in
		  copy_header_static e1' hdr frees !builder_ref;
		  let dummy_vi = get_vis_dummy_slist dim in
		  let vis = get_vis dummy_vi !builder_ref in
		  
		  let hdraddr = L.build_alloca (L.type_of hdr) "tgt_header" !builder_ref in
		  let s1addr = L.build_alloca (L.type_of e1') "s1_header" !builder_ref in
		  let s2addr = L.build_alloca (L.type_of e2') "s2_header" !builder_ref in 
		  ignore (L.build_store hdr hdraddr !builder_ref);
		  ignore (L.build_store e1' s1addr !builder_ref);
		  ignore (L.build_store e2' s2addr !builder_ref);
		  
		  let sm = StringMap.empty in
		  let sm2 = StringMap.add "_tgt_header_" hdraddr sm in
		  let sm3 = StringMap.add "_s1_header_" s1addr sm2 in
		  let sm4 = StringMap.add "_s2_header_" s2addr sm3 in
		     
		  FoldStack.push (sm4) the_scope;
		  let names = gen_names "_slicenot_" 0 (strip_vis vis) in
		  let k = gen_binop_callback "_tgt_header_" "_s1_header_" "_s2_header_" op in
		  let newbuilder = gen_tensor_binop hdr k names [] 0 !builder_ref in
		  builder_ref := newbuilder;
   
		  ignore (FoldStack.pop the_scope);
                  hdr)
		)
      | S.Unop(line, t, op, e) ->
	       let e' = expr !builder_ref e in
	         (match op with
	          A.Neg     -> if t = S.Int then L.build_neg e' "tmp" !builder_ref else L.build_fsub (L.const_float f64_t 0.0) e' "tmp" !builder_ref
          	| A.Not     -> L.build_not (L.build_icmp L.Icmp.Ne e' (L.const_int i64_t 0) "nottmp" !builder_ref) "tmp" !builder_ref)
      | S.Assign (line, t, s, e) -> let e' = if t = S.Float then (L.build_sitofp (expr !builder_ref e) f64_t "cast_tmp" !builder_ref)  else expr !builder_ref e in
	                   ignore (L.build_store e' (lookup s the_scope) !builder_ref); e'
      (* TODO do calls *)
      | S.Call (line, t, fd, sexprlist) ->
         (if (compare fd.S.sfname "print") = 0 then
             let fet = (get_first sexprlist) in
             let ftype = Sm.extract_type fet in
             match ftype with 
               S.Int -> 
                  L.build_call printf_func [| int_format_str ; (expr !builder_ref (get_first sexprlist)) |] "printf_ignore" !builder_ref
             | S.Float -> 
                  L.build_call printf_func [| flt_format_str ; (expr !builder_ref fet) |] "printf_ignore" !builder_ref
             | S.String ->
                  L.build_call printf_func [| (expr !builder_ref fet) |] "printf_ignore" !builder_ref
             | S.Tensor dim ->
                   let e' = expr !builder_ref (get_first sexprlist) in
                   FoldStack.push StringMap.empty the_scope;
                   let names = gen_free_vars "_printf_prefix_" dim !builder_ref in
                   let newbuilder = gen_printf_ten e' names [] 0 !builder_ref in
                   builder_ref := newbuilder;
                   ignore (FoldStack.pop the_scope);
                   L.const_int i64_t 0
         else if (compare fd.S.sfname "dim") = 0 then
		let ptr = access_ith_true (expr !builder_ref (get_first sexprlist)) (L.build_add (expr !builder_ref (List.nth sexprlist 1)) (L.const_int i64_t 1) "addtmp" !builder_ref) !builder_ref (L.const_int i32_t 8) in
		L.build_load ptr "tenresult" !builder_ref
	 else if (compare fd.S.sfname "ftoi") = 0 then
		L.build_fptosi (expr !builder_ref (get_first sexprlist)) i64_t "inttmp" !builder_ref

	 else if (compare fd.S.sfname "itof") = 0 then
	 	L.build_sitofp (expr !builder_ref (get_first sexprlist)) f64_t "floattmp" !builder_ref

	 else if (compare fd.S.sfname "ftos") = 0 then
               let mem =  L.build_array_malloc i8_t (L.const_int i32_t 50) "malloc_tmp" !builder_ref in
	       ignore(L.build_call sprintf_func [|mem; float_to_string_format_str; (expr !builder_ref (get_first sexprlist))|] "sprintf_tmp" !builder_ref);
	       mem

	 else if (compare fd.S.sfname "itos") = 0 then
               let mem =  L.build_array_malloc i8_t (L.const_int i32_t 50) "malloc_tmp" !builder_ref in
	       ignore(L.build_call sprintf_func [|mem; int_to_string_format_str; (expr !builder_ref (get_first sexprlist))|] "sprintf_tmp" !builder_ref);
	       mem

 	 else if (compare fd.S.sfname "stoi") = 0 then
	       L.build_call atoi_func [|expr !builder_ref (get_first sexprlist)|] "atoi_tmp" !builder_ref

 	 else if (compare fd.S.sfname "stof") = 0 then
	       L.build_call atof_func [|expr !builder_ref (get_first sexprlist)|] "atof_tmp" !builder_ref
		      
	 else if (compare fd.S.sfname "fopen") = 0 then
	       L.build_call fopen_func [|(expr !builder_ref (get_first sexprlist)); (expr !builder_ref (List.nth sexprlist 1))|] "fopen_tmp" !builder_ref

	 else if (compare fd.S.sfname "fclose") = 0 then
	       L.build_call fclose_func [|(expr !builder_ref (get_first sexprlist))|] "fclose_tmp" !builder_ref
	 
	 else if (compare fd.S.sfname "fread") = 0 then
	       let size = L.build_trunc (expr !builder_ref (get_first sexprlist)) i32_t "trunctmp" !builder_ref in
	       let ptr = L.build_array_malloc i8_t size "malloc_tmp" !builder_ref in 
	       let castptr = L.build_bitcast ptr i64p_t "bitcast_tmp" !builder_ref in
               let nmemb = L.const_int i32_t 1 in
	       let file = L.build_inttoptr (expr !builder_ref (List.nth sexprlist 1)) i64p_t "cast_tmp" !builder_ref in 
	       ignore(L.build_call fread_func [|castptr; size; nmemb; file|] "fread_tmp" !builder_ref);
	       ptr


	 else if (compare fd.S.sfname "fwrite") = 0 then
	      let ptr = expr !builder_ref (get_first sexprlist) in
	      let size = L.build_call strlen_func [|ptr|] "strlen" !builder_ref in
	      let nmemb = L.const_int i32_t 1 in
	      let file = L.build_inttoptr (expr !builder_ref (List.nth sexprlist 1)) i64p_t "cast_tmp" !builder_ref in 
	      L.build_call fwrite_func [|(L.build_bitcast ptr i64p_t "bitcast_tmp" !builder_ref); size; nmemb; file|] "fwrite_tmp" !builder_ref
	       


	else if (compare fd.S.sfname "sqrt") = 0 then
	     L.build_call sqrt_func [|(expr !builder_ref (get_first sexprlist))|] "sqrt_tmp" !builder_ref


	else if (compare fd.S.sfname "strlen") = 0 then
	     L.build_call strlen_func [|expr !builder_ref (get_first sexprlist)|] "strlen" !builder_ref

	 else
         let (fdef, fdecl) = StringMap.find fd.S.sfname function_decls in
	 let actuals = List.rev (List.map (expr !builder_ref) (List.rev sexprlist)) in
	 let result = (match fdecl.S.ftyp with S.Void -> ""
                                            | _ -> fd.S.sfname ^ "_result") in
         L.build_call fdef (Array.of_list actuals) result !builder_ref
         )

      | S.Fliteral (line,_,f) -> L.const_float f64_t f
      | S.Iliteral (line,_,i) -> L.const_int i64_t i
      | S.Sliteral (line,_,s) -> L.build_global_stringptr s s !builder_ref
      | S.Itensor (line,_,S.STenDim(l,i)) ->
          let hdr = build_tensor_header (List.length l) "immediate_tmp" !builder_ref in
	  ignore (assign_header_static hdr l !builder_ref 0);

	  let datptroffset = access_ith hdr (1 + (List.length l)) !builder_ref 8 in

	  ignore (assign_tensor datptroffset [S.STenDim(l,i)] !builder_ref);
	  hdr
      | S.Itensor (line,_,S.SExprDim(i, l)) ->
          let hdr = build_tensor_header 1 "immediate_tmp" !builder_ref in
	  ignore (assign_header_static hdr [List.length l] !builder_ref 0);
	  let datptroffset = access_ith hdr 2 !builder_ref 8 in
	  ignore (assign_tensor datptroffset [S.SExprDim(i,l)] !builder_ref);
	  hdr
      | S.BindExpr (line, t, S.InferredBind (inner_line, n, e)) -> let alloc =  L.build_alloca (ltype_of_typ_wrapper t) n !builder_ref in
          let e' = expr !builder_ref e in 
	  let curr_stringmap = FoldStack.pop the_scope in
	  ignore (L.build_store e' alloc !builder_ref);
	  let strmap2 = StringMap.add n alloc curr_stringmap in
	  FoldStack.push strmap2 the_scope; e';
      | S.BindExpr (line, t, S.TensorBind (inner_line, s, qllist)) ->
          let hdr = build_tensor_header (List.length qllist) "dynamic_ten" !builder_ref in
	  let qvals = List.map (fun x -> expr !builder_ref x) qllist in

          FoldStack.push StringMap.empty the_scope;
	  ignore (assign_header hdr qvals !builder_ref 0);
	  let inames = gen_free_vars "_free_vars" (List.length qvals) !builder_ref in 
          let newbuilder = gen_alloc_builderk inames [] hdr 0 !builder_ref in
	  builder_ref := newbuilder;
          FoldStack.pop the_scope;
	  let alloc = L.build_alloca (L.pointer_type i64_t) s !builder_ref in
	  ignore (L.build_store hdr alloc !builder_ref);
          let curr_stringmap = FoldStack.pop the_scope in
	  let strmap2 = StringMap.add s alloc curr_stringmap in
	  FoldStack.push strmap2 the_scope; hdr
      | S.BindExpr (line, t, S.TensorBindAndAssign(inner_line, s,q,e)) ->
          ignore (expr !builder_ref (S.BindExpr(line, t, S.TensorBind(inner_line, s, q))));
	  expr !builder_ref (S.TensorAssign(inner_line, t, s, q, e))

      | S.TensorAssign (line, t, s, slist, e) ->
          if List.length slist = 0 then
	      expr !builder_ref (S.Assign ("", S.Float, s, e))
	  else
          let e' = expr !builder_ref e in 
          let vis = get_vis slist !builder_ref in
          if all_bound vis then
	      if (t = S.Float || t = S.Int) then
		      let tptr = L.build_load (lookup s the_scope) s !builder_ref in
		      let lds = (gen_loads_raw (strip_vis vis) !builder_ref) in
		      let fptr = access_index tptr lds !builder_ref in
		      let fptrcast = L.build_bitcast fptr f64p_t "fpaccess" !builder_ref in
		      ignore (L.build_store (L.build_sitofp (e') f64_t "floatcast" !builder_ref) fptrcast !builder_ref); e'
	      else 
		      let tptr = L.build_load (lookup s the_scope) s !builder_ref in
		      let lds = (gen_loads_raw (strip_vis vis) !builder_ref) in
		      let iptr = access_loc tptr lds !builder_ref in
		      ignore (L.build_store e' iptr !builder_ref); e'
	          
          else
              (ignore (L.build_store e' (lookup s the_scope) !builder_ref);
              e')
      | S.TensorId (line, t, s, slist) -> 
          if List.length slist = 0 then
	      expr !builder_ref (S.Id ("", S.Float, s))
	  else
          let vis = get_vis slist !builder_ref in
          if all_bound vis then
              let tptr = L.build_load (lookup s the_scope) s !builder_ref in
	      let lds = (gen_loads_raw (strip_vis vis) !builder_ref) in
              let fptr = access_index tptr lds !builder_ref in
	      if t = S.Float then
                  let fptrcast = L.build_bitcast fptr f64p_t "fpaccess" !builder_ref in
                  L.build_load fptrcast "fpret" !builder_ref
              else
	          L.build_ptrtoint fptr i64_t "icast" !builder_ref
          else if all_free vis then
              L.build_load (lookup s the_scope) s !builder_ref
          else
              let nf = num_free vis in
              let shdr = L.build_load (lookup s the_scope) s !builder_ref in
              let hdr = build_tensor_header nf "cpy_hdr" !builder_ref in
	      let hdraddr = L.build_alloca (L.type_of hdr) "tgt_header" !builder_ref in
	      ignore (L.build_store hdr hdraddr !builder_ref);
              copy_header_static shdr hdr vis !builder_ref;
	      
	      FoldStack.push (StringMap.add "_tgt_header" hdraddr StringMap.empty) the_scope;

	      let names = gen_names "_slicenot_" 0 (strip_vis vis) in
              let names_spec = add_vis names vis in
              let names_free = get_free names_spec in
	      let im = make_slice_idx_copy_map vis 0 0 IntMap.empty in
	      let k = gen_cc_builderk s "_tgt_header" names in
              let newbuilder = gen_slice_builderk im names_free [] shdr hdr k !builder_ref in
	      FoldStack.pop the_scope;
	      builder_ref := newbuilder;
	      
              hdr
    (* Invoke "f builder" if the current block doesn't already
       have a terminal (e.g., a branch). *)
    and add_terminal builder f =
      match L.block_terminator (L.insertion_block builder) with
	Some _ -> ()
      | None -> ignore (f builder)
	
    and stmt builder = function
	S.SBlock sl -> FoldStack.push StringMap.empty the_scope; let bld = List.fold_left stmt builder sl in
	   ignore (FoldStack.pop the_scope); bld
      | S.Expr e -> builder_ref := builder; ignore (expr builder e); !builder_ref
      | S.Return e -> ignore (match fdecl.S.ftyp with
	  S.Void -> L.build_ret_void builder
	| _ -> 	
	L.build_ret (expr builder e) builder); builder
      | S.Callback f -> f builder
      | S.If (predicate, then_stmt, else_stmt) ->  
             let p = expr builder predicate in
             let bool_val = (match L.type_of p with 
                  i64_t -> L.build_icmp L.Icmp.Ne p (L.const_int i64_t 0) "booltmp" !builder_ref
                 |i1_t -> p) in
	 let merge_bb = L.append_block context "merge" the_function in

	 let then_bb = L.append_block context "then" the_function in
	 add_terminal (stmt (L.builder_at_end context then_bb) then_stmt)
	   (L.build_br merge_bb);

	 let else_bb = L.append_block context "else" the_function in
	 add_terminal (stmt (L.builder_at_end context else_bb) else_stmt)
	   (L.build_br merge_bb);

	 ignore (L.build_cond_br bool_val then_bb else_bb builder);
	 L.builder_at_end context merge_bb

      | S.While (predicate, body) ->
	  let pred_bb = L.append_block context "while" the_function in
	  ignore (L.build_br pred_bb builder);

	  let body_bb = L.append_block context "while_body" the_function in
	  add_terminal (stmt (L.builder_at_end context body_bb) body)
	    (L.build_br pred_bb);

	  let pred_builder = L.builder_at_end context pred_bb in
	  let p = expr pred_builder predicate in
          let bool_val = (match L.type_of p with
                  i64_t -> L.build_icmp L.Icmp.Ne p (L.const_int i64_t 0) "booltmp" !builder_ref
                 |i1_t -> p) in

	  let merge_bb = L.append_block context "merge" the_function in
	  ignore (L.build_cond_br bool_val body_bb merge_bb pred_builder);
	  L.builder_at_end context merge_bb

      | S.For (e1, e2, e3, body) ->
            stmt builder (S.SBlock [S.Expr e1; S.While (e2, S.SBlock [body; S.Expr e3])])
    in

    (* Build the code for each statement in the function *)
    let builder = stmt builder fdecl.S.sbody in
        
    (* Add a return if the last block falls off the end *)
    add_terminal builder (match fdecl.S.ftyp with
        S.Void -> L.build_ret_void
      | t -> L.build_ret (L.const_int (ltype_of_typ_wrapper t) 0))
  in

  List.iter build_function_body program.S.functions;
  the_module
