aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2015-12-18 17:51:53 +0100
committerGravatar Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr>2015-12-21 19:36:38 +0100
commit9b02ddf179b375cb09966b70dd3b119eda0d92c1 (patch)
tree8e0db6b7e782eeecd64858362702a3d5412847d9
parent589130e87d68227d25800e7506666eaf1d47a25a (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.ml4
-rw-r--r--lib/genarg.ml10
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 *)