Printers.ml 3.44 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 Library General Public License version 2, with a         *)
(*  special exception on linking, as described in the file LICENSE.           *)
(*                                                                            *)
(******************************************************************************)

14
module Make
15
  (I : IncrementalEngine.EVERYTHING)
16
  (User : sig
17 18 19
    val print: string -> unit
    val print_symbol: I.xsymbol -> unit
    val print_element: (I.element -> unit) option
20 21 22
  end)
= struct

23 24 25
  let arrow = " -> "
  let dot = "."
  let space = " "
26
  let newline = "\n"
27

28
  open User
29
  open I
30 31 32 33 34

  (* Printing a list of symbols. An optional dot is printed at offset
     [i] into the list [symbols], if this offset lies between [0] and
     the length of the list (included). *)

35
  let rec print_symbols i symbols =
36
    if i = 0 then begin
37 38 39
      print dot;
      print space;
      print_symbols (-1) symbols
40 41 42 43 44 45
    end
    else begin
      match symbols with
      | [] ->
          ()
      | symbol :: symbols ->
46 47 48
          print_symbol symbol;
          print space;
          print_symbols (i - 1) symbols
49 50 51 52 53 54
    end

  (* Printing an element as a symbol. *)

  let print_element_as_symbol element =
    match element with
55 56
    | Element (s, _, _, _) ->
        print_symbol (X (incoming_symbol s))
57

58 59 60
  (* Some of the functions that follow need an element printer. They use
     [print_element] if provided by the user; otherwise they use
     [print_element_as_symbol]. *)
61

62 63 64 65 66 67 68
  let print_element =
    match print_element with
    | Some print_element ->
        print_element
    | None ->
        print_element_as_symbol

69 70 71 72 73 74 75 76 77 78 79 80 81 82
  (* Printing a stack as a list of symbols. Stack bottom on the left,
     stack top on the right. *)

  let rec print_stack env =
    match top env, pop env with
    | Some element, Some env ->
        print_stack env;
        print space;
        print_element element
    | _, _ ->
        ()

  let print_stack env =
    print_stack env;
83
    print newline
84

85 86 87
  (* Printing an item. *)

  let print_item (prod, i) =
88
    print_symbol (lhs prod);
89
    print arrow;
90
    print_symbols i (rhs prod);
91 92
    print newline

93 94 95 96 97
  (* Printing a list of symbols (public version). *)

  let print_symbols symbols =
    print_symbols (-1) symbols

98 99 100 101 102 103 104 105 106
  (* Printing a production (without a dot). *)

  let print_production prod =
    print_item (prod, -1)

  (* Printing the current LR(1) state. *)

  let print_current_state env =
    print "Current LR(1) state: ";
107 108 109
    match top env with
    | None ->
        print "<some initial state>"; (* TEMPORARY unsatisfactory *)
110
        print newline
111
    | Some (Element (current, _, _, _)) ->
112
        print (string_of_int (number current));
113
        print newline;
114 115 116
        List.iter print_item (items current)

  let print_env env =
117
    print_stack env;
118 119
    print_current_state env;
    print newline
120

121
end