myocamlbuild.ml 11.5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

fpottier's avatar
fpottier committed
14 15 16
open Ocamlbuild_plugin
open Command

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
(* ---------------------------------------------------------------------------- *)

(* This compatibility layer allows us to support both OCaml 4.02 and 4.03, with
   deprecation errors activated. We define our own copies of certain 4.03
   functions. *)

module Compatibility = struct

  module Char = struct

    let lowercase_ascii c =
      if (c >= 'A' && c <= 'Z')
      then Char.chr (Char.code c + 32)
      else c

    let uppercase_ascii c =
      if (c >= 'a' && c <= 'z')
      then Char.chr (Char.code c - 32)
      else c

  end

  module Bytes = struct

    include Bytes

    let apply1 f s =
      if Bytes.length s = 0 then s else begin
        let r = Bytes.copy s in
        Bytes.unsafe_set r 0 (f (Bytes.unsafe_get s 0));
        r
      end

    let capitalize_ascii s =
      apply1 Char.uppercase_ascii s

    let uncapitalize_ascii s =
      apply1 Char.lowercase_ascii s

  end

  module String = struct

    let capitalize_ascii s =
      Bytes.unsafe_to_string (Bytes.capitalize_ascii (Bytes.unsafe_of_string s))

    let uncapitalize_ascii s =
      Bytes.unsafe_to_string (Bytes.uncapitalize_ascii (Bytes.unsafe_of_string s))

  end

end

70
(* ---------------------------------------------------------------------------- *)
71
(* The following rules can be copied into other projects. *)
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
(* ---------------------------------------------------------------------------- *)

(* The auxiliary function [lines] reads a file, line by line. *)

let lines filename : string list =
  let c = open_in filename in
  let lines = ref [] in
  try
    while true do
      lines := input_line c :: !lines
    done;
    assert false
  with End_of_file ->
    close_in c;
    List.rev !lines

(* The auxiliary function [noncomment] recognizes a non-blank non-comment line. *)

let rec noncomment s i n =
  i < n && match s.[i] with
  | ' ' | '\t' | '\r' | '\n' ->
      noncomment s (i + 1) n
  | '#' ->
      false
  | _ ->
      true

let noncomment s =
  noncomment s 0 (String.length s)

(* ---------------------------------------------------------------------------- *)

104 105 106 107 108 109 110 111
(* If [m] is the name of a module, [cmx m] are the possible names of its
   [.cmx] file. There are two candidate names, because of OCaml's convention
   where the first letter of the file name is capitalized to obtain the module
   name. We do *not* decide between them by accessing the file system, because
   we do not understand or control when ocamlbuild copies files to the build
   directory. *)

let cmx (m : string) : string list =
112
  let candidate = m ^ ".cmx" in
113
  [ candidate; Compatibility.String.uncapitalize_ascii candidate ]
114

fpottier's avatar
fpottier committed
115 116
(* ---------------------------------------------------------------------------- *)

117 118 119 120 121 122 123 124 125 126
(* If there is a file [foo.mlpack], then the modules that are listed in this
   file are meant to be part of the library [Foo], and should receive the tag
   [for-pack(Foo)]. ocamlbuild doesn't do this automatically, so we program
   it. *)

(* The argument [basename] should be the basename of the [.mlpack] file. *)

let for_pack (basename : string) =
  let filename = basename ^ ".mlpack" in
  let modules = List.filter noncomment (lines filename) in
127
  let library = Compatibility.String.capitalize_ascii basename in
128 129
  let tags = [ Printf.sprintf "for-pack(%s)" library ] in
  List.iter (fun m ->
130 131 132
    List.iter (fun candidate ->
      tag_file candidate tags
    ) (cmx m)
133 134 135 136 137 138
  ) modules

(* ---------------------------------------------------------------------------- *)
(* The following rules can be copied into other projects. *)
(* ---------------------------------------------------------------------------- *)

139 140
(* This rule generates an .ml file [target] from an .mly file [grammar] and a
   .messages file [messages]. *)
fpottier's avatar
fpottier committed
141

142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
(* If the name of a witness file is passed, it is made an additional
   dependency. This triggers a separate rule (see below) which performs a
   completeness check, that is, which checks that the .messages file lists
   every possible syntax error. *)

let compile_errors grammar messages (witness : string list) target =
  rule
    "menhir/compile_errors"
    ~prod:target
    ~deps:([ grammar; messages ] @ witness)
    (fun env _ ->
      let grammar = env grammar in
      let tags = tags_of_pathname grammar ++ "ocaml" ++ "menhir" in
      Cmd(S[
        !Options.ocamlyacc; (* menhir *)
        T tags;
        P grammar;
        A "--compile-errors"; P (env messages);
        Sh ">"; Px (env target);
      ]))

(* A generic version of the above rule, with uniform naming. *)

let generic_compile_errors (check_completeness : bool) =
  compile_errors
    (* sources: *)
    "%.mly" "%Messages.messages"
    (* if present, this dependency forces a completeness check: *)
    (if check_completeness then [ "%Messages.witness" ] else [])
    (* target: *)
    "%Messages.ml"

(* ---------------------------------------------------------------------------- *)

176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
(* This rule allows to embed a text file verbatim inside an OCaml module. The
   OCaml module contains a single value [contents] containing the contents
   of the text file. *)

let embed_text_files input output =
  rule
    "embed a text file inside an OCaml module"
    ~prod:output
    ~dep:input
    (fun env _ ->
      let ic = open_in_bin (env input) in
      let contents = really_input_string ic (in_channel_length ic) in
      close_in ic;
      Echo(["let contents = \""; String.escaped contents; "\""], env output)
    )

(* ---------------------------------------------------------------------------- *)

194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
(* This rule generates a .messages file [messages] from an .mly file
   [grammar]. *)

let list_errors grammar messages =
  rule
    "produce a list of messages"
    ~prod:messages
    ~dep:grammar
    (fun env _ ->
      let grammar = env grammar in
      let tags = tags_of_pathname grammar ++ "ocaml" ++ "menhir" in
      Cmd(S[
        !Options.ocamlyacc; (* menhir *)
        T tags;
        P grammar;
        A "--list-errors";
        Sh ">"; Px (env messages);
      ]))

(* ---------------------------------------------------------------------------- *)

(* This rule compares the .messages files [messages1] and [messages2]. This is
   used to ensure complete coverage, i.e., check that every possible error is
   covered. The file [witness] is used as a witness that the comparison has
   been carried out. *)

let compare_errors grammar messages1 messages2 witness =
  rule
    "compare two lists of messages"
    ~stamp:witness
    ~deps:[ grammar; messages1; messages2 ]
    (fun env _ ->
      let grammar = env grammar in
      let tags = tags_of_pathname grammar ++ "ocaml" ++ "menhir" in
      Cmd(S[
        !Options.ocamlyacc; (* menhir *)
        T tags;
        P grammar;
        A "--compare-errors"; P (env messages1);
        A "--compare-errors"; P (env messages2);
      ]))
fpottier's avatar
fpottier committed
235 236 237

(* ---------------------------------------------------------------------------- *)

238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
(* This rule combines the above two rules and makes sure that the [messages]
   file is complete, i.e., covers all possible errors. This rule creates a
   witness file. *)

let completeness_check grammar messages witness =
  (* We need a name for a temporary [.messages] file, which we produce,
     and which lists all possible errors. *)
  let complete_messages = grammar ^ ".auto.messages" in
  (* Use the above two rules. *)
  list_errors grammar complete_messages;
  compare_errors grammar complete_messages messages witness

(* A generic version of the above rule, with uniform naming. *)

let generic_completeness_check () =
  completeness_check
    (* sources: *)
    "%.mly" "%Messages.messages"
    (* target: *)
    "%Messages.witness"

(* ---------------------------------------------------------------------------- *)
(* The following rules and settings are specific to the compilation of Menhir.  *)
(* ---------------------------------------------------------------------------- *)

fpottier's avatar
fpottier committed
263 264 265 266 267 268
(* Dealing with the two parsers. *)

(* Just for fun, Menhir comes with two parsers for its own input files. One is
   called [yacc-parser.mly] and is built using [ocamlyacc]. The other is called
   [fancy-parser.mly] and is built using Menhir. It depends on [standard.mly].
   The choice between the two parsers is determined by the presence of the tag
269
   [fancy_parser]. *)
fpottier's avatar
fpottier committed
270

POTTIER Francois's avatar
POTTIER Francois committed
271 272 273 274
let fancy () : bool =
  mark_tag_used "fancy_parser";
  Tags.mem "fancy_parser" (tags_of_pathname "")

275 276
let parser_configuration () =
  (* Create [parser.mly] by copying the appropriate source file. *)
POTTIER Francois's avatar
POTTIER Francois committed
277 278 279 280 281
  copy_rule "create parser.mly"
    (* source: *)
    (if fancy() then "fancy-parser.mly" else "yacc-parser.mly")
    (* target: *)
    "parser.mly"
282 283
  ;
  (* Create [Driver.ml] by copying the appropriate source file. *)
284
  copy_rule "create Driver.ml"
POTTIER Francois's avatar
POTTIER Francois committed
285 286 287
    (* source: *)
    (if fancy() then "fancyDriver.ml" else "yaccDriver.ml")
    (* target: *)
288
    "Driver.ml"
289
  ;
290 291 292 293 294
  (* In the fancy case, use Menhir to generate [parserMessages.ml] based
     on [parserMessages.messages], which is maintained by hand. Also, check
     that [parserMessages.messages] covers all possible syntax errors. *)
  if fancy() then begin
    generic_compile_errors true;
POTTIER Francois's avatar
POTTIER Francois committed
295 296 297 298
    (* We might wish to perform the completeness check only if [Sys.word_size]
       is at least 64. Indeed, on a 32-bit machine, [menhir --list-errors] is
       restricted to small grammars. For the moment, this works, because our
       grammar is small enough. *)
299 300
    generic_completeness_check()
  end
301 302
  ;
  embed_text_files "%.mly" "%_mly.ml"
303 304 305

(* ---------------------------------------------------------------------------- *)

306 307 308 309 310 311 312 313 314 315 316 317
(* If the tag [sdk] is provided, then the modules listed in [menhirSdk.mlpack]
   must be built using [for-pack(MenhirSdk)]. Otherwise, we are building Menhir
   and menhirLib, so the modules listed in [menhirLib.mlpack] must be built using
   [for-pack(MenhirLib)]. There could be a nonempty intersection between the two,
   which is why we do not supply both sets of flags at once. *)

let sdk () : bool =
  mark_tag_used "sdk";
  Tags.mem "sdk" (tags_of_pathname "")

(* ---------------------------------------------------------------------------- *)

318 319 320
(* Compilation flags for Menhir. *)

let flags () =
POTTIER Francois's avatar
POTTIER Francois committed
321
  (* -noassert (if enabled by tag) *)
322 323
  flag ["ocaml"; "compile"; "noassert"] (S [A "-noassert"]);
  (* nazi warnings *)
324
  flag ["ocaml"; "compile"; "my_warnings"] (S[A "-w"; A "@1..66-4-9-41-44-60"])
325

fpottier's avatar
fpottier committed
326 327 328 329 330 331 332
(* ---------------------------------------------------------------------------- *)

(* Define custom compilation rules. *)

let () =
  dispatch (function After_rules ->
    (* Add our rules after the standard ones. *)
333
    parser_configuration();
fpottier's avatar
fpottier committed
334
    flags();
335
    if sdk() then for_pack "menhirSdk" else for_pack "menhirLib"
fpottier's avatar
fpottier committed
336 337
  | _ -> ()
  )