front.ml 7.37 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.                                                             *)
(*                                                                            *)
(******************************************************************************)

14
(* The front-end. This module performs a series of toplevel side effects. *)
15

16 17 18 19
(* ------------------------------------------------------------------------- *)

(* Reading a grammar from a file. *)

20
let load_partial_grammar filename : Syntax.partial_grammar =
21 22
  let validExt = if Settings.coq then ".vy" else ".mly" in
  if not (Filename.check_suffix filename validExt) then
23
    Error.error []
24
      "argument file names should end in %s. \"%s\" is not accepted."
25
      validExt filename;
26
  InputFile.new_input_file filename;
27 28 29
  try

    let contents = IO.read_whole_file filename in
30 31 32 33 34 35 36 37
    InputFile.with_file_contents contents (fun () ->
      let open Lexing in
      let lexbuf = Lexing.from_string contents in
      lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename };
      (* the grammar: *)
      { (Driver.grammar Lexer.main lexbuf)
        with Syntax.pg_filename = filename }
    )
38 39

  with Sys_error msg ->
40
    Error.error [] "%s" msg
41 42 43 44 45

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

(* Read all of the grammar files that are named on the command line. *)

46
let grammars : Syntax.partial_grammar list =
47 48 49 50 51 52 53
  List.map load_partial_grammar Settings.filenames

let () =
  Time.tick "Lexing and parsing"

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

54 55
(* Eliminate anonymous rules. *)

56 57
let grammars : Syntax.partial_grammar list =
  List.map Anonymous.transform_partial_grammar grammars
58 59 60

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

61 62
(* If several grammar files were specified, merge them. *)

63 64
let grammar : Syntax.grammar =
  PartialGrammar.join_partial_grammars grammars
65 66 67

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

68
(* Check that the grammar is well-sorted; infer the sort of every symbol. *)
69

70
let sorts =
71
  SortInference.infer grammar
72 73 74

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

75 76
(* Expand away all applications of parameterized nonterminal symbols, so as
   to obtain a grammar without parameterized nonterminal symbols. *)
77

78
let grammar : BasicSyntax.grammar =
79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
  let module S = SelectiveExpansion in
  (* First, perform a selective expansion: expand away all parameters of
     higher sort, keeping the parameters of sort [*]. This process always
     terminates. *)
  let grammar1 = S.expand S.ExpandHigherSort sorts grammar in
  (* This "first-order parameterized grammar" can then be submitted to
     the termination check. *)
  CheckSafeParameterizedGrammar.check grammar1;
  (* If it passes the check, then full expansion is safe. We drop [grammar1]
     and start over from [grammar]. This is required in order to get correct
     names. (Expanding [grammar1] would yield an equivalent grammar, with
     more complicated names, reflecting the two steps of expansion.) *)
  let grammar = S.expand S.ExpandAll sorts grammar in
  (* This yields an unparameterized grammar. *)
  Drop.drop grammar
94 95 96 97 98

let () =
  Time.tick "Joining and expanding"

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

100 101 102 103
(* If [--only-tokens] was specified on the command line, produce
   the definition of the [token] type and stop. *)

let () =
104
  TokenType.produce_tokentypes grammar
105

106 107
(* ------------------------------------------------------------------------- *)

108 109 110 111 112 113 114 115
(* Perform reachability analysis. *)

let grammar =
  Reachability.trim grammar

let () =
  Time.tick "Trimming"

116 117
(* ------------------------------------------------------------------------- *)

118 119 120
(* If [--infer] was specified on the command line, perform type inference.
   The OCaml type of every nonterminal symbol is then known. *)

121 122
(* If [--depend] or [--raw-depend] was specified on the command line,
   perform dependency analysis and stop. *)
123

124 125 126
(* The purpose of [--depend] and [--raw-depend] is to support [--infer].
   Indeed, [--infer] is implemented by producing a mock [.ml] file (which
   contains just the semantic actions) and invoking [ocamlc]. This requires
127 128 129 130 131
   certain [.cmi] files to exist. So, [--(raw-)depend] is a way for us to
   announce which [.cmi] files we need. It is implemented by producing the
   mock [.ml] file and running [ocamldep] on it. We also produce a mock
   [.mli] file, even though in principle it should be unnecessary -- see
   comment in [nonterminalType.mli]. *)
132

133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
(* If [--infer-write-query] was specified on the command line, write a
   mock [.ml] file and stop. It is then up to the user (or build system)
   to invoke [ocamlc -i] on this file, so as to do type inference. *)

(* If [--infer-read-reply] was specified on the command line, read the
   inferred [.mli] file. The OCaml type of every nonterminal symbol is
   then known, just as with [--infer]. *)

let grammar, ocaml_types_have_been_checked =
  Settings.(match infer with
  | IMNone ->
      grammar, false
  | IMInfer ->
      let grammar = Infer.infer grammar in
      Time.tick "Inferring types for nonterminals";
      grammar, true
  | IMDependRaw ->
      Infer.depend false grammar         (* never returns *)
  | IMDependPostprocess ->
      Infer.depend true grammar          (* never returns *)
  | IMWriteQuery filename ->
      Infer.write_query filename grammar (* never returns *)
  | IMReadReply filename ->
      let grammar = Infer.read_reply filename grammar in
      Time.tick "Reading inferred types for nonterminals";
      grammar, true
  )
160

161
(* ------------------------------------------------------------------------- *)
162 163 164 165 166 167 168

(* Expand away some of the position keywords. *)

let grammar =
  KeywordExpansion.expand_grammar grammar

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

170 171 172 173 174
(* If [--no-inline] was specified on the command line, skip the
   inlining of non terminal definitions marked with %inline. *)

let grammar =
  if Settings.inline then begin
175
    let grammar = Inlining.inline grammar in
176 177 178
    (* 2018/05/23 Removed the warning that was issued when %inline was used
       but --infer was turned off. Most people should use ocamlbuild or dune
       anyway. *)
179 180 181
    Time.tick "Inlining";
    grammar
  end
182
  else
183 184
    grammar

185 186
(* ------------------------------------------------------------------------- *)

187 188 189 190 191 192
(* If [--only-preprocess] or [--only-preprocess-drop] was specified on the
   command line, print the grammar and stop. Otherwise, continue. *)

let () =
  match Settings.preprocess_mode with
  | Settings.PMOnlyPreprocess mode ->
193
      BasicPrinter.print mode stdout grammar;
194 195 196
      exit 0
  | Settings.PMNormal ->
      ()