diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/genarg.ml | 33 | ||||
| -rw-r--r-- | lib/genarg.mli | 16 |
2 files changed, 13 insertions, 36 deletions
diff --git a/lib/genarg.ml b/lib/genarg.ml index c201d78b48..358a010aea 100644 --- a/lib/genarg.ml +++ b/lib/genarg.ml @@ -25,8 +25,7 @@ type argument_type = | ConstrWithBindingsArgType | BindingsArgType | RedExprArgType - | List0ArgType of argument_type - | List1ArgType of argument_type + | ListArgType of argument_type | OptArgType of argument_type | PairArgType of argument_type * argument_type | ExtraArgType of string @@ -45,8 +44,7 @@ let rec argument_type_eq arg1 arg2 = match arg1, arg2 with | ConstrWithBindingsArgType, ConstrWithBindingsArgType -> true | BindingsArgType, BindingsArgType -> true | RedExprArgType, RedExprArgType -> true -| List0ArgType arg1, List0ArgType arg2 -> argument_type_eq arg1 arg2 -| List1ArgType arg1, List1ArgType arg2 -> argument_type_eq arg1 arg2 +| ListArgType arg1, ListArgType arg2 -> argument_type_eq arg1 arg2 | OptArgType arg1, OptArgType arg2 -> argument_type_eq arg1 arg2 | PairArgType (arg1l, arg1r), PairArgType (arg2l, arg2r) -> argument_type_eq arg1l arg2l && argument_type_eq arg1r arg2r @@ -73,9 +71,7 @@ let rawwit t = t let glbwit t = t let topwit t = t -let wit_list0 t = List0ArgType t - -let wit_list1 t = List1ArgType t +let wit_list t = ListArgType t let wit_opt t = OptArgType t @@ -85,15 +81,10 @@ let in_gen t o = (t,Obj.repr o) let out_gen t (t',o) = if argument_type_eq t t' then Obj.magic o else failwith "out_gen" let genarg_tag (s,_) = s -let fold_list0 f = function - | (List0ArgType t, l) -> - List.fold_right (fun x -> f (in_gen t x)) (Obj.magic l) - | _ -> failwith "Genarg: not a list0" - -let fold_list1 f = function - | (List1ArgType t, l) -> +let fold_list f = function + | (ListArgType t, l) -> List.fold_right (fun x -> f (in_gen t x)) (Obj.magic l) - | _ -> failwith "Genarg: not a list1" + | _ -> failwith "Genarg: not a list" let fold_opt f a = function | (OptArgType t, l) -> @@ -108,18 +99,12 @@ let fold_pair f = function f (in_gen t1 x1) (in_gen t2 x2) | _ -> failwith "Genarg: not a pair" -let app_list0 f = function - | (List0ArgType t as u, l) -> +let app_list f = function + | (ListArgType t as u, l) -> let o = Obj.magic l in (u, Obj.repr (List.map (fun x -> out_gen t (f (in_gen t x))) o)) | _ -> failwith "Genarg: not a list0" -let app_list1 f = function - | (List1ArgType t as u, l) -> - let o = Obj.magic l in - (u, Obj.repr (List.map (fun x -> out_gen t (f (in_gen t x))) o)) - | _ -> failwith "Genarg: not a list1" - let app_opt f = function | (OptArgType t as u, l) -> let o = Obj.magic l in @@ -175,7 +160,7 @@ let make0 = create_arg let default_empty_value t = let rec aux = function - | List0ArgType _ -> Some (Obj.repr []) + | ListArgType _ -> Some (Obj.repr []) | OptArgType _ -> Some (Obj.repr None) | PairArgType(t1, t2) -> (match aux t1, aux t2 with diff --git a/lib/genarg.mli b/lib/genarg.mli index 8152a19ed8..a7232c6bd7 100644 --- a/lib/genarg.mli +++ b/lib/genarg.mli @@ -162,10 +162,7 @@ val top_unpack : 'r top_unpack -> tlevel generic_argument -> 'r Those functions fail if they are applied to an argument which has not the right dynamic type. *) -val fold_list0 : - ('a generic_argument -> 'c -> 'c) -> 'a generic_argument -> 'c -> 'c - -val fold_list1 : +val fold_list : ('a generic_argument -> 'c -> 'c) -> 'a generic_argument -> 'c -> 'c val fold_opt : @@ -178,10 +175,7 @@ val fold_pair : (** [app_list0] fails if applied to an argument not of tag [List0 t] for some [t]; it's the responsability of the caller to ensure it *) -val app_list0 : ('a generic_argument -> 'b generic_argument) -> -'a generic_argument -> 'b generic_argument - -val app_list1 : ('a generic_argument -> 'b generic_argument) -> +val app_list : ('a generic_argument -> 'b generic_argument) -> 'a generic_argument -> 'b generic_argument val app_opt : ('a generic_argument -> 'b generic_argument) -> @@ -210,8 +204,7 @@ type argument_type = | ConstrWithBindingsArgType | BindingsArgType | RedExprArgType - | List0ArgType of argument_type - | List1ArgType of argument_type + | ListArgType of argument_type | OptArgType of argument_type | PairArgType of argument_type * argument_type | ExtraArgType of string @@ -250,8 +243,7 @@ end (** {6 Parameterized types} *) -val wit_list0 : ('a, 'b, 'c) genarg_type -> ('a list, 'b list, 'c list) genarg_type -val wit_list1 : ('a, 'b, 'c) genarg_type -> ('a list, 'b list, 'c list) genarg_type +val wit_list : ('a, 'b, 'c) genarg_type -> ('a list, 'b list, 'c list) genarg_type val wit_opt : ('a, 'b, 'c) genarg_type -> ('a option, 'b option, 'c option) genarg_type val wit_pair : ('a1, 'b1, 'c1) genarg_type -> ('a2, 'b2, 'c2) genarg_type -> ('a1 * 'a2, 'b1 * 'b2, 'c1 * 'c2) genarg_type |