inspectionTableInterpreter.ml 4.13 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
(* -------------------------------------------------------------------------- *)

(* The type functor. *)

module Symbols (T : sig

  type 'a terminal
  type 'a nonterminal

end) = struct

  open T

14
15
16
  (* This should be the only place in the whole library (and generator!)
     where these types are defined. *)

17
18
19
20
21
22
23
24
25
26
27
28
29
  type 'a symbol =
    | T : 'a terminal -> 'a symbol
    | N : 'a nonterminal -> 'a symbol

  type xsymbol = 
    | X : 'a symbol -> xsymbol

end

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

(* The code functor. *)

30
31
32
33
34
module Make
  (B : TableFormat.TABLES)
  (T : InspectionTableFormat.TABLES
       with type 'a lr1state = int)
= struct
35

36
37
  (* Including [T] is an easy way of inheriting the definitions of the types
     [symbol] and [xsymbol]. *)
38

39
  include T
40

41
42
43
44
45
46
47
48
49
  (* This auxiliary function decodes a packed linearized array, as created by
     [TableBackend.linearize_and_marshal1]. Here, we read a row all at once. *)

  let read_packed_linearized ((data, entry) : PackedIntArray.t * PackedIntArray.t) (i : int) : int list =
    LinearizedArray.read_row_via
      (PackedIntArray.get data)
      (PackedIntArray.get entry)
      i

50
51
52
  (* This auxiliary function decodes a symbol. The encoding was done by
     [encode_symbol] or [encode_symbol_option] in the table back-end. *)

53
  let decode_symbol (symbol : int) : T.xsymbol =
54
55
56
57
58
59
60
61
62
63
64
65
    (* If [symbol] is 0, then we have no symbol. This could mean e.g.
       that the function [incoming_symbol] has been applied to an
       initial state. In principle, this cannot happen. *)
    assert (symbol > 0);
    (* The low-order bit distinguishes terminal and nonterminal symbols. *)
    let kind = symbol land 1 in
    let symbol = symbol lsr 1 in
    if kind = 0 then
      T.terminal (symbol - 1)
    else
      T.nonterminal symbol

66
67
68
69
70
71
72
73
74
75
76
77
78
  (* This auxiliary function converts a nonterminal symbol to its integer
     code. For speed and for convenience, we use an unsafe type cast. This
     relies on the fact that the data constructors of the [nonterminal] GADT
     are declared in an order that reflects their internal code. We add
     [start] to account for the presence of the start symbols. *)

  let n2i (nt : 'a T.nonterminal) : int =
    let answer = B.start + Obj.magic nt in
    assert (T.nonterminal answer = X (N nt)); (* TEMPORARY roundtrip *)
    answer

  (* The function [incoming_symbol] goes through the tables [T.lr0_core] and
     [T.lr0_incoming]. This yields a representation of type [xsymbol], out of
79
80
81
82
     which we strip the [X] quantifier, so as to get a naked symbol. This last
     step is ill-typed and potentially dangerous. It is safe only because this
     function is used at type ['a lr1state -> 'a symbol], which forces an
     appropriate choice of ['a]. *)
83

84
85
86
87
  let incoming_symbol (s : 'a T.lr1state) : 'a T.symbol =
    let core = PackedIntArray.get T.lr0_core s in
    let symbol = decode_symbol (PackedIntArray.get T.lr0_incoming core) in
    match symbol with
88
89
90
    | T.X symbol ->
        Obj.magic symbol

91
  (* The function [lhs] reads the table [B.lhs] and uses [T.nonterminal]
92
93
94
     to decode the symbol. *)

  let lhs prod =
95
    T.nonterminal (PackedIntArray.get B.lhs prod)
96

97
  (* The function [rhs] reads the table [T.rhs] and uses [decode_symbol]
98
     to decode the symbol. *)
99
100
101
102
103

  let rhs prod =
    List.map decode_symbol (read_packed_linearized T.rhs prod)

  (* The function [items] maps the LR(1) state [s] to its LR(0) core,
104
     then uses [core] as an index into the table [T.lr0_items]. The
105
106
107
     items are then decoded by the function [export] below, which is
     essentially a copy of [Item.export]. *)

108
109
110
111
  type item =
      int * int

  let export t : item =
112
113
114
115
116
    (t lsr 7, t mod 128)

  let items s =
    (* Map [s] to its LR(0) core. *)
    let core = PackedIntArray.get T.lr0_core s in
117
    (* Now use [core] to look up the table [T.lr0_items]. *)
118
119
    List.map export (read_packed_linearized T.lr0_items core)

120
121
122
123
124
125
126
  (* The function [nullable] maps the nonterminal symbol [nt] to its
     integer code, which it uses to look up the array [T.nullable].
     This yields 0 or 1, which we map back to a Boolean result. *)

  let nullable nt =
    PackedIntArray.get1 T.nullable (n2i nt) = 1

127
end