From be28156de988449424f1c7bba8c817cc4f72d1f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Le=CC=81onard=20Ge=CC=81rard?= Date: Thu, 17 Nov 2011 15:28:46 +0100 Subject: [PATCH] Add a simplify pass to Obc --- compiler/obc/main/obc_compiler.ml | 6 +++ compiler/obc/transformations/simplify.ml | 50 +++++++++++++++++++ compiler/utilities/global/compiler_options.ml | 1 + compiler/utilities/misc.ml | 6 +++ compiler/utilities/misc.mli | 4 ++ 5 files changed, 67 insertions(+) create mode 100644 compiler/obc/transformations/simplify.ml diff --git a/compiler/obc/main/obc_compiler.ml b/compiler/obc/main/obc_compiler.ml index 65bf8a3..afb0c9a 100644 --- a/compiler/obc/main/obc_compiler.ml +++ b/compiler/obc/main/obc_compiler.ml @@ -19,6 +19,12 @@ let compile_program p = let p = pass "Application of Memory Allocation" (!do_mem_alloc or !do_linear_typing) Memalloc_apply.program p pp in + (*Scalarize for wanting backends*) + let p = pass "Scalarize" (!do_scalarize) Scalarize.program p pp in + + (*Simplify*) + let p = pass "Simplify" (!do_simplify) Simplify.program p pp in + (*Dead code removal*) let p = pass "Dead code removal" (!do_mem_alloc or !do_linear_typing) Deadcode.program p pp in diff --git a/compiler/obc/transformations/simplify.ml b/compiler/obc/transformations/simplify.ml new file mode 100644 index 0000000..d9c910c --- /dev/null +++ b/compiler/obc/transformations/simplify.ml @@ -0,0 +1,50 @@ +(**************************************************************************) +(* *) +(* Heptagon *) +(* *) +(* Author : Marc Pouzet *) +(* Organization : Demons, LRI, University of Paris-Sud, Orsay *) +(* *) +(**************************************************************************) + +(** This module simplify static expression of the program and deal with : + (0^n)[3] ==> 0 + [3,4,5][2] ==> 5 + *) + + + +open Names +open Types +open Static +open Obc +open Obc_mapfold + +let extvaluedesc funs acc evd = match evd with + | Wconst se -> + Wconst (simplify QualEnv.empty se), acc + | Warray (ev,e) -> + let ev, acc = extvalue_it funs acc ev in + (match ev.w_desc with + | Wconst { se_desc = Sarray_power (sv, [_]) } -> + Wconst sv, acc + | Wconst ({ se_desc = Sarray_power (sv, _::idx) } as arr) -> + Wconst {arr with se_desc = Sarray_power (sv, idx)}, acc + | Wconst { se_desc = Sarray sv_l } -> + (match e.e_desc with + | Eextvalue { w_desc = Wconst i } -> + (try + let indice = int_of_static_exp QualEnv.empty i in + Wconst (Misc.nth_of_list (indice+1) sv_l), acc + with _ -> raise Errors.Fallback) + | _ -> raise Errors.Fallback + ) + | _ -> raise Errors.Fallback + ) + | _ -> raise Errors.Fallback + +let program p = + let funs = { defaults with evdesc = extvaluedesc } in + let p, _ = program_it funs [] p in + p + diff --git a/compiler/utilities/global/compiler_options.ml b/compiler/utilities/global/compiler_options.ml index 6c13bd1..25bbe8c 100644 --- a/compiler/utilities/global/compiler_options.ml +++ b/compiler/utilities/global/compiler_options.ml @@ -104,6 +104,7 @@ let add_tomato_check s = tomato_check := s :: !tomato_check let do_iterator_fusion = ref false let do_scalarize = ref false +let do_simplify = ref true let do_mem_alloc = ref false let do_linear_typing = ref false diff --git a/compiler/utilities/misc.ml b/compiler/utilities/misc.ml index bc76fa4..b892ab2 100644 --- a/compiler/utilities/misc.ml +++ b/compiler/utilities/misc.ml @@ -109,6 +109,12 @@ let rec take n l = match n, l with | n, h :: t -> take (n - 1) t | _ -> invalid_arg "take: list is too short" +let rec nth_of_list n l = match n, l with + | 1, h::t -> h + | n, h::t -> nth_of_list (n-1) t + | _ -> raise List_too_short + + let remove x l = List.filter (fun y -> x <> y) l diff --git a/compiler/utilities/misc.mli b/compiler/utilities/misc.mli index 95e3263..1ff8192 100644 --- a/compiler/utilities/misc.mli +++ b/compiler/utilities/misc.mli @@ -53,6 +53,10 @@ val split_at : int -> 'a list -> 'a list * 'a list (** [take n l] returns the [n] first elements of the list [l] *) val take : int -> 'a list -> 'a list +(** [nth_of_list n l] @return the [n] element of the list [l] (1 is the first) + @raise List_too_short exception if the list is too short.*) +val nth_of_list : int -> 'a list -> 'a + (** [remove x l] removes all occurrences of x from list l.*) val remove : 'a -> 'a list -> 'a list