From 9998d7ea3993afb512ea257161d665ae5a54cb5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9onard=20G=C3=A9rard?= Date: Tue, 23 Nov 2010 17:10:11 +0100 Subject: [PATCH] Added a unit type. Tunit. --- compiler/global/clocks.ml | 29 ++++++++++------------- compiler/global/global_compare.ml | 2 ++ compiler/global/global_mapfold.ml | 1 + compiler/global/global_printer.ml | 1 + compiler/global/modules.ml | 1 + compiler/global/types.ml | 6 ++++- compiler/heptagon/analysis/typing.ml | 1 + compiler/minils/transformations/tomato.ml | 3 ++- compiler/obc/c/cgen.ml | 1 + compiler/obc/c/cmain.ml | 4 ++-- todo.txt | 10 ++++++++ 11 files changed, 39 insertions(+), 20 deletions(-) create mode 100644 todo.txt diff --git a/compiler/global/clocks.ml b/compiler/global/clocks.ml index a57fd26..61702f7 100644 --- a/compiler/global/clocks.ml +++ b/compiler/global/clocks.ml @@ -28,6 +28,8 @@ and link = exception Unify +let invalid_clock = Cprod [] + let index = ref 0 @@ -53,18 +55,8 @@ let rec occur_check index ck = | Con (ck, _, _) -> occur_check index ck | _ -> raise Unify - -let rec unify t1 t2 = - if t1 == t2 - then () - else - (match (t1, t2) with - | (Ck ck1, Ck ck2) -> unify_ck ck1 ck2 - | (Cprod ct_list1, Cprod ct_list2) -> - (try List.iter2 unify ct_list1 ct_list2 with | _ -> raise Unify) - | _ -> raise Unify) - -and unify_ck ck1 ck2 = +(** unify ck *) +let rec unify_ck ck1 ck2 = let ck1 = ck_repr ck1 in let ck2 = ck_repr ck2 in if ck1 == ck2 @@ -82,22 +74,27 @@ and unify_ck ck1 ck2 = unify_ck ck1 ck2 | _ -> raise Unify) - +(** unify ct *) let rec unify t1 t2 = + if t1 == t2 then () else match (t1, t2) with | (Ck ck1, Ck ck2) -> unify_ck ck1 ck2 | (Cprod t1_list, Cprod t2_list) -> unify_list t1_list t2_list | _ -> raise Unify and unify_list t1_list t2_list = - try List.iter2 unify t1_list t2_list with | _ -> raise Unify + try List.iter2 unify t1_list t2_list + with _ -> raise Unify + let rec skeleton ck = function | Tprod ty_list -> (match ty_list with - | [] -> Format.eprintf "Warning, an exp with void type@."; Ck ck + | [] -> + Format.eprintf "Internal error, an exp with invalid type@."; + assert false; | _ -> Cprod (List.map (skeleton ck) ty_list)) - | Tarray _ | Tid _ -> Ck ck + | Tarray _ | Tid _ | Tunit -> Ck ck (* TODO here it implicitely says that the base clock is Cbase and that all tuple is on Cbase *) diff --git a/compiler/global/global_compare.ml b/compiler/global/global_compare.ml index c48b8a4..00c75df 100644 --- a/compiler/global/global_compare.ml +++ b/compiler/global/global_compare.ml @@ -102,3 +102,5 @@ and type_compare ty1 ty2 = match ty1, ty2 with if cr <> 0 then cr else static_exp_compare se1 se2 | (Tprod _ | Tid _), _ -> 1 | (Tarray _), _ -> -1 + | Tunit, Tunit -> 0 + | Tunit, _ -> -1 diff --git a/compiler/global/global_mapfold.ml b/compiler/global/global_mapfold.ml index f90d634..1af3f94 100644 --- a/compiler/global/global_mapfold.ml +++ b/compiler/global/global_mapfold.ml @@ -59,6 +59,7 @@ and ty funs acc t = match t with let t, acc = ty_it funs acc t in let se, acc = static_exp_it funs acc se in Tarray (t, se), acc + | Tunit -> t, acc (* and ct_it funs acc c = try funs.ct funs acc c with Fallback -> ct funs acc t and ct funs acc c = match c with diff --git a/compiler/global/global_printer.ml b/compiler/global/global_printer.ml index 0a4be9e..814895c 100644 --- a/compiler/global/global_printer.ml +++ b/compiler/global/global_printer.ml @@ -48,6 +48,7 @@ and print_type ff = function | Tid id -> print_qualname ff id | Tarray (ty, n) -> fprintf ff "@[%a^%a@]" print_type ty print_static_exp n + | Tunit -> fprintf ff "()" let print_field ff field = fprintf ff "@[%a: %a@]" print_qualname field.f_name print_type field.f_type diff --git a/compiler/global/modules.ml b/compiler/global/modules.ml index 4384a89..6fce969 100644 --- a/compiler/global/modules.ml +++ b/compiler/global/modules.ml @@ -262,6 +262,7 @@ let rec unalias_type t = match t with with Not_found -> raise (Undefined_type ty_name)) | Tarray (ty, n) -> Tarray(unalias_type ty, n) | Tprod ty_list -> Tprod (List.map unalias_type ty_list) + | Tunit -> Tunit (** Return the current module as a [module_object] *) diff --git a/compiler/global/types.ml b/compiler/global/types.ml index 9fa71a4..c2832b0 100644 --- a/compiler/global/types.ml +++ b/compiler/global/types.ml @@ -26,7 +26,11 @@ and static_exp_desc = | Srecord of (field_name * static_exp) list (** { f1 = e1; f2 = e2; ... } *) | Sop of fun_name * static_exp list (** defined ops for now in pervasives *) -and ty = | Tprod of ty list | Tid of type_name | Tarray of ty * static_exp +and ty = + | Tprod of ty list + | Tid of type_name + | Tarray of ty * static_exp + | Tunit let invalid_type = Tprod [] diff --git a/compiler/heptagon/analysis/typing.ml b/compiler/heptagon/analysis/typing.ml index 4896927..c031168 100644 --- a/compiler/heptagon/analysis/typing.ml +++ b/compiler/heptagon/analysis/typing.ml @@ -384,6 +384,7 @@ let rec check_type const_env = function | Tid ty_name -> Tid ty_name | Tprod l -> Tprod (List.map (check_type const_env) l) + | Tunit -> Tunit and typing_static_exp const_env se = try diff --git a/compiler/minils/transformations/tomato.ml b/compiler/minils/transformations/tomato.ml index 1e2e283..5519839 100644 --- a/compiler/minils/transformations/tomato.ml +++ b/compiler/minils/transformations/tomato.ml @@ -398,7 +398,8 @@ let rec reconstruct input_type (env : PatEnv.t) = | Evarpat ident, _ -> mk_var_dec ident ty :: var_list | Etuplepat pat_list, Tprod ty_list -> List.fold_right2 mk_var_decs pat_list ty_list var_list - | Etuplepat _, (Tarray _ | Tid _) -> assert false (* ill-typed *) in + | Etuplepat [], Tunit -> var_list + | Etuplepat _, (Tarray _ | Tid _ | Tunit) -> assert false (* ill-typed *) in let add_to_lists pat (_, head, children) (eq_list, var_list) = (* Remember the encoding of resets given above. *) diff --git a/compiler/obc/c/cgen.ml b/compiler/obc/c/cgen.ml index 8974644..0096b8c 100644 --- a/compiler/obc/c/cgen.ml +++ b/compiler/obc/c/cgen.ml @@ -102,6 +102,7 @@ let rec ctype_of_otype oty = | Tarray(ty, n) -> Cty_arr(int_of_static_exp n, ctype_of_otype ty) | Tprod _ -> assert false + | Tunit -> assert false let cvarlist_of_ovarlist vl = let cvar_of_ovar vd = diff --git a/compiler/obc/c/cmain.ml b/compiler/obc/c/cmain.ml index dda9f96..1b1a2a8 100644 --- a/compiler/obc/c/cmain.ml +++ b/compiler/obc/c/cmain.ml @@ -84,7 +84,7 @@ let assert_node_res cd = (* TODO: refactor into something more readable. *) let main_def_of_class_def cd = let format_for_type ty = match ty with - | Tarray _ | Tprod _ -> assert false + | Tarray _ | Tprod _ | Tunit -> assert false | Types.Tid id when id = Initial.pfloat -> "%f" | Types.Tid id when id = Initial.pint -> "%d" | Types.Tid id when id = Initial.pbool -> "%d" @@ -93,7 +93,7 @@ let main_def_of_class_def cd = (** Does reading type [ty] need a buffer? When it is the case, [need_buf_for_ty] also returns the type's name. *) let need_buf_for_ty ty = match ty with - | Tarray _ | Tprod _ -> assert false + | Tarray _ | Tprod _ | Tunit -> assert false | Types.Tid id when id = Initial.pfloat -> None | Types.Tid id when id = Initial.pint -> None | Types.Tid id when id = Initial.pbool -> None diff --git a/todo.txt b/todo.txt new file mode 100644 index 0000000..e42266b --- /dev/null +++ b/todo.txt @@ -0,0 +1,10 @@ + +Plus ou moins ordonné du plus urgent au moins urgent. + +*- (LG) Faire la passe de transformation des switchs dans heptagon avant le reset et ainsi simplifier le reset. + +*- (LG) Rajouter les annotations d'horloge dans le source (les mettres comme contrainte de sous typage en ck_base ?? voir avec lucy-n) + +*- Compléter la passe "static.ml" pour gérer l'ensemble des opérateurs de pervasives + +*- Optimiser le reset en utilisant un memcopy ?