diff --git a/compiler/global/linearity.ml b/compiler/global/linearity.ml index 1c9be78..96d78c1 100644 --- a/compiler/global/linearity.ml +++ b/compiler/global/linearity.ml @@ -87,7 +87,7 @@ let rec unify_lin expected_lin lin = | _, _ -> raise UnifyFailed let check_linearity lin = - if is_linear lin && not !Compiler_options.do_mem_alloc then + if is_linear lin && not !Compiler_options.do_linear_typing then Ltop else lin diff --git a/compiler/heptagon/analysis/typing.ml b/compiler/heptagon/analysis/typing.ml index 90af552..836d0d5 100644 --- a/compiler/heptagon/analysis/typing.ml +++ b/compiler/heptagon/analysis/typing.ml @@ -198,7 +198,7 @@ let message loc kind = | Eenable_memalloc -> eprintf "%aThis function was compiled with linear types. \ - Enable memory allocation to call it.@." + Enable linear typing to call it.@." print_location loc end; raise Errors.Error @@ -235,7 +235,7 @@ let flatten_ty_list l = let kind f ty_desc = let ty_of_arg v = - if Linearity.is_linear v.a_linearity && not !Compiler_options.do_mem_alloc then + if Linearity.is_linear v.a_linearity && not !Compiler_options.do_linear_typing then error Eenable_memalloc; v.a_type in diff --git a/compiler/heptagon/main/hept_compiler.ml b/compiler/heptagon/main/hept_compiler.ml index 4835c4b..3f45d1a 100644 --- a/compiler/heptagon/main/hept_compiler.ml +++ b/compiler/heptagon/main/hept_compiler.ml @@ -18,7 +18,7 @@ let compile_program p = (* Typing *) let p = silent_pass "Statefulness check" true Stateful.program p in let p = pass "Typing" true Typing.program p pp in - let p = pass "Linear Typing" !do_mem_alloc Linear_typing.program p pp in + let p = pass "Linear Typing" !do_linear_typing Linear_typing.program p pp in (* Causality check *) let p = silent_pass "Causality check" !causality Causality.program p in diff --git a/compiler/main/heptc.ml b/compiler/main/heptc.ml index cb3eafd..673439d 100644 --- a/compiler/main/heptc.ml +++ b/compiler/main/heptc.ml @@ -123,7 +123,9 @@ let main () = "-fti", Arg.Set full_type_info, doc_full_type_info; "-fname", Arg.Set full_name, doc_full_name; "-itfusion", Arg.Set do_iterator_fusion, doc_itfusion; - "-memalloc", Arg.Set do_mem_alloc, doc_memalloc; + "-memalloc", Arg.Unit do_mem_alloc_and_typing, doc_memalloc; + "-only-memalloc", Arg.Set do_mem_alloc, doc_memalloc_only; + "-only-linear", Arg.Set do_linear_typing, doc_linear_only; "-sch-interf", Arg.Set use_interf_scheduler, doc_interf_scheduler ] compile errmsg; diff --git a/compiler/obc/main/obc_compiler.ml b/compiler/obc/main/obc_compiler.ml index e1fc3b4..43a6788 100644 --- a/compiler/obc/main/obc_compiler.ml +++ b/compiler/obc/main/obc_compiler.ml @@ -18,9 +18,11 @@ let compile_program p = let p = pass "Control optimization" true Control.program p pp in (* Memory allocation application *) - let p = pass "Application of Memory Allocation" !do_mem_alloc Memalloc_apply.program p pp in + let p = pass "Application of Memory Allocation" + (!do_mem_alloc or !do_linear_typing) Memalloc_apply.program p pp in (*Dead code removal*) - let p = pass "Dead code removal" !do_mem_alloc Deadcode.program p pp in + let p = pass "Dead code removal" + (!do_mem_alloc or !do_linear_typing) Deadcode.program p pp in p diff --git a/compiler/obc/transformations/memalloc_apply.ml b/compiler/obc/transformations/memalloc_apply.ml index 5243a6d..b75e929 100644 --- a/compiler/obc/transformations/memalloc_apply.ml +++ b/compiler/obc/transformations/memalloc_apply.ml @@ -146,7 +146,12 @@ let var_decs _ (env, mutables,j) vds = let add_other_vars md cd = let add_one (env, ty_env) vd = - if is_linear vd.v_linearity && not (Interference.World.is_optimized_ty vd.v_type) then + let should_add_var = + is_linear vd.v_linearity && + (not !Compiler_options.do_mem_alloc + || not (Interference.World.is_optimized_ty vd.v_type)) + in + if should_add_var then let r = location_name vd.v_linearity in let env = LinListEnv.add_element r (Ivar vd.v_ident) env in let ty_env = LocationEnv.add r vd.v_type ty_env in @@ -168,7 +173,13 @@ let class_def funs acc cd = let outputs = ivars_of_vds md.m_outputs in let mems = ivars_of_vds cd.cd_mems in (*add linear variables not taken into account by memory allocation*) - let mem_alloc = (add_other_vars md cd) @ cd.cd_mem_alloc in + let mem_alloc = + if !Compiler_options.do_linear_typing then + add_other_vars md cd + else + [] + in + let mem_alloc = mem_alloc @ cd.cd_mem_alloc in let env, mutables = memalloc_subst_map inputs outputs mems mem_alloc in let cd, _ = Obc_mapfold.class_def funs (env, mutables, cd.cd_objs) cd in (* remove unnecessary outputs*) diff --git a/compiler/utilities/global/compiler_options.ml b/compiler/utilities/global/compiler_options.ml index 5a6e968..d036020 100644 --- a/compiler/utilities/global/compiler_options.ml +++ b/compiler/utilities/global/compiler_options.ml @@ -104,6 +104,11 @@ let do_iterator_fusion = ref false let do_scalarize = ref false let do_mem_alloc = ref false +let do_linear_typing = ref false + +let do_mem_alloc_and_typing () = + do_mem_alloc := true; + do_linear_typing := true let use_interf_scheduler = ref false @@ -134,5 +139,7 @@ and doc_assert = "\t\tInsert run-time assertions for boolean node " and doc_inline = "\t\tInline node " and doc_itfusion = "\t\tEnable iterator fusion." and doc_tomato = "\t\tEnable automata minimization." -and doc_memalloc = "\t\tEnable memory allocation" +and doc_memalloc = "\t\tEnable memory allocation and linear annotations" +and doc_memalloc_only = "\t\tEnable memory allocation" +and doc_linear_only = "\t\tEnable linear annotations" and doc_interf_scheduler = "\t\tUse a scheduler that tries to minimise interferences"