slr.ml 4.71 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
(* This module extends the LR(0) automaton with lookahead information in order
   to construct an SLR(1) automaton. The lookahead information is obtained by
   considering the FOLLOW sets. *)

(* This construction is not used by Menhir, but can be used to check whether
   the grammar is in the class SLR(1). This check is performed when the log
   level [lg] is at least 1. *)

open Grammar

(* This flag, which is reserved for internal use, causes more information
   about SLR(1) conflict states to be printed. *)

let tell_me_everything =
  false

(* The following function turns an LR(0) state into an SLR(1) state. *)

let make_slr_state (s : Lr0.node) : Lr0.concretelr1state =

  (* Obtain the set of LR(0) items associated with the state [s]. *)

  let items = Lr0.items s in

  (* Unfortunately, this set is not closed. We do not have a function that
     computes the closure of a set of LR(0) items -- we could build one using
     [Item.Closure], but that would be overkill.  So, we first convert this
     set to a set of LR(1) items, then compute the closure at this level, and
     finally we turn this LR(1) state into an SLR(1) state by letting the
     lookahead sets be the FOLLOW sets. This is somewhat ugly and naïve, but
     seems to work. *)

  (* Convert this set to a set of LR(1) items. Here, we can use any set of
     tokens as the lookahead set. We use the empty set. *)

36
  let s = Item.Map.lift (fun _item -> TerminalSet.empty) items in
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 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

  (* Compute the LR(1) closure. *)

  let s = Lr0.closure s in

  (* We now have an LR(1) state that has the correct set of LR(0) items but
     phony lookahead information. We convert it into an SLR(1) state by
     deciding that, for each item, the lookahead set is the FOLLOW set of the
     symbol that appears on the left-hand side of the item. *)

  Item.Map.fold (fun item toks accu ->
    let _, nt, _, _, _ = Item.def item in
    let follow_nt = Analysis.follow nt in
    assert (TerminalSet.subset toks follow_nt); (* sanity check *)
    Item.Map.add item follow_nt accu
  ) s Item.Map.empty

(* Insertion of a new reduce action into the table of reductions. Copied
   from [Lr1] (boo, hiss). *)

let addl prod tok reductions =
  let prods =
    try
      TerminalMap.lookup tok reductions
    with Not_found ->
      []
  in
  TerminalMap.add tok (prod :: prods) reductions

(* Same thing, for a set of tokens. *)

let addl prod toks reductions =
  TerminalSet.fold (addl prod) toks reductions

(* The following function turns a closed LR(1) state into a map of terminal
   symbols to reduction actions. Copied from a related function in [Lr0]. *)

let reductions (s : Lr0.concretelr1state) : Production.index list TerminalMap.t =
  Item.Map.fold (fun item toks reductions ->
    match Item.classify item with
    | Item.Reduce prod ->
	addl prod toks reductions
    | Item.Shift _ ->
	reductions
  ) s TerminalMap.empty

(* The following function turns a closed LR(1) state into a set of shift
   actions. *)

let transitions (s : Lr0.concretelr1state) : TerminalSet.t =
  Item.Map.fold (fun item _ transitions ->
    match Item.classify item with
    | Item.Shift (Symbol.T tok, _) ->
        TerminalSet.add tok transitions
    | Item.Shift (Symbol.N _, _)
    | Item.Reduce _ ->
        transitions
  ) s TerminalSet.empty

(* This function computes the domain of a terminal map, producing a terminal
   set. *)

let domain (m : 'a TerminalMap.t) : TerminalSet.t =
  TerminalMap.fold (fun tok _ accu ->
    TerminalSet.add tok accu
  ) m TerminalSet.empty

(* The following function checks whether a closed LR(1) state is free of
   conflicts. *)

let state_is_ok (s : Lr0.concretelr1state) : bool =

  let reductions = reductions s
  and transitions = transitions s in

  (* Check for shift/reduce conflicts. *)

  TerminalSet.disjoint transitions (domain reductions) &&

  (* Check for reduce/reduce conflicts. *)

  TerminalMap.fold (fun _ prods ok ->
    ok && match prods with
    | []
    | [ _ ] ->
        true
    | _ :: _ :: _ ->
        false
  ) reductions true

(* The following function counts the number of states in the SLR(1) automaton
   that have a conflict. *)

let count_slr_violations () : int =

  let count = ref 0 in

  for s = 0 to Lr0.n - 1 do
    let s = make_slr_state s in
    if not (state_is_ok s) then begin
      incr count;
      if tell_me_everything then
	Printf.fprintf
	  stderr
	  "The following SLR(1) state has a conflict:\n%s"
	  (Lr0.print_concrete s)
    end
  done;

  !count

(* At log level 1, indicate whether the grammar is SLR(1). *)

let () =
  Error.logG 1 (fun f ->
    let count = count_slr_violations() in
    if count = 0 then
      Printf.fprintf f "The grammar is SLR(1).\n"
    else
      Printf.fprintf f "The grammar is not SLR(1) -- %d states have a conflict.\n" count
  )