reachability.ml 1.21 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 36 37 38 39 40
open UnparameterizedSyntax

let rec visit grammar visited symbol =
  try
    let rule = StringMap.find symbol grammar.rules in
    if not (StringSet.mem symbol visited) then
      let visited = StringSet.add symbol visited in
      List.fold_left (visitb grammar) visited rule.branches
    else
      visited
  with Not_found ->
    (* This is a terminal symbol. *)
    assert (symbol = "error" || StringMap.mem symbol grammar.tokens);
    visited

and visitb grammar visited { producers = symbols } =
  List.fold_left (visits grammar) visited symbols

and visits grammar visited (symbol, _) =
  visit grammar visited symbol

let trim grammar =
  if StringSet.cardinal grammar.start_symbols = 0 then
    Error.error [] "no start symbol has been declared."
  else
    let reachable =
      StringSet.fold (fun symbol visited ->
	visit grammar visited symbol
      ) grammar.start_symbols StringSet.empty 
    in
    StringMap.iter (fun symbol rule ->
      if not (StringSet.mem symbol reachable) then
	Error.grammar_warning
	  rule.positions
	  (Printf.sprintf
	     "symbol %s is unreachable from any of the start symbol(s)."
	       symbol)
    ) grammar.rules;
    { grammar with rules = StringMap.restrict reachable grammar.rules }