[infer] Remove marker from procname dispatcher

Summary: This diff removes `'markers` and `'captured_types` from the procname dispatcher. They are for checking an integrity when a type is captured from template parameters then it is used to match in parameters. However, we have not used that feature, so which simply complicates the types in the dispatcher without any gain at the moment.

Reviewed By: jvillard

Differential Revision: D18706254

fbshipit-source-id: f493778d7
master
Sungkeun Cho 5 years ago committed by Facebook Github Bot
parent 3d181bd831
commit b15395ad60

@ -31,10 +31,6 @@ type qual_name = QualifiedCppName.t
type templated_name = qual_name * Typ.template_arg list type templated_name = qual_name * Typ.template_arg list
type 'marker mtyp = typ
type 'captured_types capt = unit -> 'captured_types
(* Typ helpers *) (* Typ helpers *)
let template_args_of_template_spec_info = function let template_args_of_template_spec_info = function
@ -65,89 +61,51 @@ let templated_name_of_java java =
(* Intermediate matcher types *) (* Intermediate matcher types *)
type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher = type ('context, 'f_in, 'f_out, 'value) name_matcher =
{ on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * 'captured_types capt) option { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> 'f_out option
; on_qual_name: 'context -> 'f_in -> qual_name -> ('f_out * 'captured_types capt) option ; on_qual_name: 'context -> 'f_in -> qual_name -> 'f_out option }
; get_markers: 'markers_in -> 'markers_out }
type ('f_in, 'f_out, 'list_constraint) template_arg =
type ( 'f_in {eat_template_arg: 'f_in * Typ.template_arg list -> ('f_out * Typ.template_arg list) option}
, 'f_out
, 'captured_types_in type ('context, 'f_in, 'f_out, 'list_constraint, 'value) templ_matcher =
, 'captured_types_out { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * Typ.template_arg list) option
, 'markers_in
, 'markers_out
, 'list_constraint )
template_arg =
{ eat_template_arg:
'f_in * 'captured_types_in capt * Typ.template_arg list
-> ('f_out * 'captured_types_out capt * Typ.template_arg list) option
; add_marker: 'markers_in -> 'markers_out }
type ( 'context
, 'f_in
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, 'list_constraint
, 'value )
templ_matcher =
{ on_objc_cpp:
'context
-> 'f_in
-> objc_cpp
-> ('f_out * 'captured_types capt * Typ.template_arg list) option
; on_templated_name: ; on_templated_name:
'context 'context -> 'f_in -> templated_name -> ('f_out * Typ.template_arg list) option }
-> 'f_in
-> templated_name
-> ('f_out * 'captured_types capt * Typ.template_arg list) option
; get_markers: 'markers_in -> 'markers_out }
type ('context, 'f_in, 'f_out, 'captured_types, 'emptyness) path_extra = type ('context, 'f_in, 'f_out, 'emptyness) path_extra =
| PathEmpty : ('context, 'f, 'f, unit, empty) path_extra | PathEmpty : ('context, 'f, 'f, empty) path_extra
| PathNonEmpty : | PathNonEmpty :
{on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * 'captured_types capt) option} {on_objc_cpp: 'context -> 'f_in -> objc_cpp -> 'f_out option}
-> ('context, 'f_in, 'f_out, 'captured_types, non_empty) path_extra -> ('context, 'f_in, 'f_out, non_empty) path_extra
type ( 'context type ('context, 'f_in, 'f_out, 'emptyness, 'value) path_matcher =
, 'f_in { on_templated_name: 'context -> 'f_in -> templated_name -> 'f_out option
, 'f_out ; path_extra: ('context, 'f_in, 'f_out, 'emptyness) path_extra }
, 'captured_types
, 'markers_in
, 'markers_out
, 'emptyness
, 'value )
path_matcher =
{ on_templated_name: 'context -> 'f_in -> templated_name -> ('f_out * 'captured_types capt) option
; path_extra: ('context, 'f_in, 'f_out, 'captured_types, 'emptyness) path_extra
; get_markers: 'markers_in -> 'markers_out }
type typ_matcher = typ -> bool type typ_matcher = typ -> bool
(* Combinators *) (* Combinators *)
let empty : ('context, 'f, 'f, unit, 'markers, 'markers, empty, 'value) path_matcher = let empty : ('context, 'f, 'f, empty, 'value) path_matcher =
let get_markers m = m in
let get_capture () = () in
let on_templated_name _context f (qual_name, template_args) = let on_templated_name _context f (qual_name, template_args) =
match (QualifiedCppName.extract_last qual_name, template_args) with match (QualifiedCppName.extract_last qual_name, template_args) with
| None, [] -> | None, [] ->
Some (f, get_capture) Some f
| None, _ -> | None, _ ->
assert false assert false
| Some _, _ -> | Some _, _ ->
None None
in in
{on_templated_name; path_extra= PathEmpty; get_markers} {on_templated_name; path_extra= PathEmpty}
let name_cons : let name_cons :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) path_matcher ('context, 'f_in, 'f_out, _, 'value) path_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher = -> ('context, 'f_in, 'f_out, 'value) name_matcher =
fun m name -> fun m name ->
let {on_templated_name; get_markers} = m in let {on_templated_name} = m in
let match_fuzzy_name = let match_fuzzy_name =
let fuzzy_name_regexp = name |> Str.quote |> Printf.sprintf "^%s\\(<.+>\\)?$" |> Str.regexp in let fuzzy_name_regexp = name |> Str.quote |> Printf.sprintf "^%s\\(<.+>\\)?$" |> Str.regexp in
fun s -> Str.string_match fuzzy_name_regexp s 0 fun s -> Str.string_match fuzzy_name_regexp s 0
@ -164,15 +122,15 @@ let name_cons :
on_templated_name context f (templated_name_of_class_name objc_cpp.class_name) on_templated_name context f (templated_name_of_class_name objc_cpp.class_name)
else None else None
in in
{on_objc_cpp; on_qual_name; get_markers} {on_objc_cpp; on_qual_name}
let name_cons_f : let name_cons_f :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) path_matcher ('context, 'f_in, 'f_out, _, 'value) path_matcher
-> ('context -> string -> bool) -> ('context -> string -> bool)
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher = -> ('context, 'f_in, 'f_out, 'value) name_matcher =
fun m f_name -> fun m f_name ->
let {on_templated_name; get_markers} = m in let {on_templated_name} = m in
let on_qual_name context f qual_name = let on_qual_name context f qual_name =
match QualifiedCppName.extract_last qual_name with match QualifiedCppName.extract_last qual_name with
| Some (last, rest) when f_name context last -> | Some (last, rest) when f_name context last ->
@ -185,30 +143,14 @@ let name_cons_f :
on_templated_name context f (templated_name_of_class_name objc_cpp.class_name) on_templated_name context f (templated_name_of_class_name objc_cpp.class_name)
else None else None
in in
{on_objc_cpp; on_qual_name; get_markers} {on_objc_cpp; on_qual_name}
let all_names_cons : let all_names_cons :
( 'context ('context, 'f_in, 'f_out, non_empty, 'value) path_matcher
, 'f_in -> ('context, 'f_in, 'f_out, non_empty, 'value) path_matcher =
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, non_empty
, 'value )
path_matcher
-> ( 'context
, 'f_in
, 'f_out
, 'captured_tpes
, 'markers_in
, 'markers_out
, non_empty
, 'value )
path_matcher =
fun m -> fun m ->
let {on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} = m in let {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}} = m in
let rec on_templated_name_rec context f templated_name = let rec on_templated_name_rec context f templated_name =
match on_templated_name context f templated_name with match on_templated_name context f templated_name with
| Some _ as some -> | Some _ as some ->
@ -229,103 +171,59 @@ let all_names_cons :
| None -> | None ->
on_templated_name context f (templated_name_of_class_name objc_cpp.class_name) on_templated_name context f (templated_name_of_class_name objc_cpp.class_name)
in in
{on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}}
let templ_begin : let templ_begin :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher
-> ( 'context -> ('context, 'f_in, 'f_out, accept_more, 'value) templ_matcher =
, 'f_in
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, accept_more
, 'value )
templ_matcher =
fun m -> fun m ->
let {on_objc_cpp; on_qual_name; get_markers} = m in let {on_objc_cpp; on_qual_name} = m in
let on_templated_name context f (qual_name, template_args) = let on_templated_name context f (qual_name, template_args) =
match on_qual_name context f qual_name with match on_qual_name context f qual_name with None -> None | Some f -> Some (f, template_args)
| None ->
None
| Some (f, captured_types) ->
Some (f, captured_types, template_args)
in in
let on_objc_cpp context f (objc_cpp : Typ.Procname.ObjC_Cpp.t) = let on_objc_cpp context f (objc_cpp : Typ.Procname.ObjC_Cpp.t) =
match on_objc_cpp context f objc_cpp with match on_objc_cpp context f objc_cpp with
| None -> | None ->
None None
| Some (f, captured_types) -> | Some f ->
let template_args = template_args_of_template_spec_info objc_cpp.template_args in let template_args = template_args_of_template_spec_info objc_cpp.template_args in
Some (f, captured_types, template_args) Some (f, template_args)
in in
{on_objc_cpp; on_templated_name; get_markers} {on_objc_cpp; on_templated_name}
let templ_cons : let templ_cons :
( 'context ('context, 'f_in, 'f_interm, accept_more, 'value) templ_matcher
, 'f_in -> ('f_interm, 'f_out, 'lc) template_arg
, 'f_interm -> ('context, 'f_in, 'f_out, 'lc, 'value) templ_matcher =
, 'captured_types_in
, 'markers_interm
, 'markers_out
, accept_more
, 'value )
templ_matcher
-> ( 'f_interm
, 'f_out
, 'captured_types_in
, 'captured_types_out
, 'markers_in
, 'markers_interm
, 'lc )
template_arg
-> ( 'context
, 'f_in
, 'f_out
, 'captured_types_out
, 'markers_in
, 'markers_out
, 'lc
, 'value )
templ_matcher =
fun m template_arg -> fun m template_arg ->
let {on_objc_cpp; on_templated_name; get_markers} = m in let {on_objc_cpp; on_templated_name} = m in
let {eat_template_arg; add_marker} = template_arg in let {eat_template_arg} = template_arg in
let get_markers m = get_markers (add_marker m) in
let on_templated_name context f templated_name = let on_templated_name context f templated_name =
on_templated_name context f templated_name |> Option.bind ~f:eat_template_arg on_templated_name context f templated_name |> Option.bind ~f:eat_template_arg
in in
let on_objc_cpp context f objc_cpp = let on_objc_cpp context f objc_cpp =
on_objc_cpp context f objc_cpp |> Option.bind ~f:eat_template_arg on_objc_cpp context f objc_cpp |> Option.bind ~f:eat_template_arg
in in
{on_objc_cpp; on_templated_name; get_markers} {on_objc_cpp; on_templated_name}
let templ_end : let templ_end :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) templ_matcher ('context, 'f_in, 'f_out, _, 'value) templ_matcher
-> ( 'context -> ('context, 'f_in, 'f_out, non_empty, 'value) path_matcher =
, 'f_in let match_empty_templ_args (f, template_args) =
, 'f_out match template_args with [] -> Some f | _ -> None
, 'captured_types
, 'markers_in
, 'markers_out
, non_empty
, 'value )
path_matcher =
let match_empty_templ_args (f, captured_types, template_args) =
match template_args with [] -> Some (f, captured_types) | _ -> None
in in
fun m -> fun m ->
let {on_objc_cpp; on_templated_name; get_markers} = m in let {on_objc_cpp; on_templated_name} = m in
let on_templated_name context f templated_name = let on_templated_name context f templated_name =
on_templated_name context f templated_name |> Option.bind ~f:match_empty_templ_args on_templated_name context f templated_name |> Option.bind ~f:match_empty_templ_args
in in
let on_objc_cpp context f objc_cpp = let on_objc_cpp context f objc_cpp =
on_objc_cpp context f objc_cpp |> Option.bind ~f:match_empty_templ_args on_objc_cpp context f objc_cpp |> Option.bind ~f:match_empty_templ_args
in in
{on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}; get_markers} {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}}
module type Common = sig module type Common = sig
@ -337,227 +235,108 @@ module type Common = sig
(* Template arguments *) (* Template arguments *)
val any_typ : val any_typ : ('f, 'f, accept_more) template_arg
('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, accept_more) template_arg
(** Eats a type *) (** Eats a type *)
val capt_typ : val capt_typ : (Typ.t -> 'f, 'f, accept_more) template_arg
'marker (** Captures a type *)
-> ( 'marker mtyp -> 'f
, 'f val capt_int : (Int64.t -> 'f, 'f, accept_more) template_arg
, 'captured_types
, 'marker mtyp * 'captured_types
, 'markers
, 'marker * 'markers
, accept_more )
template_arg
(** Captures a type than can be back-referenced *)
val capt_int :
( Int64.t -> 'f
, 'f
, 'captured_types
, 'captured_types
, 'markers
, 'markers
, accept_more )
template_arg
(** Captures an int *) (** Captures an int *)
val capt_all : val capt_all : (Typ.template_arg list -> 'f, 'f, end_of_list) template_arg
( Typ.template_arg list -> 'f
, 'f
, 'captured_types
, 'captured_types
, 'markers
, 'markers
, end_of_list )
template_arg
(** Captures all template args *) (** Captures all template args *)
val ( ~- ) : string -> ('context, 'f, 'f, unit, 'markers, 'markers, 'value) name_matcher val ( ~- ) : string -> ('context, 'f, 'f, 'value) name_matcher
(** Starts a path with a name *) (** Starts a path with a name *)
val ( ~+ ) : val ( ~+ ) : ('context -> string -> bool) -> ('context, 'f, 'f, 'value) name_matcher
('context -> string -> bool)
-> ('context, 'f, 'f, unit, 'markers, 'markers, 'value) name_matcher
(** Starts a path with a matching name that satisfies the given function *) (** Starts a path with a matching name that satisfies the given function *)
val ( &+ ) : val ( &+ ) :
( 'context ('context, 'f_in, 'f_interm, accept_more, 'value) templ_matcher
, 'f_in -> ('f_interm, 'f_out, 'lc) template_arg
, 'f_interm -> ('context, 'f_in, 'f_out, 'lc, 'value) templ_matcher
, 'captured_types_in
, 'markers_interm
, 'markers_out
, accept_more
, 'value )
templ_matcher
-> ( 'f_interm
, 'f_out
, 'captured_types_in
, 'captured_types_out
, 'markers_in
, 'markers_interm
, 'lc )
template_arg
-> ( 'context
, 'f_in
, 'f_out
, 'captured_types_out
, 'markers_in
, 'markers_out
, 'lc
, 'value )
templ_matcher
(** Separate template arguments *) (** Separate template arguments *)
val ( < ) : val ( < ) :
( 'context ('context, 'f_in, 'f_interm, 'value) name_matcher
, 'f_in -> ('f_interm, 'f_out, 'lc) template_arg
, 'f_interm -> ('context, 'f_in, 'f_out, 'lc, 'value) templ_matcher
, 'captured_types_in
, 'markers_interm
, 'markers_out
, 'value )
name_matcher
-> ( 'f_interm
, 'f_out
, 'captured_types_in
, 'captured_types_out
, 'markers_in
, 'markers_interm
, 'lc )
template_arg
-> ( 'context
, 'f_in
, 'f_out
, 'captured_types_out
, 'markers_in
, 'markers_out
, 'lc
, 'value )
templ_matcher
(** Starts template arguments after a name *) (** Starts template arguments after a name *)
val ( >:: ) : val ( >:: ) :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) templ_matcher ('context, 'f_in, 'f_out, _, 'value) templ_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Ends template arguments and starts a name *) (** Ends template arguments and starts a name *)
val ( >::+ ) : val ( >::+ ) :
('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) templ_matcher ('context, 'f_in, 'f_out, 'lc, 'value) templ_matcher
-> ('a -> string -> bool) -> ('context -> string -> bool)
-> ('a, 'b, 'c, 'd, 'e, 'f, 'h) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
val ( &+...>:: ) : val ( &+...>:: ) :
( 'context ('context, 'f_in, 'f_out, accept_more, 'value) templ_matcher
, 'f_in
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, accept_more
, 'value )
templ_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Ends template arguments with eats-ALL and starts a name *) (** Ends template arguments with eats-ALL and starts a name *)
val ( &:: ) : val ( &:: ) :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Separates names (accepts ALL template arguments on the left one) *) (** Separates names (accepts ALL template arguments on the left one) *)
val ( &::+ ) : val ( &::+ ) :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher
-> ('context -> string -> bool) -> ('context -> string -> bool)
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
val ( <>:: ) : val ( <>:: ) :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Separates names (accepts NO template arguments on the left one) *) (** Separates names (accepts NO template arguments on the left one) *)
end end
module Common = struct module Common = struct
(* Template arguments *) (* Template arguments *)
let add_no_marker capture_markers = capture_markers
(** Eats all template args *) (** Eats all template args *)
let any_template_args : let any_template_args : ('f, 'f, end_of_list) template_arg =
('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, end_of_list) template_arg = let eat_template_arg (f, _) = Some (f, []) in
let eat_template_arg (f, captured_types, _) = Some (f, captured_types, []) in {eat_template_arg}
{eat_template_arg; add_marker= add_no_marker}
(** Eats a type *) (** Eats a type *)
let any_typ : let any_typ : ('f, 'f, accept_more) template_arg =
('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, accept_more) template_arg = let eat_template_arg (f, template_args) =
let eat_template_arg (f, captured_types, template_args) = match template_args with Typ.TType _ :: rest -> Some (f, rest) | _ -> None
match template_args with Typ.TType _ :: rest -> Some (f, captured_types, rest) | _ -> None
in in
{eat_template_arg; add_marker= add_no_marker} {eat_template_arg}
(** Captures a type than can be back-referenced *) (** Captures a type *)
let capt_typ : let capt_typ : (Typ.t -> 'f, 'f, accept_more) template_arg =
'marker let eat_template_arg (f, template_args) =
-> ( 'marker mtyp -> 'f match template_args with Typ.TType ty :: rest -> Some (f ty, rest) | _ -> None
, 'f
, 'captured_types
, 'marker mtyp * 'captured_types
, 'markers
, 'marker * 'markers
, accept_more )
template_arg =
fun marker ->
let eat_template_arg (f, captured_types, template_args) =
match template_args with
| Typ.TType ty :: rest ->
let captured_types () = (ty, captured_types ()) in
Some (f ty, captured_types, rest)
| _ ->
None
in in
let add_marker capture_markers = (marker, capture_markers) in {eat_template_arg}
{eat_template_arg; add_marker}
(** Captures an int *) (** Captures an int *)
let capt_int : let capt_int : (Int64.t -> 'f, 'f, accept_more) template_arg =
( Int64.t -> 'f let eat_template_arg (f, template_args) =
, 'f match template_args with Typ.TInt i :: rest -> Some (f i, rest) | _ -> None
, 'captured_types
, 'captured_types
, 'markers
, 'markers
, accept_more )
template_arg =
let eat_template_arg (f, captured_types, template_args) =
match template_args with Typ.TInt i :: rest -> Some (f i, captured_types, rest) | _ -> None
in in
{eat_template_arg; add_marker= add_no_marker} {eat_template_arg}
(** Captures all template args *) (** Captures all template args *)
let capt_all : let capt_all : (Typ.template_arg list -> 'f, 'f, end_of_list) template_arg =
( Typ.template_arg list -> 'f let eat_template_arg (f, template_args) = Some (f template_args, []) in
, 'f {eat_template_arg}
, 'captured_types
, 'captured_types
, 'markers
, 'markers
, end_of_list )
template_arg =
let eat_template_arg (f, captured_types, template_args) =
Some (f template_args, captured_types, [])
in
{eat_template_arg; add_marker= add_no_marker}
let ( <! ) name_matcher () = templ_begin name_matcher let ( <! ) name_matcher () = templ_begin name_matcher
@ -616,40 +395,33 @@ module Call = struct
Logging.(die InternalError) "Expected Lvar, got %a:%a" Exp.pp e (Typ.pp Pp.text) typ Logging.(die InternalError) "Expected Lvar, got %a:%a" Exp.pp e (Typ.pp Pp.text) typ
end end
type ('context, 'f_in, 'f_out, 'captured_types) proc_matcher = type ('context, 'f_in, 'f_out) proc_matcher =
{ on_objc_cpp: 'context -> 'f_in -> objc_cpp -> ('f_out * 'captured_types) option { on_objc_cpp: 'context -> 'f_in -> objc_cpp -> 'f_out option
; on_c: 'context -> 'f_in -> c -> ('f_out * 'captured_types) option ; on_c: 'context -> 'f_in -> c -> 'f_out option
; on_java: 'context -> 'f_in -> java -> ('f_out * 'captured_types) option } ; on_java: 'context -> 'f_in -> java -> 'f_out option }
type ('context, 'f_in, 'f_out, 'captured_types, 'value) on_args = type ('context, 'f_in, 'f_out, 'value) on_args =
'context 'context -> 'f_in * 'value FuncArg.t list -> ('f_out * 'value FuncArg.t list) option
-> 'captured_types
-> 'f_in * 'value FuncArg.t list
-> ('f_out * 'value FuncArg.t list) option
type ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher = type ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher =
{ on_proc: ('context, 'f_in, 'f_proc_out, 'captured_types) proc_matcher { on_proc: ('context, 'f_in, 'f_proc_out) proc_matcher
; on_args: ('context, 'f_proc_out, 'f_out, 'captured_types, 'value) on_args ; on_args: ('context, 'f_proc_out, 'f_out, 'value) on_args }
; markers: 'markers }
type ('context, 'captured_types, 'markers, 'value) one_arg_matcher = type ('context, 'value) one_arg_matcher = {match_arg: 'context -> 'value FuncArg.t -> bool}
{ match_arg: 'context -> 'captured_types -> 'value FuncArg.t -> bool
; marker_static_checker: 'markers -> bool }
type ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_capture = type ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_capture =
{get_captured_value: 'value FuncArg.t -> 'arg_in; do_capture: 'f_in -> 'arg_out -> 'f_out} {get_captured_value: 'value FuncArg.t -> 'arg_in; do_capture: 'f_in -> 'arg_out -> 'f_out}
type ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'captured_types, 'markers, 'value) one_arg = type ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'value) one_arg =
{ one_arg_matcher: ('context, 'captured_types, 'markers, 'value) one_arg_matcher { one_arg_matcher: ('context, 'value) one_arg_matcher
; capture: ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_capture } ; capture: ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_capture }
type ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_preparer = type ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_preparer =
{ on_empty: ('f_in -> 'arg_out -> 'f_out) -> 'f_in -> ('f_out * 'value FuncArg.t list) option { on_empty: ('f_in -> 'arg_out -> 'f_out) -> 'f_in -> ('f_out * 'value FuncArg.t list) option
; wrapper: 'arg_in -> 'arg_out } ; wrapper: 'arg_in -> 'arg_out }
type ('context, 'f_in, 'f_out, 'captured_types, 'markers, 'value) func_arg = type ('context, 'f_in, 'f_out, 'value) func_arg =
{ eat_func_arg: ('context, 'f_in, 'f_out, 'captured_types, 'value) on_args {eat_func_arg: ('context, 'f_in, 'f_out, 'value) on_args}
; marker_static_checker: 'markers -> bool }
type ('context, 'f, 'value) matcher = type ('context, 'f, 'value) matcher =
{ on_objc_cpp: 'context -> objc_cpp -> 'value FuncArg.t list -> 'f option { on_objc_cpp: 'context -> objc_cpp -> 'value FuncArg.t list -> 'f option
@ -665,11 +437,11 @@ module Call = struct
let pre_map_opt opt ~f = match opt with None -> DoesNotMatch | Some x -> Matches (f x) let pre_map_opt opt ~f = match opt with None -> DoesNotMatch | Some x -> Matches (f x)
type ('context, 'f_in, 'f_out, 'captured_types, 'value) func_args_end = type ('context, 'f_in, 'f_out, 'value) func_args_end =
on_args:('context, 'f_in, 'f_out, 'captured_types, 'value) on_args on_args:('context, 'f_in, 'f_out, 'value) on_args
-> 'context -> 'context
-> 'value FuncArg.t list -> 'value FuncArg.t list
-> 'f_in * 'captured_types -> 'f_in
-> ('context, 'f_out, 'value) pre_result -> ('context, 'f_out, 'value) pre_result
type ('context, 'f_in, 'f_out, 'value) all_args_matcher = type ('context, 'f_in, 'f_out, 'value) all_args_matcher =
@ -688,44 +460,37 @@ module Call = struct
'context -> Typ.Procname.t -> 'value FuncArg.t list -> 'f option 'context -> Typ.Procname.t -> 'value FuncArg.t list -> 'f option
let args_begin : let args_begin :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, non_empty, 'value) path_matcher ('context, 'f_in, 'f_out, non_empty, 'value) path_matcher
-> ('context, 'f_in, 'f_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher = -> ('context, 'f_in, 'f_out, 'f_out, 'value) args_matcher =
let on_args _context _capt f_args = Some f_args in let on_args _context f_args = Some f_args in
fun m -> fun m ->
let {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}; get_markers} = m in let {on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}} = m in
let markers = get_markers () in
let get_captures (f, captured_types) = (f, captured_types ()) in
let on_c context f (c : c) = let on_c context f (c : c) =
let template_args = template_args_of_template_spec_info c.template_args in let template_args = template_args_of_template_spec_info c.template_args in
on_templated_name context f (c.name, template_args) |> Option.map ~f:get_captures on_templated_name context f (c.name, template_args)
in in
let on_java context f (java : java) = let on_java context f (java : java) =
on_templated_name context f (templated_name_of_java java) |> Option.map ~f:get_captures on_templated_name context f (templated_name_of_java java)
in
let on_objc_cpp context f objc_cpp =
on_objc_cpp context f objc_cpp |> Option.map ~f:get_captures
in in
let on_proc : (_, _, _, _) proc_matcher = {on_objc_cpp; on_c; on_java} in let on_objc_cpp context f objc_cpp = on_objc_cpp context f objc_cpp in
{on_proc; on_args; markers} let on_proc : _ proc_matcher = {on_objc_cpp; on_c; on_java} in
{on_proc; on_args}
let args_cons : let args_cons :
('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers, 'value) args_matcher ('context, 'f_in, 'f_proc_out, 'f_interm, 'value) args_matcher
-> ('context, 'f_interm, 'f_out, 'captured_types, 'markers, 'value) func_arg -> ('context, 'f_interm, 'f_out, 'value) func_arg
-> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher = -> ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher =
fun m func_arg -> fun m func_arg ->
let {on_proc; on_args; markers} = m in let {on_proc; on_args} = m in
let {marker_static_checker; eat_func_arg} = func_arg in let {eat_func_arg} = func_arg in
assert (marker_static_checker markers) ; let on_args context f_args = on_args context f_args |> Option.bind ~f:(eat_func_arg context) in
let on_args context capt f_args = {on_proc; on_args}
on_args context capt f_args |> Option.bind ~f:(eat_func_arg context capt)
in
{on_proc; on_args; markers}
let args_end : let args_end :
('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher
-> ('context, 'f_proc_out, 'f_out, 'captured_types, 'value) func_args_end -> ('context, 'f_proc_out, 'f_out, 'value) func_args_end
-> ('context, 'f_in, 'f_out, 'value) all_args_matcher = -> ('context, 'f_in, 'f_out, 'value) all_args_matcher =
fun m func_args_end -> fun m func_args_end ->
let {on_proc= {on_c; on_java; on_objc_cpp}; on_args} = m in let {on_proc= {on_c; on_java; on_objc_cpp}; on_args} = m in
@ -816,52 +581,17 @@ module Call = struct
(* Function args *) (* Function args *)
let no_marker_checker _markers = true
(** Matches any arg *) (** Matches any arg *)
let match_any_arg : (_, _, _, _) one_arg_matcher = let match_any_arg : _ one_arg_matcher =
let match_arg _context _capt _arg = true in let match_arg _context _arg = true in
{match_arg; marker_static_checker= no_marker_checker} {match_arg}
let mk_match_typ_nth :
('markers -> 'marker)
-> ('captured_types -> 'marker mtyp)
-> 'marker
-> ('context, 'captured_types, 'markers, 'value) one_arg_matcher =
fun get_m get_c marker ->
let marker_static_checker markers = Poly.equal marker (get_m markers) in
let match_arg _context capt arg = Typ.equal (FuncArg.typ arg) (get_c capt) in
{match_arg; marker_static_checker}
(** Matches first captured type *)
let match_typ1 : 'marker -> ('context, 'marker mtyp * _, 'marker * _, _) one_arg_matcher =
let pos1 (x, _) = x in
fun marker -> mk_match_typ_nth pos1 pos1 marker
(** Matches second captured type *)
let match_typ2 :
'marker -> ('context, _ * ('marker mtyp * _), _ * ('marker * _), _) one_arg_matcher =
let pos2 (_, (x, _)) = x in
fun marker -> mk_match_typ_nth pos2 pos2 marker
(** Matches third captured type *)
let match_typ3 :
'marker
-> ('context, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _)), 'value) one_arg_matcher =
let pos3 (_, (_, (x, _))) = x in
fun marker -> mk_match_typ_nth pos3 pos3 marker
(** Matches the type matched by the given path_matcher *) (** Matches the type matched by the given path_matcher *)
let match_typ : let match_typ :
('context, _, _, unit, unit, unit, non_empty, 'value) path_matcher ('context, _, _, non_empty, 'value) path_matcher -> ('context, 'value) one_arg_matcher =
-> ('context, _, _, _) one_arg_matcher =
fun m -> fun m ->
let ({on_templated_name} : (_, _, _, unit, unit, unit, non_empty, 'value) path_matcher) = m in let ({on_templated_name} : (_, _, _, non_empty, 'value) path_matcher) = m in
let rec match_typ context typ = let rec match_typ context typ =
match typ with match typ with
| {Typ.desc= Tstruct name} -> | {Typ.desc= Tstruct name} ->
@ -871,15 +601,15 @@ module Call = struct
| _ -> | _ ->
false false
in in
let match_arg context _capt arg = match_typ context (FuncArg.typ arg) in let match_arg context arg = match_typ context (FuncArg.typ arg) in
{match_arg; marker_static_checker= no_marker_checker} {match_arg}
(** Matches the type matched by the given typ_matcher *) (** Matches the type matched by the given typ_matcher *)
let match_prim_typ : typ_matcher -> _ one_arg_matcher = let match_prim_typ : typ_matcher -> _ one_arg_matcher =
fun on_typ -> fun on_typ ->
let match_arg _context _capt arg = on_typ (FuncArg.typ arg) in let match_arg _context arg = on_typ (FuncArg.typ arg) in
{match_arg; marker_static_checker= no_marker_checker} {match_arg}
(* Function argument capture *) (* Function argument capture *)
@ -933,43 +663,43 @@ module Call = struct
let make_arg : let make_arg :
('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_preparer ('arg_in, 'arg_out, 'f_in, 'f_out, 'value) arg_preparer
-> ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, _, _, 'value) one_arg -> ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'value) one_arg
-> ('context, 'f_in, 'f_out, _, _, 'value) func_arg = -> ('context, 'f_in, 'f_out, 'value) func_arg =
fun arg_preparer one_arg -> fun arg_preparer one_arg ->
let {on_empty; wrapper} = arg_preparer in let {on_empty; wrapper} = arg_preparer in
let {one_arg_matcher; capture} = one_arg in let {one_arg_matcher; capture} = one_arg in
let {match_arg; marker_static_checker} = one_arg_matcher in let {match_arg} = one_arg_matcher in
let {get_captured_value; do_capture} = capture in let {get_captured_value; do_capture} = capture in
let eat_func_arg context capt (f, args) = let eat_func_arg context (f, args) =
match args with match args with
| [] -> | [] ->
on_empty do_capture f on_empty do_capture f
| arg :: rest when match_arg context capt arg -> | arg :: rest when match_arg context arg ->
Some (arg |> get_captured_value |> wrapper |> do_capture f, rest) Some (arg |> get_captured_value |> wrapper |> do_capture f, rest)
| _ -> | _ ->
None None
in in
{eat_func_arg; marker_static_checker} {eat_func_arg}
let any_arg : ('context, unit, _, 'f, 'f, _, _, _) one_arg = let any_arg : ('context, unit, _, 'f, 'f, 'value) one_arg =
{one_arg_matcher= match_any_arg; capture= no_capture} {one_arg_matcher= match_any_arg; capture= no_capture}
let capt_arg : let capt_arg : ('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg
('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg = =
{one_arg_matcher= match_any_arg; capture= capture_arg} {one_arg_matcher= match_any_arg; capture= capture_arg}
let capt_value : ('context, 'value, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg = let capt_value : ('context, 'value, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg =
{one_arg_matcher= match_any_arg; capture= capture_arg_val} {one_arg_matcher= match_any_arg; capture= capture_arg_val}
let capt_exp : ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg = let capt_exp : ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg =
{one_arg_matcher= match_any_arg; capture= capture_arg_exp} {one_arg_matcher= match_any_arg; capture= capture_arg_exp}
let capt_var_exn : ('context, Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg = let capt_var_exn : ('context, Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg =
{one_arg_matcher= match_any_arg; capture= capture_arg_var_exn} {one_arg_matcher= match_any_arg; capture= capture_arg_var_exn}
@ -992,36 +722,24 @@ module Call = struct
{one_arg_matcher= one_arg_matcher_of_prim_typ typ; capture= capture_arg_exp} {one_arg_matcher= one_arg_matcher_of_prim_typ typ; capture= capture_arg_exp}
let typ1 : 'marker -> ('context, unit, _, 'f, 'f, _, _, _) one_arg =
fun m -> {one_arg_matcher= match_typ1 m; capture= no_capture}
let typ2 : 'marker -> ('context, unit, _, 'f, 'f, _, _, _) one_arg =
fun m -> {one_arg_matcher= match_typ2 m; capture= no_capture}
let typ3 : 'marker -> ('context, unit, _, 'f, 'f, _, _, _) one_arg =
fun m -> {one_arg_matcher= match_typ3 m; capture= no_capture}
(* Function args end *) (* Function args end *)
(** Matches if there is no function arguments left *) (** Matches if there is no function arguments left *)
let no_args_left : ('context, _, _, _, _) func_args_end = let no_args_left : ('context, _, _, 'value) func_args_end =
let match_empty_args = function Some (f, []) -> Matches f | _ -> DoesNotMatch in let match_empty_args = function Some (f, []) -> Matches f | _ -> DoesNotMatch in
fun ~on_args context args (f, capt) -> on_args context capt (f, args) |> match_empty_args fun ~on_args context args f -> on_args context (f, args) |> match_empty_args
(** Matches any function arguments *) (** Matches any function arguments *)
let any_func_args : ('context, _, _, _, _) func_args_end = let any_func_args : ('context, _, _, 'value) func_args_end =
fun ~on_args context args (f, capt) -> on_args context capt (f, args) |> pre_map_opt ~f:fst fun ~on_args context args f -> on_args context (f, args) |> pre_map_opt ~f:fst
(** If [func_args_end1] does not match, use [func_args_end2] *) (** If [func_args_end1] does not match, use [func_args_end2] *)
let alternative_args_end : let alternative_args_end :
('context, 'f_in, 'f_out, 'captured_types, 'value) func_args_end ('context, 'f_in, 'f_out, 'value) func_args_end
-> ('context, 'f_in, 'f_out, 'captured_types, 'value) func_args_end -> ('context, 'f_in, 'f_out, 'value) func_args_end
-> ('context, 'f_in, 'f_out, 'captured_types, 'value) func_args_end = -> ('context, 'f_in, 'f_out, 'value) func_args_end =
fun func_args_end1 func_args_end2 ~on_args context args f_capt -> fun func_args_end1 func_args_end2 ~on_args context args f_capt ->
match func_args_end1 ~on_args context args f_capt with match func_args_end1 ~on_args context args f_capt with
| DoesNotMatch -> | DoesNotMatch ->
@ -1031,14 +749,14 @@ module Call = struct
(** Retries matching with another matcher *) (** Retries matching with another matcher *)
let args_end_retry : _ matcher -> ('context, _, _, _, _) func_args_end = let args_end_retry : _ matcher -> ('context, _, _, 'value) func_args_end =
fun m ~on_args:_ _context _args _f_capt -> RetryWith m fun m ~on_args:_ _context _args _f_capt -> RetryWith m
(** Retries matching with another matcher if the function does not have the (** Retries matching with another matcher if the function does not have the
exact number/types of args *) exact number/types of args *)
let exact_args_or_retry : let exact_args_or_retry : ('context, 'f, 'value) matcher -> ('context, _, _, 'value) func_args_end
('context, 'f, 'value) matcher -> ('context, _, _, _, 'value) func_args_end = =
fun m -> alternative_args_end no_args_left (args_end_retry m) fun m -> alternative_args_end no_args_left (args_end_retry m)
@ -1103,24 +821,18 @@ module type NameCommon = sig
include Common include Common
val ( >--> ) : val ( >--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _, 'value) templ_matcher ('context, 'f_in, 'f_out, _, 'value) templ_matcher
-> 'f_in -> 'f_in
-> ('context, 'f_out, 'value) matcher -> ('context, 'f_out, 'value) matcher
val ( <>--> ) : val ( <>--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
val ( &--> ) : val ( &--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
val ( &::.*--> ) : val ( &::.*--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates),
accepts ALL function arguments, binds the function *) accepts ALL function arguments, binds the function *)
end end
@ -1133,18 +845,16 @@ module NameCommon = struct
; on_objc_cpp: 'context -> objc_cpp -> 'f option } ; on_objc_cpp: 'context -> objc_cpp -> 'f option }
let make_matcher : let make_matcher :
('context, 'f_in, 'f_out, _, _, _, non_empty, 'value) path_matcher ('context, 'f_in, 'f_out, non_empty, 'value) path_matcher
-> 'f_in -> 'f_in
-> ('context, 'f_out, 'value) matcher = -> ('context, 'f_out, 'value) matcher =
fun m f -> fun m f ->
let ({on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}} let ({on_templated_name; path_extra= PathNonEmpty {on_objc_cpp}}
: ('context, 'f_in, 'f_out, _, _, _, non_empty, 'value) path_matcher) = : ('context, 'f_in, 'f_out, non_empty, 'value) path_matcher) =
m m
in in
let on_templated_name context templated_name = let on_templated_name context templated_name = templated_name |> on_templated_name context f in
templated_name |> on_templated_name context f |> Option.map ~f:fst let on_objc_cpp context objc_cpp = objc_cpp |> on_objc_cpp context f in
in
let on_objc_cpp context objc_cpp = objc_cpp |> on_objc_cpp context f |> Option.map ~f:fst in
{on_templated_name; on_objc_cpp} {on_templated_name; on_objc_cpp}

@ -12,40 +12,13 @@ type accept_more
and end_of_list and end_of_list
(* Markers are a fool-proofing mechanism to avoid mistaking captured types. (* Intermediate matcher types *)
Template argument types can be captured with [capt_typ] to be referenced later
by their position [typ1], [typ2], [typ3], ...
To avoid mixing them, give a different name to each captured type, using whatever
type/value you want and reuse it when referencing the captured type, e.g.
[capt_typ `T &+ capt_typ `A], then use [typ1 `T], [typ2 `A].
If you get them wrong, you will get a typing error at compile-time or an
assertion failure at matcher-building time.
*)
type 'marker mtyp = Typ.t type ('context, 'f_in, 'f_out, 'value) name_matcher
(* Intermediate matcher types *) type ('f_in, 'f_out_in_out, 'list_constraint) template_arg
type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher type ('context, 'f_in, 'f_out, 'list_constraint, 'value) templ_matcher
type ( 'f_in
, 'f_out
, 'captured_types_in
, 'captured_types_out
, 'markers_in
, 'markers_out
, 'list_constraint )
template_arg
type ( 'context
, 'f_in
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, 'list_constraint
, 'value )
templ_matcher
(* A matcher is a rule associating a function [f] to a [C/C++ function/method]: (* A matcher is a rule associating a function [f] to a [C/C++ function/method]:
- [C/C++ function/method] --> [f] - [C/C++ function/method] --> [f]
@ -72,151 +45,70 @@ module type Common = sig
(* Template arguments *) (* Template arguments *)
val any_typ : val any_typ : ('f, 'f, accept_more) template_arg
('f, 'f, 'captured_types, 'captured_types, 'markers, 'markers, accept_more) template_arg
(** Eats a type *) (** Eats a type *)
val capt_typ : val capt_typ : (Typ.t -> 'f, 'f, accept_more) template_arg
'marker (** Captures a type *)
-> ( 'marker mtyp -> 'f
, 'f val capt_int : (Int64.t -> 'f, 'f, accept_more) template_arg
, 'captured_types
, 'marker mtyp * 'captured_types
, 'markers
, 'marker * 'markers
, accept_more )
template_arg
(** Captures a type than can be back-referenced *)
val capt_int :
( Int64.t -> 'f
, 'f
, 'captured_types
, 'captured_types
, 'markers
, 'markers
, accept_more )
template_arg
(** Captures an int *) (** Captures an int *)
val capt_all : val capt_all : (Typ.template_arg list -> 'f, 'f, end_of_list) template_arg
( Typ.template_arg list -> 'f
, 'f
, 'captured_types
, 'captured_types
, 'markers
, 'markers
, end_of_list )
template_arg
(** Captures all template args *) (** Captures all template args *)
val ( ~- ) : string -> ('context, 'f, 'f, unit, 'markers, 'markers, 'value) name_matcher val ( ~- ) : string -> ('context, 'f, 'f, 'value) name_matcher
(** Starts a path with a name *) (** Starts a path with a name *)
val ( ~+ ) : val ( ~+ ) : ('context -> string -> bool) -> ('context, 'f, 'f, 'value) name_matcher
('context -> string -> bool)
-> ('context, 'f, 'f, unit, 'markers, 'markers, 'value) name_matcher
(** Starts a path with a matching name that satisfies the given function *) (** Starts a path with a matching name that satisfies the given function *)
val ( &+ ) : val ( &+ ) :
( 'context ('context, 'f_in, 'f_interm, accept_more, 'value) templ_matcher
, 'f_in -> ('f_interm, 'f_out, 'lc) template_arg
, 'f_interm -> ('context, 'f_in, 'f_out, 'lc, 'value) templ_matcher
, 'captured_types_in
, 'markers_interm
, 'markers_out
, accept_more
, 'value )
templ_matcher
-> ( 'f_interm
, 'f_out
, 'captured_types_in
, 'captured_types_out
, 'markers_in
, 'markers_interm
, 'lc )
template_arg
-> ( 'context
, 'f_in
, 'f_out
, 'captured_types_out
, 'markers_in
, 'markers_out
, 'lc
, 'value )
templ_matcher
(** Separate template arguments *) (** Separate template arguments *)
val ( < ) : val ( < ) :
( 'context ('context, 'f_in, 'f_interm, 'value) name_matcher
, 'f_in -> ('f_interm, 'f_out, 'lc) template_arg
, 'f_interm -> ('context, 'f_in, 'f_out, 'lc, 'value) templ_matcher
, 'captured_types_in
, 'markers_interm
, 'markers_out
, 'value )
name_matcher
-> ( 'f_interm
, 'f_out
, 'captured_types_in
, 'captured_types_out
, 'markers_in
, 'markers_interm
, 'lc )
template_arg
-> ( 'context
, 'f_in
, 'f_out
, 'captured_types_out
, 'markers_in
, 'markers_out
, 'lc
, 'value )
templ_matcher
(** Starts template arguments after a name *) (** Starts template arguments after a name *)
val ( >:: ) : val ( >:: ) :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _, 'value) templ_matcher ('context, 'f_in, 'f_out, _, 'value) templ_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Ends template arguments and starts a name *) (** Ends template arguments and starts a name *)
val ( >::+ ) : val ( >::+ ) :
('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) templ_matcher ('context, 'f_in, 'f_out, 'lc, 'value) templ_matcher
-> ('a -> string -> bool) -> ('context -> string -> bool)
-> ('a, 'b, 'c, 'd, 'e, 'f, 'h) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
val ( &+...>:: ) : val ( &+...>:: ) :
( 'context ('context, 'f_in, 'f_out, accept_more, 'value) templ_matcher
, 'f_in
, 'f_out
, 'captured_types
, 'markers_in
, 'markers_out
, accept_more
, 'value )
templ_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Ends template arguments with eats-ALL and starts a name *) (** Ends template arguments with eats-ALL and starts a name *)
val ( &:: ) : val ( &:: ) :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Separates names (accepts ALL template arguments on the left one) *) (** Separates names (accepts ALL template arguments on the left one) *)
val ( &::+ ) : val ( &::+ ) :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher
-> ('context -> string -> bool) -> ('context -> string -> bool)
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Separates names that satisfies the given function (accepts ALL (** Separates names that satisfies the given function (accepts ALL
template arguments on the left one) *) template arguments on the left one) *)
val ( <>:: ) : val ( <>:: ) :
('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher
-> string -> string
-> ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'value) name_matcher -> ('context, 'f_in, 'f_out, 'value) name_matcher
(** Separates names (accepts NO template arguments on the left one) *) (** Separates names (accepts NO template arguments on the left one) *)
end end
@ -224,24 +116,19 @@ module type NameCommon = sig
include Common include Common
val ( >--> ) : val ( >--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _, 'value) templ_matcher ('context, 'f_in, 'f_out, _, 'value) templ_matcher
-> 'f_in -> 'f_in
-> ('context, 'f_out, 'value) matcher -> ('context, 'f_out, 'value) matcher
val ( <>--> ) : val ( <>--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
val ( &--> ) : val ( &--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
val ( &::.*--> ) : val ( &::.*--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates),
accepts ALL function arguments, binds the function *) accepts ALL function arguments, binds the function *)
end end
@ -269,153 +156,124 @@ module Call : sig
-> ('context, 'f, 'value) dispatcher -> ('context, 'f, 'value) dispatcher
(** Merges two dispatchers into a dispatcher *) (** Merges two dispatchers into a dispatcher *)
type ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher type ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher
type ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'captured_types, 'markers, 'value) one_arg type ('context, 'arg_in, 'arg_out, 'f_in, 'f_out, 'value) one_arg
(* Function args *) (* Function args *)
val any_arg : ('context, unit, _, 'f, 'f, _, _, _) one_arg val any_arg : ('context, unit, _, 'f, 'f, 'value) one_arg
(** Eats one arg *) (** Eats one arg *)
val capt_arg : val capt_arg : ('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg
('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg
(** Captures one arg *) (** Captures one arg *)
val capt_value : ('context, 'value, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg val capt_value : ('context, 'value, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg
(** Captures the value of one arg at current state *) (** Captures the value of one arg at current state *)
val capt_exp : ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg val capt_exp : ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg
(** Captures one arg expression *) (** Captures one arg expression *)
val any_arg_of_typ : val any_arg_of_typ :
('context, unit, _, unit, unit, unit, 'value) name_matcher ('context, unit, _, 'value) name_matcher -> ('context, unit, _, 'f, 'f, 'value) one_arg
-> ('context, unit, _, 'f, 'f, _, _, 'value) one_arg
(** Eats one arg of the given type *) (** Eats one arg of the given type *)
val capt_arg_of_typ : val capt_arg_of_typ :
('context, unit, _, unit, unit, unit, 'value) name_matcher ('context, unit, _, 'value) name_matcher
-> ('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, 'value) one_arg -> ('context, 'value FuncArg.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg
(** Captures one arg of the given type *) (** Captures one arg of the given type *)
val capt_exp_of_typ : val capt_exp_of_typ :
('context, unit, _, unit, unit, unit, 'value) name_matcher ('context, unit, _, 'value) name_matcher
-> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg -> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg
(** Captures one arg expression of the given type *) (** Captures one arg expression of the given type *)
val any_arg_of_prim_typ : Typ.t -> ('context, unit, _, 'f, 'f, _, _, _) one_arg val any_arg_of_prim_typ : Typ.t -> ('context, unit, _, 'f, 'f, 'value) one_arg
(** Eats one arg of the given primitive type *) (** Eats one arg of the given primitive type *)
val capt_exp_of_prim_typ : val capt_exp_of_prim_typ :
Typ.t -> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg Typ.t -> ('context, Exp.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg
(** Captures one arg expression of the given primitive type *) (** Captures one arg expression of the given primitive type *)
val capt_var_exn : ('context, Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, _, _, _) one_arg val capt_var_exn : ('context, Ident.t, 'wrapped_arg, 'wrapped_arg -> 'f, 'f, 'value) one_arg
(** Captures one arg Var. Fails with an internal error if the expression is not a Var *) (** Captures one arg Var. Fails with an internal error if the expression is not a Var *)
val typ1 : 'marker -> ('context, unit, _, 'f, 'f, 'marker mtyp * _, 'marker * _, _) one_arg
(** Matches first captured type *)
val typ2 :
'marker -> ('context, unit, _, 'f, 'f, _ * ('marker mtyp * _), _ * ('marker * _), _) one_arg
(** Matches second captured type *)
val typ3 :
'marker
-> ('context, unit, _, 'f, 'f, _ * (_ * ('marker mtyp * _)), _ * (_ * ('marker * _)), _) one_arg
(** Matches third captured type *)
val ( $+ ) : val ( $+ ) :
('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers, 'value) args_matcher ('context, 'f_in, 'f_proc_out, 'f_interm, 'value) args_matcher
-> ('context, 'arg, 'arg, 'f_interm, 'f_out, 'captured_types, 'markers, 'value) one_arg -> ('context, 'arg, 'arg, 'f_interm, 'f_out, 'value) one_arg
-> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher
(** Separate function arguments *) (** Separate function arguments *)
val ( $+? ) : val ( $+? ) :
('context, 'f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers, 'value) args_matcher ('context, 'f_in, 'f_proc_out, 'f_interm, 'value) args_matcher
-> ('context, 'arg, 'arg option, 'f_interm, 'f_out, 'captured_types, 'markers, 'value) one_arg -> ('context, 'arg, 'arg option, 'f_interm, 'f_out, 'value) one_arg
-> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher
(** Add an optional argument *) (** Add an optional argument *)
val ( >$ ) : val ( >$ ) :
('context, 'f_in, 'f_proc_out, 'ct, unit, 'cm, _, 'value) templ_matcher ('context, 'f_in, 'f_proc_out, 'ct, 'value) templ_matcher
-> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'ct, 'cm, 'value) one_arg -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'value) one_arg
-> ('context, 'f_in, 'f_proc_out, 'f_out, 'ct, 'cm, 'value) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher
(** Ends template arguments and starts function arguments *) (** Ends template arguments and starts function arguments *)
val ( $--> ) : val ( $--> ) :
('context, 'f_in, _, 'f_out, 'captured_types, 'markers, 'value) args_matcher ('context, 'f_in, _, 'f_out, 'value) args_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** Ends function arguments, binds the function *) (** Ends function arguments, binds the function *)
val ( $ ) : val ( $ ) :
('context, 'f_in, 'f_proc_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_proc_out, 'value) name_matcher
-> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) one_arg -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'value) one_arg
-> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher
(** Ends a name with accept-ALL template arguments and starts function arguments *) (** Ends a name with accept-ALL template arguments and starts function arguments *)
val ( <>$ ) : val ( <>$ ) :
('context, 'f_in, 'f_proc_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_proc_out, 'value) name_matcher
-> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) one_arg -> ('context, 'arg, 'arg, 'f_proc_out, 'f_out, 'value) one_arg
-> ('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher -> ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher
(** Ends a name with accept-NO template arguments and starts function arguments *) (** Ends a name with accept-NO template arguments and starts function arguments *)
val ( >--> ) : val ( >--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _, 'value) templ_matcher ('context, 'f_in, 'f_out, _, 'value) templ_matcher
-> 'f_in -> 'f_in
-> ('context, 'f_out, 'value) matcher -> ('context, 'f_out, 'value) matcher
(** Ends template arguments, accepts ALL function arguments, binds the function *) (** Ends template arguments, accepts ALL function arguments, binds the function *)
val ( $+...$--> ) : val ( $+...$--> ) :
('context, 'f_in, _, 'f_out, 'captured_types, 'markers, 'value) args_matcher ('context, 'f_in, _, 'f_out, 'value) args_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** Ends function arguments with eats-ALL and binds the function *) (** Ends function arguments with eats-ALL and binds the function *)
val ( >$$--> ) : val ( >$$--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, _, 'value) templ_matcher ('context, 'f_in, 'f_out, _, 'value) templ_matcher
-> 'f_in -> 'f_in
-> ('context, 'f_out, 'value) matcher -> ('context, 'f_out, 'value) matcher
(** Ends template arguments, accepts NO function arguments, binds the function *) (** Ends template arguments, accepts NO function arguments, binds the function *)
val ( $$--> ) : val ( $$--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** After a name, accepts ALL template arguments, accepts NO function arguments, binds the function *) (** After a name, accepts ALL template arguments, accepts NO function arguments, binds the function *)
val ( <>$$--> ) : val ( <>$$--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** After a name, accepts NO template arguments, accepts NO function arguments, binds the function *) (** After a name, accepts NO template arguments, accepts NO function arguments, binds the function *)
val ( &--> ) : val ( &--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** After a name, accepts ALL template arguments, accepts ALL function arguments, binds the function *) (** After a name, accepts ALL template arguments, accepts ALL function arguments, binds the function *)
val ( <>--> ) : val ( <>--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** After a name, accepts NO template arguments, accepts ALL function arguments, binds the function *) (** After a name, accepts NO template arguments, accepts ALL function arguments, binds the function *)
val ( &::.*--> ) : val ( &::.*--> ) :
('context, 'f_in, 'f_out, 'captured_types, unit, 'markers, 'value) name_matcher ('context, 'f_in, 'f_out, 'value) name_matcher -> 'f_in -> ('context, 'f_out, 'value) matcher
-> 'f_in
-> ('context, 'f_out, 'value) matcher
(** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates), (** After a name, accepts ALL template arguments, accepts ALL path tails (names, templates),
accepts ALL function arguments, binds the function *) accepts ALL function arguments, binds the function *)
val ( $!--> ) : val ( $!--> ) :
('context, 'f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers, 'value) args_matcher ('context, 'f_in, 'f_proc_out, 'f_out, 'value) args_matcher
-> 'f_in -> 'f_in
-> ('context, 'f_out, 'value) matcher -> ('context, 'f_out, 'value) matcher
(** Ends function arguments, accepts NO more function arguments. (** Ends function arguments, accepts NO more function arguments.
If the args do not match, raise an internal error. If the args do not match, raise an internal error. *)
*)
end end
[@@warning "-32"] [@@warning "-32"]

@ -1259,29 +1259,18 @@ module Call = struct
; std_array2 >:: "at" $ capt_arg $+ capt_arg $!--> StdArray.at ; std_array2 >:: "at" $ capt_arg $+ capt_arg $!--> StdArray.at
; std_array2 >:: "operator[]" $ capt_arg $+ capt_arg $!--> StdArray.at ; std_array2 >:: "operator[]" $ capt_arg $+ capt_arg $!--> StdArray.at
; -"std" &:: "array" &::.*--> no_model ; -"std" &:: "array" &::.*--> no_model
; -"std" &:: "basic_string" ; -"std" &:: "basic_string" < capt_typ &+...>:: "basic_string" $ capt_arg
< capt_typ `T
&+...>:: "basic_string" $ capt_arg
$+ capt_exp_of_typ (-"std" &:: "basic_string") $+ capt_exp_of_typ (-"std" &:: "basic_string")
$--> StdBasicString.copy_constructor $--> StdBasicString.copy_constructor
; -"std" &:: "basic_string" ; -"std" &:: "basic_string" < capt_typ &+...>:: "basic_string" $ capt_arg
< capt_typ `T $+ capt_exp_of_prim_typ char_ptr $--> StdBasicString.constructor_from_char_ptr_without_len
&+...>:: "basic_string" $ capt_arg $+ capt_exp_of_prim_typ char_ptr ; -"std" &:: "basic_string" < capt_typ &+...>:: "basic_string" $ capt_arg
$--> StdBasicString.constructor_from_char_ptr_without_len $+ capt_exp_of_prim_typ char_ptr
; -"std" &:: "basic_string"
< capt_typ `T
&+...>:: "basic_string" $ capt_arg $+ capt_exp_of_prim_typ char_ptr
$+ capt_exp_of_prim_typ (Typ.mk (Typ.Tint Typ.size_t)) $+ capt_exp_of_prim_typ (Typ.mk (Typ.Tint Typ.size_t))
$--> StdBasicString.constructor_from_char_ptr_with_len $--> StdBasicString.constructor_from_char_ptr_with_len
; -"std" &:: "basic_string" ; -"std" &:: "basic_string" < capt_typ &+...>:: "empty" $ capt_arg $--> StdBasicString.empty
< capt_typ `T ; -"std" &:: "basic_string" < capt_typ &+...>:: "length" $ capt_arg $--> StdBasicString.length
&+...>:: "empty" $ capt_arg $--> StdBasicString.empty ; -"std" &:: "basic_string" < capt_typ &+...>:: "size" $ capt_arg $--> StdBasicString.length
; -"std" &:: "basic_string"
< capt_typ `T
&+...>:: "length" $ capt_arg $--> StdBasicString.length
; -"std" &:: "basic_string"
< capt_typ `T
&+...>:: "size" $ capt_arg $--> StdBasicString.length
; -"std" &:: "basic_string" &:: "compare" &--> by_value Dom.Val.Itv.top ; -"std" &:: "basic_string" &:: "compare" &--> by_value Dom.Val.Itv.top
; +PatternMatch.implements_lang "String" ; +PatternMatch.implements_lang "String"
&:: "equals" &:: "equals"
@ -1314,35 +1303,26 @@ module Call = struct
$+ any_arg_of_typ (-"std" &:: "basic_string") $+ any_arg_of_typ (-"std" &:: "basic_string")
$--> by_value Dom.Val.Itv.unknown_bool $--> by_value Dom.Val.Itv.unknown_bool
; -"std" &:: "basic_string" &::.*--> no_model ; -"std" &:: "basic_string" &::.*--> no_model
; -"std" &:: "vector" ; -"std" &:: "vector" < capt_typ &+ any_typ >:: "vector"
< capt_typ `T
&+ any_typ >:: "vector"
$ capt_arg_of_typ (-"std" &:: "vector") $ capt_arg_of_typ (-"std" &:: "vector")
$--> StdVector.constructor_empty $--> StdVector.constructor_empty
; -"std" &:: "vector" ; -"std" &:: "vector" < capt_typ &+ any_typ >:: "vector"
< capt_typ `T
&+ any_typ >:: "vector"
$ capt_arg_of_typ (-"std" &:: "vector") $ capt_arg_of_typ (-"std" &:: "vector")
$+ capt_exp_of_prim_typ (Typ.mk (Typ.Tint Typ.size_t)) $+ capt_exp_of_prim_typ (Typ.mk (Typ.Tint Typ.size_t))
$+? any_arg $--> StdVector.constructor_size $+? any_arg $--> StdVector.constructor_size
; -"std" &:: "vector" ; -"std" &:: "vector" < capt_typ &+ any_typ >:: "vector"
< capt_typ `T
&+ any_typ >:: "vector"
$ capt_arg_of_typ (-"std" &:: "vector") $ capt_arg_of_typ (-"std" &:: "vector")
$+ capt_exp_of_typ (-"std" &:: "vector") $+ capt_exp_of_typ (-"std" &:: "vector")
$+? any_arg $--> StdVector.constructor_copy $+? any_arg $--> StdVector.constructor_copy
; -"std" &:: "vector" ; -"std" &:: "vector" < capt_typ &+ any_typ >:: "operator[]"
< capt_typ `T
&+ any_typ >:: "operator[]"
$ capt_arg_of_typ (-"std" &:: "vector") $ capt_arg_of_typ (-"std" &:: "vector")
$+ capt_exp $--> StdVector.at $+ capt_exp $--> StdVector.at
; -"std" &:: "vector" < capt_typ `T &+ any_typ >:: "empty" $ capt_arg $--> StdVector.empty ; -"std" &:: "vector" < capt_typ &+ any_typ >:: "empty" $ capt_arg $--> StdVector.empty
; -"std" &:: "vector" < capt_typ `T &+ any_typ >:: "data" $ capt_arg $--> StdVector.data ; -"std" &:: "vector" < capt_typ &+ any_typ >:: "data" $ capt_arg $--> StdVector.data
; -"std" &:: "vector" ; -"std" &:: "vector" < capt_typ &+ any_typ >:: "push_back" $ capt_arg $+ capt_exp
< capt_typ `T $--> StdVector.push_back
&+ any_typ >:: "push_back" $ capt_arg $+ capt_exp $--> StdVector.push_back
; -"std" &:: "vector" < any_typ &+ any_typ >:: "reserve" $ any_arg $+ any_arg $--> no_model ; -"std" &:: "vector" < any_typ &+ any_typ >:: "reserve" $ any_arg $+ any_arg $--> no_model
; -"std" &:: "vector" < capt_typ `T &+ any_typ >:: "size" $ capt_arg $--> StdVector.size ; -"std" &:: "vector" < capt_typ &+ any_typ >:: "size" $ capt_arg $--> StdVector.size
; +PatternMatch.implements_collection ; +PatternMatch.implements_collection
&:: "<init>" <>$ capt_var_exn &:: "<init>" <>$ capt_var_exn
$+ capt_exp_of_typ (+PatternMatch.implements_collection) $+ capt_exp_of_typ (+PatternMatch.implements_collection)

@ -33,7 +33,7 @@ end
let dispatch : (Tenv.t, typ_model, unit) ProcnameDispatcher.TypName.dispatcher = let dispatch : (Tenv.t, typ_model, unit) ProcnameDispatcher.TypName.dispatcher =
let open ProcnameDispatcher.TypName in let open ProcnameDispatcher.TypName in
make_dispatcher make_dispatcher
[ -"std" &:: "array" < capt_typ `T &+ capt_int >--> std_array [ -"std" &:: "array" < capt_typ &+ capt_int >--> std_array
; -"std" &:: "vector" < any_typ &+ any_typ >--> std_vector ; -"std" &:: "vector" < any_typ &+ any_typ >--> std_vector
; +PatternMatch.implements_collection &::.*--> Java.collection ; +PatternMatch.implements_collection &::.*--> Java.collection
; +PatternMatch.implements_iterator &::.*--> Java.collection ; +PatternMatch.implements_iterator &::.*--> Java.collection

Loading…
Cancel
Save