2020-05-15 12:16:19 -07:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* OCaml *)
|
|
|
|
(* *)
|
|
|
|
(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *)
|
|
|
|
(* Thomas Refis, Jane Street Europe *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 2019 Institut National de Recherche en Informatique et *)
|
|
|
|
(* en Automatique. *)
|
|
|
|
(* *)
|
|
|
|
(* All rights reserved. This file is distributed under the terms of *)
|
|
|
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
|
|
|
(* special exception on linking described in the file LICENSE. *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
|
|
|
|
2019-08-19 00:48:59 -07:00
|
|
|
open Asttypes
|
|
|
|
open Typedtree
|
|
|
|
open Types
|
|
|
|
|
|
|
|
val omega : pattern
|
|
|
|
(** aka. "Tpat_any" or "_" *)
|
|
|
|
|
|
|
|
val omegas : int -> pattern list
|
|
|
|
(** [List.init (fun _ -> omega)] *)
|
|
|
|
|
|
|
|
val omega_list : 'a list -> pattern list
|
|
|
|
(** [List.map (fun _ -> omega)] *)
|
|
|
|
|
2019-09-09 09:04:48 -07:00
|
|
|
module Non_empty_row : sig
|
|
|
|
type 'a t = 'a * Typedtree.pattern list
|
|
|
|
|
|
|
|
val of_initial : Typedtree.pattern list -> Typedtree.pattern t
|
|
|
|
(** 'assert false' on empty rows *)
|
|
|
|
|
|
|
|
val map_first : ('a -> 'b) -> 'a t -> 'b t
|
|
|
|
end
|
|
|
|
|
2019-09-09 13:48:11 -07:00
|
|
|
module Simple : sig
|
|
|
|
type view = [
|
|
|
|
| `Any
|
|
|
|
| `Constant of constant
|
|
|
|
| `Tuple of pattern list
|
|
|
|
| `Construct of
|
|
|
|
Longident.t loc * constructor_description * pattern list
|
|
|
|
| `Variant of label * pattern option * row_desc ref
|
|
|
|
| `Record of
|
|
|
|
(Longident.t loc * label_description * pattern) list * closed_flag
|
|
|
|
| `Array of pattern list
|
|
|
|
| `Lazy of pattern
|
|
|
|
]
|
|
|
|
type pattern = view pattern_data
|
2019-09-10 00:15:13 -07:00
|
|
|
|
|
|
|
val omega : [> view ] pattern_data
|
2019-09-09 13:48:11 -07:00
|
|
|
end
|
|
|
|
|
|
|
|
module Half_simple : sig
|
|
|
|
type view = [
|
|
|
|
| Simple.view
|
|
|
|
| `Or of pattern * pattern * row_desc option
|
|
|
|
]
|
|
|
|
type pattern = view pattern_data
|
|
|
|
end
|
|
|
|
|
2019-09-09 09:04:48 -07:00
|
|
|
module General : sig
|
2019-09-09 13:48:11 -07:00
|
|
|
type view = [
|
|
|
|
| Half_simple.view
|
|
|
|
| `Var of Ident.t * string loc
|
|
|
|
| `Alias of pattern * Ident.t * string loc
|
|
|
|
]
|
|
|
|
type pattern = view pattern_data
|
2019-09-09 09:04:48 -07:00
|
|
|
|
|
|
|
val view : Typedtree.pattern -> pattern
|
2019-09-09 13:48:11 -07:00
|
|
|
val erase : [< view ] pattern_data -> Typedtree.pattern
|
2019-09-10 00:15:13 -07:00
|
|
|
|
|
|
|
val strip_vars : pattern -> Half_simple.pattern
|
2019-09-09 09:04:48 -07:00
|
|
|
end
|
|
|
|
|
2019-08-19 00:48:59 -07:00
|
|
|
module Head : sig
|
|
|
|
type desc =
|
|
|
|
| Any
|
|
|
|
| Construct of constructor_description
|
|
|
|
| Constant of constant
|
|
|
|
| Tuple of int
|
|
|
|
| Record of label_description list
|
|
|
|
| Variant of
|
|
|
|
{ tag: label; has_arg: bool;
|
|
|
|
cstr_row: row_desc ref;
|
|
|
|
type_row : unit -> row_desc; }
|
|
|
|
(* the row of the type may evolve if [close_variant] is called,
|
|
|
|
hence the (unit -> ...) delay *)
|
|
|
|
| Array of int
|
|
|
|
| Lazy
|
|
|
|
|
2019-09-09 08:54:09 -07:00
|
|
|
type t = desc pattern_data
|
2019-08-19 00:48:59 -07:00
|
|
|
|
|
|
|
val arity : t -> int
|
|
|
|
|
|
|
|
(** [deconstruct p] returns the head of [p] and the list of sub patterns.
|
|
|
|
|
2020-06-03 02:25:25 -07:00
|
|
|
@raise [Invalid_arg _] if [p] is an or- or an exception-pattern. *)
|
2019-09-10 00:15:13 -07:00
|
|
|
val deconstruct : Simple.pattern -> t * pattern list
|
2019-08-19 00:48:59 -07:00
|
|
|
|
|
|
|
(** reconstructs a pattern, putting wildcards as sub-patterns. *)
|
|
|
|
val to_omega_pattern : t -> pattern
|
|
|
|
|
|
|
|
val omega : t
|
|
|
|
|
|
|
|
end
|