Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

changed the casts

  • Loading branch information...
commit 716b937b5b8d3550d737a9b6ec3b1cf305b860c3 1 parent 411dfd9
@pikatchu pikatchu authored
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 > 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
View
9 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
View
68 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
View
2  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 $@
View
2  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
Please sign in to comment.
Something went wrong with that request. Please try again.