Permalink
Browse files

Revert "changed the casts"

This reverts commit 716b937.
  • Loading branch information...
1 parent 716b937 commit aa47e7d5b5adf9574cf7474d358c6846901c42db @pikatchu committed Apr 25, 2011
Showing with 32 additions and 66 deletions.
  1. +9 −8 compiler/emit.ml
  2. +3 −6 compiler/llstOfEst.ml
  3. +18 −50 test/examples/map.lml
  4. +1 −1 test/shootout/Makefile
  5. +1 −1 test/unit/go.sh
View
17 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 > Global.max_reg_return
+ if List.length ty2 > 1
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 [|Llvm.const_null (pointer_type (i8_type ctx))|] "" builder in
+ let v = build_call f [|z|] "" builder in
set_instruction_call_conv ccfast v ; (* TODO check signature etc ... *)
let _ = build_ret z builder in
()
@@ -333,7 +333,8 @@ let dump_module md_file md pm =
let optims pm =
()
; add_memory_to_register_demotion pm
- ; add_instruction_combination pm
+ ; add_tail_call_elimination pm
+(* ; add_instruction_combination pm
; add_memory_to_register_promotion pm
; add_constant_propagation pm
; add_sccp pm
@@ -353,6 +354,7 @@ 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
@@ -362,9 +364,8 @@ let optims pm =
; add_aggressive_dce pm
; add_scalar_repl_aggregation pm
; add_ind_var_simplification pm
- ; add_instruction_combination pm
- ; add_tail_call_elimination pm
-
+ ; add_instruction_combination pm
+*)
let rec program base root no_opt dump_as mdl =
let ctx = global_context() in
@@ -424,7 +425,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 > Global.max_reg_return ->
+ | ret :: params when List.length df.df_ret > 1 ->
Some ret, params
| _ -> None, params in
env.ret := ret ;
@@ -583,7 +584,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 > Global.max_reg_return ->
+ | Tfun (_, _, tyl) when List.length tyl > 1 ->
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
View
9 compiler/llstOfEst.ml
@@ -321,12 +321,9 @@ and type_expr = function
Llst.Tfun (k, tyl1, tyl2)
and ftype_expr = function
- | Tany
- | Tprim _
- | Tvar _ -> Llst.Tany
- | Tid x
- | Tapply (x, _) -> Llst.Tid x
- | Tfun _ as ft -> type_expr ft
+ | Tany | Tprim _
+ | Tvar _ | Tid _
+ | Tapply _ | Tfun _ -> Llst.Tprim Llst.Tint
and ftype_expr_list l = List.map ftype_expr l
View
68 test/examples/map.lml
@@ -353,52 +353,6 @@ 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
@@ -407,9 +361,23 @@ module Test = struct
val cpy: int obs -> int
let cpy x = x
- val main: unit -> Loop.env
+ 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
let main() =
- let env = Map.init cmp 0 0 cpy cpy Loop.fint Loop.fint in
- let env = Loop.make env 1000000 in
- env
+ 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
end
View
2 test/shootout/Makefile
@@ -2,7 +2,7 @@
LIMLC = ../../compiler/limlc
-default: fankuch.run bintree_2.run
+default: fankuch.run bintree.run
%.run: %.lml
$(LIMLC) $< -root Main -o $@
View
2 test/unit/go.sh
@@ -2,5 +2,5 @@
for i in test*.lml ; do
echo "RUNNING: $i" ;
- ../../limlc $i -root Test ;
+ ../../liml $i -main Test ;
done

0 comments on commit aa47e7d

Please sign in to comment.