changed the casts

compiler/emit.ml

@@ -153,7 +153,7 @@ module Type = struct
 
   and type_fun mds t ctx ty1 ty2 =
     let ty1, ty2 = 
-      if List.length ty2 > 1
+      if List.length ty2 > Global.max_reg_return
       then Tptr (Tstruct ty2) :: ty1, []
       else ty1, ty2 in
     let ty1 = type_args mds t ctx ty1 in
@@ -299,7 +299,7 @@ module MakeRoot = struct
     let fdec = declare_function name ftype md in
     let bb = append_block ctx "" fdec in
     position_at_end bb builder ;  
-    let v = build_call f [|z|] "" builder in
+    let v = build_call f [|Llvm.const_null (pointer_type (i8_type ctx))|] "" builder in
     set_instruction_call_conv ccfast v ; (* TODO check signature etc ... *)
     let _ = build_ret z builder in 
     ()
@@ -333,8 +333,7 @@ let dump_module md_file md pm =
 let optims pm = 
   ()
     ;  add_memory_to_register_demotion pm
-    ;  add_tail_call_elimination pm
-(*    ;  add_instruction_combination pm  
+    ;  add_instruction_combination pm  
     ;  add_memory_to_register_promotion pm
     ;  add_constant_propagation pm
     ;  add_sccp pm
@@ -354,7 +353,6 @@ let optims pm =
     ;  add_gvn pm
     ;  add_memcpy_opt pm
     ;  add_loop_deletion pm
-    ;  add_tail_call_elimination pm
     ;  add_lib_call_simplification pm
     ;  add_ind_var_simplification pm
     ;  add_instruction_combination pm  
@@ -364,8 +362,9 @@ let optims pm =
     ;  add_aggressive_dce pm
     ;  add_scalar_repl_aggregation pm
     ;  add_ind_var_simplification pm  
-    ; add_instruction_combination pm 
-*)
+    ;  add_instruction_combination pm 
+    ;  add_tail_call_elimination pm
+
 
 let rec program base root no_opt dump_as mdl = 
   let ctx = global_context() in
@@ -425,7 +424,7 @@ and function_ env df =
   let params = Array.to_list params in
   let ret, params = 
     match params with
-    | ret :: params when List.length df.df_ret > 1 ->
+    | ret :: params when List.length df.df_ret > Global.max_reg_return ->
       Some ret, params 
     | _ -> None, params in
   env.ret := ret ;
@@ -584,7 +583,7 @@ and apply env acc xl fk (fty, f) argl =
   let argl = build_args acc argl in
   let ret, argl = 
     match fty with
-    | Tfun (_, _, tyl) when List.length tyl > 1 ->
+    | Tfun (_, _, tyl) when List.length tyl > Global.max_reg_return ->
 	let int = Type.type_prim env.ctx Llst.Tint in
 	let tty = List.map (fun _ -> int) tyl in
 	let ty = struct_type env.ctx (Array.of_list tty) in

compiler/llstOfEst.ml

@@ -321,9 +321,12 @@ and type_expr = function
       Llst.Tfun (k, tyl1, tyl2)
 
 and ftype_expr = function
-  | Tany | Tprim _
-  | Tvar _ | Tid _
-  | Tapply _ | Tfun _ -> Llst.Tprim Llst.Tint
+  | Tany 
+  | Tprim _
+  | Tvar _ -> Llst.Tany
+  | Tid x
+  | Tapply (x, _) ->  Llst.Tid x
+  | Tfun _ as ft -> type_expr ft
 
 and ftype_expr_list l = List.map ftype_expr l
 

test/examples/map.lml

@@ -353,6 +353,52 @@ module Map = struct
 
 end
 
+module Loop = struct
+
+  type env = {
+      menv: (int, int) Map.env;
+      macc: (int, int) Map.t;
+    }
+
+  val fint: int -> unit
+  let fint _ = ()
+
+  val free_env: env -> Map.error List.t
+  let free_env env =
+    let { env; ~menv; ~macc } = env in
+    Map.free_t !fint !fint macc;
+    let errl = Map.free_env menv in
+    free env;
+    errl
+
+  val private f: env * int -> env
+  let f env i = 
+    if i < 0
+    then env
+    else 
+      let {env; ~menv; ~macc} = env in
+      let menv, macc = Map.add menv i i macc in
+      let env = { env with ~menv; ~macc } in
+      f env (i-1)
+
+  val private f2: env * int * int -> env
+  let f2 env acc i = 
+    if i < 0
+    then env
+    else
+      let { env; ~menv } = env in
+      let menv, x = Map.find menv i env.macc in
+      let env = { env with ~menv } in
+      f2 env (acc + x) (i-1)
+
+  val make: (int, int) Map.env * int -> env
+  let make menv n =
+    let env = { menv = menv; macc = Map.empty() } in
+    let env = f env n in
+    let env = f2 env 0 n in
+    env
+end
+
 module Test = struct
 
   val cmp: int obs * int obs -> int
@@ -361,23 +407,9 @@ module Test = struct
   val cpy: int obs -> int
   let cpy x = x
 
-  val make: 
-       (int, int) Map.env * (int, int) Map.t * int
-    -> (int, int) Map.env * (int, int) Map.t
-  let make env acc i = 
-    if i < 0
-    then env, acc
-    else 
-      let env, acc = Map.add env i i acc in
-      make env acc (i-1)
-
-  val fint: int -> unit
-  let fint _ = ()
-
-  val main: unit -> Map.error List.t
+  val main: unit -> Loop.env
   let main() =
-    let env = Map.init cmp 0 0 cpy cpy fint fint in
-    let env, t = make env (Map.empty()) 1000000 in
-    Map.free_t !fint !fint t;
-    Map.free_env env
+    let env = Map.init cmp 0 0 cpy cpy Loop.fint Loop.fint in
+    let env = Loop.make env 1000000 in
+    env
 end

test/shootout/Makefile

@@ -2,7 +2,7 @@
 LIMLC = ../../compiler/limlc
 
 
-default: fankuch.run bintree.run
+default: fankuch.run bintree_2.run
 
 %.run: %.lml
 	$(LIMLC) $< -root Main -o $@

test/unit/go.sh

@@ -2,5 +2,5 @@
 
 for i in test*.lml ; do 
     echo "RUNNING:     $i" ;
-    ../../liml $i -main Test ; 
+    ../../limlc $i -root Test ; 
 done