diff --git a/compiler/global/static.ml b/compiler/global/static.ml index 5d9689a..a3f39c5 100644 --- a/compiler/global/static.ml +++ b/compiler/global/static.ml @@ -21,6 +21,7 @@ open Modules (* unsatisfiable constraint *) exception Instanciation_failed +exception Partial_instanciation of static_exp exception Not_static @@ -30,34 +31,9 @@ let op_from_app_name ln = | Modname { qual = "Pervasives" } -> ln | _ -> raise Not_static -(** [simplify env e] returns e simplified with the - variables values taken from env (mapping vars to integers). - Variables are replaced with their values and every operator - that can be computed is replaced with the value of the result. *) -let rec simplify env se = match se.se_desc with - | Sint _ | Sfloat _ | Sbool _ | Sconstructor _ -> se - | Svar ln -> ( - try - let { info = cd } = find_const ln in - simplify env cd.c_value - with Not_found -> ( - match ln with - | Name n -> (try simplify env (NamesEnv.find n env) with | _ -> se) - | Modname _ -> se ) ) - | Sop (op, se_list) -> - let se_list = List.map (simplify env) se_list in - { se with se_desc = apply_op op se_list } - | Sarray se_list -> - { se with se_desc = Sarray (List.map (simplify env) se_list) } - | Sarray_power (se, n) -> - { se with se_desc = Sarray_power (simplify env se, simplify env n) } - | Stuple se_list -> - { se with se_desc = Stuple (List.map (simplify env) se_list) } - | Srecord f_se_list -> - { se with se_desc = Srecord - (List.map (fun (f,se) -> f, simplify env se) f_se_list) } -and apply_op op se_list = + +let partial_apply_op op se_list = match se_list with | [{ se_desc = Sint n1 }; { se_desc = Sint n2 }] -> (match op with @@ -81,6 +57,49 @@ and apply_op op se_list = ) | _ -> Sop(op, se_list) +let apply_op op se_list = + let se = partial_apply_op op se_list in + match se with + | Sop _ -> raise Not_found + | _ -> se + +let eval_core eval apply_op env se = match se.se_desc with + | Sint _ | Sfloat _ | Sbool _ | Sconstructor _ -> se + | Svar ln -> ( + try (* first try to find in global const env *) + let { info = cd } = find_const ln in + eval env cd.c_value + with Not_found -> ( + match ln with (* then try to find in local env *) + | Name n -> eval env (NamesEnv.find n env) + | Modname _ -> raise Not_found ) ) + | Sop (op, se_list) -> + let se_list = List.map (eval env) se_list in + { se with se_desc = apply_op op se_list } + | Sarray se_list -> + { se with se_desc = Sarray (List.map (eval env) se_list) } + | Sarray_power (se, n) -> + { se with se_desc = Sarray_power (eval env se, eval env n) } + | Stuple se_list -> + { se with se_desc = Stuple (List.map (eval env) se_list) } + | Srecord f_se_list -> + { se with se_desc = Srecord + (List.map (fun (f,se) -> f, eval env se) f_se_list) } + +(** [simplify env e] returns e simplified with the + variables values taken from [env] or from the global env with [find_const]. + Every operator that can be computed is. + It can return static_exp with uninstanciated variables.*) +let rec simplify env se = + try eval_core simplify partial_apply_op env se + with _ -> se + +(** [eval env e] does the same as [simplify] + but if it returns, there are no variables nor op left. + @raise [Partial_instanciation] when it cannot fully evaluate *) +let rec eval env se = + try eval_core eval apply_op env se + with Not_found -> raise (Partial_instanciation se) (** [int_of_static_exp env e] returns the value of the expression [e] in the environment [env], mapping vars to integers. Raises diff --git a/compiler/global/types.ml b/compiler/global/types.ml index 45620bd..4b87f38 100644 --- a/compiler/global/types.ml +++ b/compiler/global/types.ml @@ -34,7 +34,7 @@ let prod = function | [ty] -> ty | ty_list -> Tprod ty_list -(** DO NOT use this after the typing, since it gives invalid_type *) +(** DO NOT use this after the typing, since it could give invalid_type *) let mk_static_exp ?(loc = no_location) ?(ty = invalid_type) desc = { se_desc = desc; se_ty = ty; se_loc = loc } diff --git a/compiler/minils/transformations/callgraph_mapfold.ml b/compiler/minils/transformations/callgraph_mapfold.ml index 195583a..6d0c124 100644 --- a/compiler/minils/transformations/callgraph_mapfold.ml +++ b/compiler/minils/transformations/callgraph_mapfold.ml @@ -13,7 +13,7 @@ module Error = struct type error = | Enode_unbound of longname - | Evar_unbound of name + | Epartial_instanciation of static_exp let message loc kind = begin match kind with @@ -21,10 +21,10 @@ struct Format.eprintf "%aUnknown node '%s'@." print_location loc (fullname ln) - | Evar_unbound n -> - Format.eprintf "%aUnbound static var '%s'\n" - print_location loc - n + | Epartial_instanciation se -> + Format.eprintf "%aUnable to fully instanciate the static exp '%a'@." + print_location se.se_loc + print_static_exp se end; raise Misc.Error end @@ -76,7 +76,10 @@ struct let nodes_instances = ref LongNameEnv.empty (** create a params instance *) - let instantiate m se = List.map (simplify m) se + let instantiate m se = + try List.map (eval m) se + with Partial_instanciation se -> + Error.message no_location (Error.Epartial_instanciation se) (** @return the name of the node corresponding to the instance of [ln] with the static parameters [params]. *) @@ -137,9 +140,6 @@ struct | Name n -> (try NamesEnv.find n m with Not_found -> (* It should then be in the global env *) - (* TODO should we check it's in the global env ? - I guess it should not be necessary cf typing. - Error.message se.se_loc (Error.Evar_unbound n)) *) se) | Modname _ -> se) | _ -> se in