From e3f2781feb49325615affaaef2853c56874e6c22 Mon Sep 17 00:00:00 2001 From: Pierre-Marie Pédrot Date: Fri, 29 Aug 2014 15:52:49 +0200 Subject: Simplification of Genarg unpackers. Instead of having a version of unpackers for each level, we use a dummy argument to force unification of types. --- lib/genarg.ml | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) (limited to 'lib/genarg.ml') 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 *) -- cgit v1.2.3