(* File GRREAD.ML *)

(* Project: GR *)

datatype gs         = T of string | N of string;
datatype 'a rhs     = Rhs of 'a list;
datatype 'a group   = Group of string * 'a rhs list;
datatype 'a grammar = Grammar of string list * 'a group list;

exception GrammarError of string;

local

  fun token_decl toks =
        ($"%token" ~~ many id >> snd) toks

  fun token_decl_seq toks =
        (many token_decl >> flat) toks

  fun rhs toks =
        (many id >> Rhs) toks

  fun rhs_seq toks =
        many_sep rhs ($"|") toks

  fun group toks =
        ( id ~~ $":" ~~ rhs_seq ~~ $";"
          >> (fn (((i,_),rhss),_) => Group (i, rhss))
        ) toks

  fun group_seq toks =
        many group toks

  fun grammar toks =
        (token_decl_seq ~~ $"%%" ~~ group_seq ~~ $"eof"
          >> (fn (((tkds,_),grps),_) => Grammar (tkds, grps))
        ) toks

  fun check_duplicates [] = ()
    | check_duplicates (x::rest) =
        if member x rest then
          raise GrammarError ("Non-terminal ["^x^"] is defined twice")
        else
          check_duplicates rest

  fun check_waifs ([], toks, defined_sym) = ()
    | check_waifs (x::rest, toks, defined_sym) =
        if (member x toks) orelse (member x defined_sym) then
          check_waifs (rest, toks, defined_sym)
        else
          raise GrammarError ("Symbol ["^x^
                  "] is neither a token nor a non-terminal")

  fun check_grammar (Grammar(toks, rules)) =
        let val defined_sym =
                  map (fn Group(nt,_) => nt) rules
            val used_sym    =
                  flat (map (fn Group(_,rhss) =>
                               flat (map (fn Rhs rhs => rhs) rhss))
                        rules)
        in
          if null rules then
            raise GrammarError "The grammar is empty"
          else ();
          case find (flip member defined_sym) toks
            of None  => ()
             | Some tk => raise GrammarError ("Symbol ["^tk^
                         "] is a token and a non-terminal at the same time");
          check_duplicates defined_sym;
          check_waifs (used_sym, toks, defined_sym);
          ()
        end

  fun insert_tags (Grammar (toks, rules)) =
        Grammar (toks,
          map (fn Group (nt, rhss) =>
                 Group (nt,
                   map (fn Rhs rhs =>
                          Rhs (map (fn sym =>
                                      if member sym toks
                                      then T sym
                                      else N sym
                                   ) rhs)
                       ) rhss)
              ) rules)

in

  fun read_grammar file_name =
    let val ()      =  output(std_err, "Reading and scanning the grammar\n")
        val toks    =  read_and_scan file_name
        val ()      =  output(std_err, "Parsing the grammar\n")
        val grammar =  parser grammar toks
        val ()      =  output(std_err, "Checking the grammar\n")
        val ()      =  check_grammar grammar
        val ()      =  output(std_err, "The grammar has been input\n")
    in insert_tags grammar end

end;