Printers.ml 2.38 KB
Newer Older
1
module Make
2
  (I : IncrementalEngine.EVERYTHING)
3
  (User : sig
4 5 6
    val print: string -> unit
    val print_symbol: I.xsymbol -> unit
    val print_element: (I.element -> unit) option
7 8 9
  end)
= struct

10 11 12
  let arrow = " -> "
  let dot = "."
  let space = " "
13
  let newline = "\n"
14

15
  open User
16
  open I
17 18 19 20 21

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

22
  let rec print_symbols i symbols =
23
    if i = 0 then begin
24 25 26
      print dot;
      print space;
      print_symbols (-1) symbols
27 28 29 30 31 32
    end
    else begin
      match symbols with
      | [] ->
          ()
      | symbol :: symbols ->
33 34 35
          print_symbol symbol;
          print space;
          print_symbols (i - 1) symbols
36 37 38 39 40 41
    end

  (* Printing an element as a symbol. *)

  let print_element_as_symbol element =
    match element with
42 43
    | Element (s, _, _, _) ->
        print_symbol (X (incoming_symbol s))
44

45 46 47
  (* 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]. *)
48

49 50 51 52 53 54 55
  let print_element =
    match print_element with
    | Some print_element ->
        print_element
    | None ->
        print_element_as_symbol

56
  (* Printing a stack as a list of symbols. *)
57

58
  let print_stack stack =
59
    General.foldr (fun element () ->
60 61
      print_element element;
      print space
62 63
    ) stack ();
    print newline
64

65 66 67
  (* Printing an item. *)

  let print_item (prod, i) =
68
    print_symbol (lhs prod);
69
    print arrow;
70
    print_symbols i (rhs prod);
71 72
    print newline

73 74 75 76 77
  (* Printing a list of symbols (public version). *)

  let print_symbols symbols =
    print_symbols (-1) symbols

78 79 80 81 82 83 84 85 86
  (* 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: ";
87
    match Lazy.force (stack env) with
88
    | General.Nil ->
89 90
        print "<some initial state>";
        print newline
91
    | General.Cons (Element (current, _, _, _), _) ->
92 93
        print (string_of_int (Obj.magic current)); (* TEMPORARY safe conversion needed *)
        print newline;
94 95 96 97 98 99
        List.iter print_item (items current)

  let print_env env =
    print_stack (stack env);
    print_current_state env;
    print newline
100

101 102
end