diff options
author | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2014-08-29 15:52:49 +0200 |
---|---|---|
committer | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2014-08-29 18:43:06 +0200 |
commit | e3f2781feb49325615affaaef2853c56874e6c22 (patch) | |
tree | b555e77cb1833390eb37a67731a4f34a1a030885 /lib | |
parent | 029f850bceb1f68640fe7b703b0875ad02486691 (diff) |
Simplification of Genarg unpackers.
Instead of having a version of unpackers for each level, we use a dummy argument
to force unification of types.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/genarg.ml | 16 | ||||
-rw-r--r-- | lib/genarg.mli | 16 |
2 files changed, 14 insertions, 18 deletions
diff --git a/lib/genarg.ml b/lib/genarg.ml index 89b6f23de..b85fef087 100644 --- a/lib/genarg.ml +++ b/lib/genarg.ml @@ -159,18 +159,16 @@ type 'a raw_abstract_argument_type = ('a,rlevel) abstract_argument_type type 'a glob_abstract_argument_type = ('a,glevel) abstract_argument_type type 'a typed_abstract_argument_type = ('a,tlevel) abstract_argument_type -type 'r raw_unpack = - { raw_unpack : 'a 'b 'c. ('a, 'b, 'c) genarg_type -> 'a -> 'r } +type ('a, 'b, 'c, 'l) cast = Obj.t -type 'r glb_unpack = - { glb_unpack : 'a 'b 'c. ('a, 'b, 'c) genarg_type -> 'b -> 'r } +let raw = Obj.obj +let glb = Obj.obj +let top = Obj.obj -type 'r top_unpack = - { top_unpack : 'a 'b 'c. ('a, 'b, 'c) genarg_type -> 'c -> 'r } +type ('r, 'l) unpacker = + { unpacker : 'a 'b 'c. ('a, 'b, 'c) genarg_type -> ('a, 'b, 'c, 'l) cast -> 'r } -let raw_unpack pack (t, obj) = pack.raw_unpack t (Obj.obj obj) -let glb_unpack pack (t, obj) = pack.glb_unpack t (Obj.obj obj) -let top_unpack pack (t, obj) = pack.top_unpack t (Obj.obj obj) +let unpack pack (t, obj) = pack.unpacker t (Obj.obj obj) (** Creating args *) diff --git a/lib/genarg.mli b/lib/genarg.mli index 45f0dddf2..e96f21c10 100644 --- a/lib/genarg.mli +++ b/lib/genarg.mli @@ -143,18 +143,16 @@ val has_type : 'co generic_argument -> ('a, 'co) abstract_argument_type -> bool (** {6 Destructors} *) -type 'r raw_unpack = - { raw_unpack : 'a 'b 'c. ('a, 'b, 'c) genarg_type -> 'a -> 'r } +type ('a, 'b, 'c, 'l) cast -type 'r glb_unpack = - { glb_unpack : 'a 'b 'c. ('a, 'b, 'c) genarg_type -> 'b -> 'r } +val raw : ('a, 'b, 'c, rlevel) cast -> 'a +val glb : ('a, 'b, 'c, glevel) cast -> 'b +val top : ('a, 'b, 'c, tlevel) cast -> 'c -type 'r top_unpack = - { top_unpack : 'a 'b 'c. ('a, 'b, 'c) genarg_type -> 'c -> 'r } +type ('r, 'l) unpacker = + { unpacker : 'a 'b 'c. ('a, 'b, 'c) genarg_type -> ('a, 'b, 'c, 'l) cast -> 'r } -val raw_unpack : 'r raw_unpack -> rlevel generic_argument -> 'r -val glb_unpack : 'r glb_unpack -> glevel generic_argument -> 'r -val top_unpack : 'r top_unpack -> tlevel generic_argument -> 'r +val unpack : ('r, 'l) unpacker -> 'l generic_argument -> 'r (** Existential-type destructors. *) (** {6 Manipulation of generic arguments} |