Module type Signatures.PLUGIN

This module contains the functions and values that can be used by plugins.

module Tags : TAGS
module Command : COMMAND with type tags = Tags.t and type pathname = Pathname.t
module Outcome : OUTCOME
module String : STRING
module List : LIST
module StringSet : Set.S with type elt = String.t
module Arch : ARCH

Findlib / Ocamlfind tools.

include MISC
val opt_print : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a option -> unit
val the : 'a option -> 'a
val getenv : ?default:string -> string -> string
val with_input_file : ?bin:bool -> string -> (in_channel -> 'a) -> 'a
val with_output_file : ?bin:bool -> string -> (out_channel -> 'a) -> 'a
val with_temp_file : string -> string -> (string -> 'a) -> 'a
val read_file : string -> string
val copy_chan : in_channel -> out_channel -> unit
val copy_file : string -> string -> unit
val print_string_list : Format.formatter -> string list -> unit
val (!*) : 'a Lazy.t -> 'a

A shortcut to force lazy value (See

azy.force

).

val (&) : ('a -> 'b) -> 'a -> 'b

The right associative application. Useful when writing to much parentheses: << f (g x ... t) >> becomes << f& g x ... t >> << f (g (h x)) >> becomes << f& g& h x >>

val (|>) : 'a -> ('a -> 'b) -> 'b

The reversed application combinator. Useful to describe some operations chaining. << f x (g y (h z)) >> becomes << z |> h |> g y |> f x >>

val (@:=) : 'a list ref -> 'a list -> unit

r @:= l is equivalent to r := !r @ l

val memo : ('a -> 'b) -> 'a -> 'b
val memo2 : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c
val memo3 : ('a -> 'b -> 'c -> 'd) -> 'a -> 'b -> 'c -> 'd
type command = Command.t =
| Seq of command list
| Cmd of spec
| Echo of string list * Pathname.t
| Nop

See COMMAND.t for the description of this type.

and spec = Command.spec =
| N
| S of spec list
| A of string
| P of string
| Px of string
| Sh of string
| T of Tags.t
| V of string
| Quote of spec

See COMMAND.spec for the description of this type.

path1/path2 Join the given path names.

val (-.-) : Pathname.t -> string -> Pathname.t

path-.-extension Add the given extension to the given pathname.

val (++) : Tags.t -> Tags.elt -> Tags.t

tags++tag Add the given tag to the given set of tags.

val (--) : Tags.t -> Tags.elt -> Tags.t

tags--tag Remove the given tag to the given set of tags.

val (+++) : Tags.t -> Tags.elt option -> Tags.t

tags+++optional_tag Add the given optional tag to the given set of tags if the given option is Some.

val (---) : Tags.t -> Tags.elt option -> Tags.t

tags---optional_tag Remove the given optional tag to the given set of tags if the given option is Some.

type env = Pathname.t -> Pathname.t

Targets and dependencies in rules are patterns, which are matched by the actual targets requested by the user. For example, if a rule explains how to build "%.cmo" from "%.ml", it will be fired if the user tries to build "foo.cmo".

The environment records the value of the pattern variables (here "%") in this matching. In the context of our example, the environment will be a function substituting "%" by "foo"; calling it on "%.cmo" will return "foo.cmo", and calling it on "%.ml" will return "foo.ml".

For a typical example of use of the environment, see the ocamldep_ml_command example in the documentation of action below.

type builder = Pathname.t list list -> (Pathname.t, exn) Outcome.t list

A builder is a function that waits for a conjunction of alternative targets. The alternatives are here to support some choices, for instance for an OCaml module an alternatives can be foo.cmo or Foo.cmo. Conjunctions are here to enable parallelism: commands that are independent will be run concurrently.

For example, passing ["foo.cmi"; "Foo.cmi"]; ["bar.cmi"; "Bar.cmi"] will build the interfaces of the modules Foo and Bar, trying both possible capitalization of the source file names.

For an example of use of a builder function, see the targets function given as an example in the documentation of the action type below.

type action = env -> builder -> Command.t

This is the type for rule actions. An action receive as argument, the environment lookup function (see env), and a function to dynamically build more targets (see builder). An action should return the command to run in order to build the rule productions using the rule dependencies.

For example, here is an action to build an ocamldep command, for use in the example of rule given in the documentation of rule below:

let ocamldep_ml_command env _build =
  let arg = env "%.ml" and out = env "%.ml.depends" in
  let tags = tags_of_pathname arg ++ "ocaml" ++ "ocamldep" in
  Cmd(S[A "ocamldep"; T tags; A "-modules"; P arg; Sh ">"; Px out])

In the example above, the build function is not used, as there are no dynamic dependencies. There are in the example below: we build a list of targets dynamically read from a "foo.itarget" file. The final command returned by the action links each of them in the current directory.

let target_list env build =
    let itarget = env "%.itarget" in
    let targets =
      let dir = Pathname.dirname itarget in
      let files = string_list_of_file itarget in
      List.map (fun file -> [Pathname.concat dir file]) files
    in
    let results = List.map Outcome.good (build targets) in
    let link_command result =
      Cmd (S [A "ln"; A "-sf";
              P (Pathname.concat !Options.build_dir result);
              A Pathname.pwd])
    in
    Seq (List.map link_command results)
val rule : string -> ?tags:string list -> ?prods:string list -> ?deps:string list -> ?prod:string -> ?dep:string -> ?stamp:string -> ?insert:[ `top | `before of string | `after of string | `bottom ] -> ?doc:string -> action -> unit

This is the main function for adding a rule to the ocamlbuild engine.

  • The first argument is the name of the rule (should be unique).
  • It takes files that the rule produces. Use ~prod for one file, ~prods for list of files.
  • It also takes files that the rule uses. Use ~dep for one file, ~deps for list of files.
  • It finally takes the action to perform in order to produce the productions files using the dependencies (see action).

There are some more optional parameters:

  • The ~insert argument allows to insert the rules precisely between other rules.
  • The ~stamp argument specifies the name of a file that will be automatically produced by ocamlbuild. This file can serve as a virtual target (or phony target), since it will be filled up by a digest of it dependencies.
  • The ~tags argument in deprecated, don't use it.

Finally, the optional ~doc argument allows to give an informal explanation of the rule purpose and behavior, that will be displayed by ocamlbuild -documentation. For example, it is a good place to specify the commands that will be called, any new tags introduced by the rule, and dynamic dependencies.

For example, here is how a rule producing foo.ml.depends from foo.ml (calling ocamldep) is defined, slightly simplified from the built-in definition.

rule "ocaml dependencies ml"
  ~prod:"%.ml.depends"
  ~dep:"%.ml"
  ~doc:"call ocamldep to compute a syntactic over-approximation \\
        of the dependencies of the corresponding implementation file"
  ocamldep_ml_command

The rule that builds a list of targets from a %.itarget file is an example of use of the ?stamp argument. It uses the target_list action provided in the documentation of action above. Besides the targets listed in the %.itarget file, this command will also produce a %.otarget file (the "stamp") that contains the digest of all the %.itarget dependencies. This stamp file is the name to use when you want to ask OCamlbuild to build the targets listed: invoking ocamlbuild foo.otarget will build the the targets listed in foo.itarget. Similarly, new rules that would depend on that list of targets should depend on %.otarget (output), not %.itarget (input).

rule "target files"
  ~dep:"%.itarget"
  ~stamp:"%.otarget"
  ~doc:"If foo.itarget contains a list of ocamlbuild targets, \
        asking ocamlbuild to produce foo.otarget will \
        build each of those targets in turn."
  target_list
val copy_rule : string -> ?insert:[ `top | `before of string | `after of string | `bottom ] -> string -> string -> unit

copy_rule name ?insert source destination

val clear_rules : unit -> unit

Empties the list of rules of the ocamlbuild engine.

val dep : Tags.elt list -> Pathname.t list -> unit

dep tags deps Will build deps when all tags will be activated. If you do not know which tags to use, have a look to the file _build/_log after trying to compile your code.

val pdep : Tags.elt list -> Tags.elt -> (string -> Pathname.t list) -> unit

pdep tags ptag deps is equivalent to dep tags deps, with an additional parametrized tag ptag. deps is now a function which takes the parameter of the tag ptag as an argument.

Example: pdep ["ocaml"; "compile"] "autodep" (fun param -> param) says that the tag autodep(file) can now be used to automatically add file as a dependency when compiling an OCaml program.

val flag : Tags.elt list -> Command.spec -> unit

flag tags command_spec Will inject the given piece of command (command_spec) when all tags will be activated. If you do not know which tags to use, have a look to the file _build/_log after trying to compile your code.

val pflag : Tags.elt list -> Tags.elt -> (string -> Command.spec) -> unit

Allows to use flag with a parametrized tag (as pdep for dep).

Example: pflag ["ocaml"; "compile"] "inline" (fun count -> S [A "-inline"; A count]) says that command line option "-inline 42" should be added when compiling OCaml modules tagged with "inline(42)".

val flag_and_dep : Tags.elt list -> Command.spec -> unit

flag_and_dep tags command_spec Combines flag and dep function. Basically it calls flag tags command_spec, and calls dep tags files where files is the list of all pathnames in command_spec. Pathnames selected are those in the constructor P or Px, or the pathname argument of builtins like Echo.

val pflag_and_dep : Tags.elt list -> Tags.elt -> (string -> Command.spec) -> unit

Allows to use flag_and_dep with a parametrized tag (as pdep for dep).

val mark_tag_used : Tags.elt -> unit

manually mark the tag as "useful" to silence the warning about tags that are not part of any flag declaration.

This is useful, for example, if the tag is used in a flag declaration that is only performed in a conditional branch: if we_are_on_Windows then flag ["libfoo"] (A "bar");

When we_are_on_Windows is not true, you could get a warning about "libfoo" not used in any flag declaration.

val non_dependency : Pathname.t -> string -> unit

non_dependency module_path module_name Example: non_dependency "foo/bar/baz" "Goo" Says that the module Baz in the file foo/bar/baz.* does not depend on Goo.

val use_lib : Pathname.t -> Pathname.t -> unit

use_lib module_path lib_path

val ocaml_lib : ?extern:bool -> ?byte:bool -> ?native:bool -> ?dir:Pathname.t -> ?tag_name:string -> Pathname.t -> unit

ocaml_lib <options> library_pathname Declare an ocaml library. This informs ocamlbuild and produce tags to use the library; they are named by default use_#

brary_name

}

.

Example: ocaml_lib "foo/bar" will setup the tag use_bar. At link time it will include: foo/bar.cma or foo/bar.cmxa

  • parameter dir

    supply the ~dir:"boo" option to add '-I boo' at link and compile time.

  • parameter extern

    use ~extern:true for non-ocamlbuild handled libraries. Set this to add libraries whose sources are not in your project.

  • parameter byte

    use ~byte:false to disable byte mode.

  • parameter native

    use ~native:false to disable native mode.

  • parameter tag_name

    Use ~tag_name:"usebar" to override the default tag name.

val expand_module : Pathname.t list -> Pathname.t -> string list -> Pathname.t list

expand_module include_dirs module_name extensions Example: expand_module ["a";"b";"c"] "Foo" ["cmo";"cmi"] = ["a/foo.cmo"; "a/Foo.cmo"; "a/foo.cmi"; "a/Foo.cmi"; "b/foo.cmo"; "b/Foo.cmo"; "b/foo.cmi"; "b/Foo.cmi"; "c/foo.cmo"; "c/Foo.cmo"; "c/foo.cmi"; "c/Foo.cmi"]

val string_list_of_file : Pathname.t -> string list

Reads the given file, parse it has list of words separated by blanks. It ignore lines that begins with a '#' character.

val module_name_of_pathname : Pathname.t -> string

Takes a pathname and returns an OCaml module name. Basically it will remove directories and extensions, and then capitalize the string.

The Unix mv command.

The Unix cp command.

The Unix ln -f command.

The Unix ln -s command.

val rm_f : Pathname.t -> Command.t

The Unix rm -f command.

The Unix chmod command (almost deprecated).

The Unix cmp command (almost deprecated).

val hide_package_contents : string -> unit

hide_package_contents pack_name Don't treat the given package as an open package. So a module will not be replaced during linking by this package even if it contains that module.

val tag_file : Pathname.t -> Tags.elt list -> unit

tag_file filename tag_list Tag the given filename with all given tags. Prefix a tag with the minus sign to remove it. This is usually used as an After_rules hook. For example tag_file "bla.ml" ["use_unix"] tags the file "bla.ml" with "use_unix" and tag_file "bla.ml" ["-use_unix"] removes the tag "use_unix" from the file "bla.ml".

val tag_any : Tags.elt list -> unit

tag_any tag_list Tag anything with all given tags.

val tags_of_pathname : Pathname.t -> Tags.t

Returns the set of tags that applies to the given pathname.

val run_and_read : string -> string

Run the given command and returns it's output as a string.

type hook =
| Before_hygiene
| After_hygiene
| Before_options
| After_options
| Before_rules
| After_rules

Here is the list of hooks that the dispatch function have to handle. Generally one responds to one or two hooks (like After_rules) and do nothing in the default case.

val dispatch : (hook -> unit) -> unit

dispatch hook_handler Is the entry point for ocamlbuild plugins. Every plugin must call it with a hook_handler where all calls to plugin functions lives.