/usr/lib/ocaml/findlib/fl_metascanner.mli is in libfindlib-ocaml-dev 1.5.5-2build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | (* $Id: fl_metascanner.mli 195 2013-06-05 23:29:59Z gerd $
* ----------------------------------------------------------------------
*
*)
(** Parses META files *)
open Fl_metatoken
type formal_pred =
[ `Pred of string (** Positive occurence of a formal predicate var *)
| `NegPred of string (** Negative occurence of a formal predicate var *)
]
type flavour =
[ `BaseDef
| `Appendix
]
(** [`BaseDef] refers to META definitions using the "=" operator,
* and [`Appendix] refers to definitions using the "+=" operator.
*)
type pkg_definition =
{ def_var : string; (** The name of the defined variable *)
def_flav : flavour; (** The flavour of the definition *)
def_preds : formal_pred list; (** The formal predicates of the def *)
def_value : string; (** The value assigned to the variable *)
}
(** A [pkg_definition] is expressed by the syntax
* {[ var(p1,p2,...) = "value" ]} (flavour `BaseDef),
* or the syntax
* {[ var(p1,p2,...) += "value" ]} (flavour `Appendix)
* in the META file. The list of predicates may be omitted. Predicates
* may be negated by using "-", e.g. "-x".
*)
type pkg_expr =
{ pkg_defs : pkg_definition list;
pkg_children : (string * pkg_expr) list;
}
(** A value of type [pkg_expr] denotes the contents of a META file.
* The component [pkg_defs] are the variable definitions.
* The component [pkg_children] contains
* the definitions of the subpackages.
*)
val parse : in_channel -> pkg_expr
(** [parse ch:]
* scans and parses the file connected with channel [ch]. The file must
* have a syntax compatible with the META format. The return value
* contains the found definitions for the package and all subpackages.
*
* [exception Stream.Error of string:] is
* raised on syntax errors. The string explains the error.
*)
val parse2 : in_channel -> pkg_expr
val parse2_lexing : Lexing.lexbuf -> pkg_expr
val parse_lexing : Lexing.lexbuf -> pkg_expr
val print : out_channel -> pkg_expr -> unit
(** [print ch expr]:
* Outputs the package expression to a channel.
*)
val lookup :
string -> string list -> pkg_definition list -> string
(** [lookup variable_name predicate_list def]:
*
* Returns the value of [variable_name] in [def] under the assumption
* that the predicates in [predicate_list] hold, but no other predicates.
*
* The rules are as follows: In the step (A), only the [`BaseDef]
* definitions are considered. The first base definition is determined where
* all predicates are satisfied and that has the longest predicate list.
* In the step (B) only the [`Appendix] definitions are considered.
* All definitions are determined where all predicates are satisfied.
* The final result is the concatenation of the single result of (A)
* and all results of (B) (in the order they are defined). A space
* character is inserted between two concatenated strings.
*
* When step (A) does not find any matching definition, the exception
* [Not_found] is raised.
*)
val predicate_exists :
string -> pkg_definition list -> bool
(** [predicate_exists variable_name def]:
Whether [variable_name] is explicitly mentioned in [def].
*)
|