diff options
author | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2015-12-18 17:51:53 +0100 |
---|---|---|
committer | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2015-12-21 19:36:38 +0100 |
commit | 9b02ddf179b375cb09966b70dd3b119eda0d92c1 (patch) | |
tree | 8e0db6b7e782eeecd64858362702a3d5412847d9 | |
parent | 589130e87d68227d25800e7506666eaf1d47a25a (diff) |
Sharing toplevel representation for several generic types.
- int and int_or_var
- ident and var
- constr and constr_may_eval
-rw-r--r-- | interp/stdarg.ml | 4 | ||||
-rw-r--r-- | lib/genarg.ml | 10 |
2 files changed, 8 insertions, 6 deletions
diff --git a/interp/stdarg.ml b/interp/stdarg.ml index e155a5217..5cfe3854a 100644 --- a/interp/stdarg.ml +++ b/interp/stdarg.ml @@ -15,7 +15,9 @@ let wit_bool : bool uniform_genarg_type = make0 None "bool" let wit_int : int uniform_genarg_type = - make0 None "int" + make0 ~dyn:(val_tag (Obj.magic IntOrVarArgType)) None "int" +(** FIXME: IntOrVarArgType is hardwired, but that definition should be the other + way around. *) let wit_string : string uniform_genarg_type = make0 None "string" diff --git a/lib/genarg.ml b/lib/genarg.ml index bf223f99e..3989cf6df 100644 --- a/lib/genarg.ml +++ b/lib/genarg.ml @@ -168,12 +168,10 @@ let default_empty_value t = | None -> None (** Beware: keep in sync with the corresponding types *) -let int_or_var_T = Val.create "int_or_var" +let int_or_var_T = Val.create "int" let ident_T = Val.create "ident" -let var_T = Val.create "var" let genarg_T = Val.create "genarg" let constr_T = Val.create "constr" -let constr_may_eval_T = Val.create "constr_may_eval" let open_constr_T = Val.create "open_constr" let option_val = Val.create "option" @@ -183,9 +181,11 @@ let pair_val = Val.create "pair" let val_tag = function | IntOrVarArgType -> cast_tag int_or_var_T | IdentArgType -> cast_tag ident_T -| VarArgType -> cast_tag var_T +| VarArgType -> cast_tag ident_T + (** Must ensure that toplevel types of Var and Ident agree! *) | ConstrArgType -> cast_tag constr_T -| ConstrMayEvalArgType -> cast_tag constr_may_eval_T +| ConstrMayEvalArgType -> cast_tag constr_T + (** Must ensure that toplevel types of Constr and ConstrMayEval agree! *) | OpenConstrArgType -> cast_tag open_constr_T | ExtraArgType s -> Obj.magic (String.Map.find s !arg0_map).dyn (** Recursive types have no associated dynamic tag *) |