myocamlbuild.ml 8.04 KB
Newer Older
fpottier's avatar
fpottier committed
1 2 3
open Ocamlbuild_plugin
open Command

4
(* ---------------------------------------------------------------------------- *)
5
(* The following rules can be copied into other projects. *)
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
(* ---------------------------------------------------------------------------- *)

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

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

(* If [m] is the name of a module, [cmx m] is the name 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 decide between
   the two by testing whether an [.ml] file exists. *)

let cmx (m : string) : string =
  let candidate = m ^ ".cmx" in
  if Sys.file_exists (m ^ ".ml") then candidate else String.uncapitalize candidate
46

fpottier's avatar
fpottier committed
47 48
(* ---------------------------------------------------------------------------- *)

49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
(* 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
  let library = String.capitalize basename in
  let tags = [ Printf.sprintf "for-pack(%s)" library ] in
  List.iter (fun m ->
    tag_file (cmx m) tags
  ) modules

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

69 70
(* This rule generates an .ml file [target] from an .mly file [grammar] and a
   .messages file [messages]. *)
fpottier's avatar
fpottier committed
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 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
(* 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"

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

(* 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
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
(* 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
175 176 177 178 179 180
(* 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
181
   [fancy_parser]. *)
fpottier's avatar
fpottier committed
182

POTTIER Francois's avatar
POTTIER Francois committed
183 184 185 186
let fancy () : bool =
  mark_tag_used "fancy_parser";
  Tags.mem "fancy_parser" (tags_of_pathname "")

187 188
let parser_configuration () =
  (* Create [parser.mly] by copying the appropriate source file. *)
POTTIER Francois's avatar
POTTIER Francois committed
189 190 191 192 193
  copy_rule "create parser.mly"
    (* source: *)
    (if fancy() then "fancy-parser.mly" else "yacc-parser.mly")
    (* target: *)
    "parser.mly"
194 195
  ;
  (* Create [Driver.ml] by copying the appropriate source file. *)
POTTIER Francois's avatar
POTTIER Francois committed
196 197 198 199
  copy_rule "create Driver.ml" 
    (* source: *)
    (if fancy() then "fancyDriver.ml" else "yaccDriver.ml")
    (* target: *)
200
    "Driver.ml"
201
  ;
202 203 204 205 206
  (* 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
207 208 209 210
    (* 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. *)
211 212 213 214 215 216 217 218 219 220 221 222 223 224
    generic_completeness_check()
  end

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

(* Compilation flags for Menhir. *)

let flags () =
  (* -inline 1000 *)
  flag ["ocaml"; "compile"; "native"] (S [A "-inline"; A "1000"]);
  (* -noassert *)
  flag ["ocaml"; "compile"; "noassert"] (S [A "-noassert"]);
  (* nazi warnings *)
  flag ["ocaml"; "compile"; "my_warnings"] (S[A "-w"; A "@1..49-4-9-41-44"])
225

fpottier's avatar
fpottier committed
226 227 228 229 230 231 232
(* ---------------------------------------------------------------------------- *)

(* Define custom compilation rules. *)

let () =
  dispatch (function After_rules ->
    (* Add our rules after the standard ones. *)
233
    parser_configuration();
fpottier's avatar
fpottier committed
234
    flags();
235
    for_pack "menhirLib";
fpottier's avatar
fpottier committed
236 237
  | _ -> ()
  )