nonterminalType.ml 4.03 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
open BasicSyntax
15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
open IL

(* This is the conventional name of the nonterminal GADT, which describes the
   nonterminal symbols. *)

let tcnonterminalgadt =
  "nonterminal"

let tnonterminalgadt a =
  TypApp (tcnonterminalgadt, [ a ])

(* This is the conventional name of the data constructors of the nonterminal
   GADT. *)

let tnonterminalgadtdata nt =
  "N_" ^ Misc.normalize nt

(* This is the definition of the nonterminal GADT. Here, the data
   constructors have no value argument, but have a type index. *)

35
exception MissingOCamlType of string
36 37

let nonterminalgadtdef grammar =
38 39 40
  assert Settings.inspection;
  let comment, datadefs =
    try
41

42 43
      (* The ordering of this list matters. We want the data constructors
         to respect the internal ordering (as determined by [nonterminals]
44
         in [BasicSyntax]) of the nonterminal symbols. This may
45
         be exploited in the table back-end to allow an unsafe conversion
46 47
         of a data constructor to an integer code. See [n2i] in
         [InspectionTableInterpreter]. *)
48

49
      "The indexed type of nonterminal symbols.",
50
      List.map (fun nt ->
51 52 53 54 55
        let index =
          match ocamltype_of_symbol grammar nt with
          | Some t ->
              TypTextual t
          | None ->
56
              raise (MissingOCamlType nt)
57 58 59 60 61
        in
        {
          dataname = tnonterminalgadtdata nt;
          datavalparams = [];
          datatypeparams = Some [ index ]
62 63
        }
      ) (nonterminals grammar)
64 65

    with MissingOCamlType nt ->
66 67 68 69
      (* If the type of some nonterminal symbol is unknown, give up
         and define ['a nonterminal] as an abstract type. This is
         useful when we are in [--(raw)-depend] mode and we do not
         wish to fail. Instead, we produce a mock [.mli] file that
70 71 72
         is an approximation of the real [.mli] file. When we are
         not in [--(raw)-depend] mode, though, this is a problem.
         We display an error message and stop. *)
73 74 75
      Settings.(match infer with
      | IMDependRaw
      | IMDependPostprocess ->
76 77
          "The indexed type of nonterminal symbols (mock!).",
          []
78
      | IMNone ->
79
          Error.error [] "\
80 81
            the type of the nonterminal symbol %s is unknown.\n\
            When --inspection is set, the type of every nonterminal symbol must be known.\n\
82 83
            Please enable type inference (see --infer and --infer-read-reply)\n\
            or specify the type of every symbol via %%type declarations."
84
            nt
85 86 87 88 89 90 91 92 93 94
      | IMInfer
      | IMReadReply _ ->
          (* This should not happen: when [--infer] or [--infer-read-reply]
             is set, the types of all nonterminal symbols should be known. *)
          assert false
      | IMWriteQuery _ ->
          (* This should not happen: when [--infer-write-query] is set, we
             write a mock [.ml] file, but no [.mli] file, so this function
             should never be called. *)
          assert false)
95

96 97 98 99 100 101 102 103 104 105
  in
  [
    IIComment comment;
    IITypeDecls [{
      typename = tcnonterminalgadt;
      typeparams = [ "_" ];
      typerhs = TDefSum datadefs;
      typeconstraint = None
    }]
  ]