bundles/menhirLib/menhir-20120123/src/slr.ml

   1 (**************************************************************************)
   2 (*                                                                        *)
   3 (*  Menhir                                                                *)
   4 (*                                                                        *)
   5 (*  François Pottier, INRIA Rocquencourt                                  *)
   6 (*  Yann Régis-Gianas, PPS, Université Paris Diderot                      *)
   7 (*                                                                        *)
   8 (*  Copyright 2005-2008 Institut National de Recherche en Informatique    *)
   9 (*  et en Automatique. All rights reserved. This file is distributed      *)
  10 (*  under the terms of the Q Public License version 1.0, with the change  *)
  11 (*  described in file LICENSE.                                            *)
  12 (*                                                                        *)
  13 (**************************************************************************)
  14
  15 (* This module extends the LR(0) automaton with lookahead information in order
  16    to construct an SLR(1) automaton. The lookahead information is obtained by
  17    considering the FOLLOW sets. *)
  18
  19 (* This construction is not used by Menhir, but can be used to check whether
  20    the grammar is in the class SLR(1). This check is performed when the log
  21    level [lg] is at least 1. *)
  22
  23 open Grammar
  24
  25 (* This flag, which is reserved for internal use, causes more information
  26    about SLR(1) conflict states to be printed. *)
  27
  28 let tell_me_everything =
  29   false
  30
  31 (* The following function turns an LR(0) state into an SLR(1) state. *)
  32
  33 let make_slr_state (s : Lr0.node) : Lr0.concretelr1state =
  34
  35   (* Obtain the set of LR(0) items associated with the state [s]. *)
  36
  37   let items = Lr0.items s in
  38
  39   (* Unfortunately, this set is not closed. We do not have a function that
  40      computes the closure of a set of LR(0) items -- we could build one using
  41      [Item.Closure], but that would be overkill.  So, we first convert this
  42      set to a set of LR(1) items, then compute the closure at this level, and
  43      finally we turn this LR(1) state into an SLR(1) state by letting the
  44      lookahead sets be the FOLLOW sets. This is somewhat ugly and naïve, but
  45      seems to work. *)
  46
  47   (* Convert this set to a set of LR(1) items. Here, we can use any set of
  48      tokens as the lookahead set. We use the empty set. *)
  49
  50   let s = Item.Map.lift (fun item -> TerminalSet.empty) items in
  51
  52   (* Compute the LR(1) closure. *)
  53
  54   let s = Lr0.closure s in
  55
  56   (* We now have an LR(1) state that has the correct set of LR(0) items but
  57      phony lookahead information. We convert it into an SLR(1) state by
  58      deciding that, for each item, the lookahead set is the FOLLOW set of the
  59      symbol that appears on the left-hand side of the item. *)
  60
  61   Item.Map.fold (fun item toks accu ->
  62     let _, nt, _, _, _ = Item.def item in
  63     let follow_nt = Analysis.follow nt in
  64     assert (TerminalSet.subset toks follow_nt); (* sanity check *)
  65     Item.Map.add item follow_nt accu
  66   ) s Item.Map.empty
  67
  68 (* Insertion of a new reduce action into the table of reductions. Copied
  69    from [Lr1] (boo, hiss). *)
  70
  71 let addl prod tok reductions =
  72   let prods =
  73     try
  74       TerminalMap.lookup tok reductions
  75     with Not_found ->
  76       []
  77   in
  78   TerminalMap.add tok (prod :: prods) reductions
  79
  80 (* Same thing, for a set of tokens. *)
  81
  82 let addl prod toks reductions =
  83   TerminalSet.fold (addl prod) toks reductions
  84
  85 (* The following function turns a closed LR(1) state into a map of terminal
  86    symbols to reduction actions. Copied from a related function in [Lr0]. *)
  87
  88 let reductions (s : Lr0.concretelr1state) : Production.index list TerminalMap.t =
  89   Item.Map.fold (fun item toks reductions ->
  90     match Item.classify item with
  91     | Item.Reduce prod ->
  92         addl prod toks reductions
  93     | Item.Shift _ ->
  94         reductions
  95   ) s TerminalMap.empty
  96
  97 (* The following function turns a closed LR(1) state into a set of shift
  98    actions. *)
  99
 100 let transitions (s : Lr0.concretelr1state) : TerminalSet.t =
 101   Item.Map.fold (fun item _ transitions ->
 102     match Item.classify item with
 103     | Item.Shift (Symbol.T tok, _) ->
 104         TerminalSet.add tok transitions
 105     | Item.Shift (Symbol.N _, _)
 106     | Item.Reduce _ ->
 107         transitions
 108   ) s TerminalSet.empty
 109
 110 (* This function computes the domain of a terminal map, producing a terminal
 111    set. *)
 112
 113 let domain (m : 'a TerminalMap.t) : TerminalSet.t =
 114   TerminalMap.fold (fun tok _ accu ->
 115     TerminalSet.add tok accu
 116   ) m TerminalSet.empty
 117
 118 (* The following function checks whether a closed LR(1) state is free of
 119    conflicts. *)
 120
 121 let state_is_ok (s : Lr0.concretelr1state) : bool =
 122
 123   let reductions = reductions s
 124   and transitions = transitions s in
 125
 126   (* Check for shift/reduce conflicts. *)
 127
 128   TerminalSet.disjoint transitions (domain reductions) &&
 129
 130   (* Check for reduce/reduce conflicts. *)
 131
 132   TerminalMap.fold (fun _ prods ok ->
 133     ok && match prods with
 134     | []
 135     | [ _ ] ->
 136         true
 137     | _ :: _ :: _ ->
 138         false
 139   ) reductions true
 140
 141 (* The following function counts the number of states in the SLR(1) automaton
 142    that have a conflict. *)
 143
 144 let count_slr_violations () : int =
 145
 146   let count = ref 0 in
 147
 148   for s = 0 to Lr0.n - 1 do
 149     let s = make_slr_state s in
 150     if not (state_is_ok s) then begin
 151       incr count;
 152       if tell_me_everything then
 153         Printf.fprintf
 154           stderr
 155           "The following SLR(1) state has a conflict:\n%s"
 156           (Lr0.print_concrete s)
 157     end
 158   done;
 159
 160   !count
 161
 162 (* At log level 1, indicate whether the grammar is SLR(1). *)
 163
 164 let () =
 165   Error.logG 1 (fun f ->
 166     let count = count_slr_violations() in
 167     if count = 0 then
 168       Printf.fprintf f "The grammar is SLR(1).\n"
 169     else
 170       Printf.fprintf f "The grammar is not SLR(1) -- %d states have a conflict.\n" count
 171   )
 172