############################################################################
#
#	File:     grammar.icn
#
#	Subject:  Procedures for handling grammars in charpatt
#
#	Author:   Ralph E. Griswold
#
#	Date:     August 29, 1998
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This file contains procedures that handle grammars
#
############################################################################
#
#  Requires:  Version 9 graphics.
#
############################################################################

$include "defines.icn"

procedure enter_pattern()

   if \touched then save_grammar()

   get_goal() | fail

   if OpenDialog("Enter pattern:") == "Cancel" then fail

   make_grammar(dialog_value)

   return

end

procedure load_values()
   local input, symbols, token, new_string, symbols_lst, maps, k, fnc
   static mode, choices

   initial {
      mode := "numerically"
      choices := ["numerically", "lexically"]
      }

   input := open(nav_file) | {
      return FailNotice("Cannot open " || image(nav_file) || ".")
      }

   get_goal() | fail

   save_state(undo_list)

   touched := 1
 
   symbol_tbl := table()
   symbols_list := copy(symbols_list_full)
   token_tbl := table()

   WAttrib("pointer=watch")

   workspace_string := ""

   while workspace_string ||:= read(input) || " "
   workspace_string[-1] := "" 

   close(input)

   save_state(undo_list)

   token_tbl := table()
   symbols_lst := copy(symbols_list_auto)	# lowercase for terminals
   new_string := ""
   symbols := ""

   if SelectDialog("Sorting method:", choices, mode) == "Cancel" then fail

   mode := dialog_value

   fnc := case mode of {
      "numerically"  :  numeric
      "lexically"    :  string
      } 

   workspace_string ? {
      while token := tab(upto(' ') | 0) do {
         token := fnc(token) | {
            Notice("Nonnumeric value in numerical sort.")
            undo()
            fail
            }
         if /token_tbl[token] then {
            symbol := get(symbols_lst) | {
               Notice("Symbols exhausted.")
               undo()
               fail
               }
            remove_symbol(symbol)
            symbols ||:= symbol
            token_tbl[token] := symbol
            }
         else symbol := token_tbl[token]
         new_string ||:= symbol
         move(1) | break
         }
      }

   symbols_lst := sort(token_tbl, 3)		# start to convert by value
   maps := ""

   every maps ||:= symbols_lst[2 to *symbols_lst by 2]

   every k := key(token_tbl) do
      token_tbl[k] := map(token_tbl[k], maps, symbols)

   workspace_string := map(new_string, maps, symbols)

   WAttrib("pointer=arrow")

   grammar := &null
  
   clear_saved()

   symbol := goal

   refresh()

   return

end

procedure load_pattern()
   local input, line, number, token
   static pattern, start_line_no, end_line_no

   initial {
      pattern := "line"
      start_line_no := end_line_no := 1
      }

   repeat {
      input := open(nav_file) | {
         return FailNotice("Cannot open " || image(nav_file) || ".")
         }
   
   touched := 1

   symbol_tbl := table()
   symbols_list := copy(symbols_list_full)
   token_tbl := table()
   
   get_goal() | fail
   
   repeat {
      if TextDialog("Line numbers?", ["first", "last"],
         [start_line_no, end_line_no], 5) == "Cancel" then fail
      (start_line_no <- pint(1), end_line_no <- pint(2)) | {
         Notice("Invalid value.")
         next
         }
      every 1 to start_line_no - 1 do
         read(input) | {
            Notice("short file.")
            close(input)
            undo()
            next
            }
      workspace_string := ""
      every 1 to end_line_no - start_line_no + 1 do
         workspace_string ||:= read(input) | {
            Notice("short file.")
            close(input)
            undo()
            next
            }
      every remove_symbol(!cset(workspace_string))
      tokenize() | {		# tokenize reserved characters
         undo()
         close(input)
         fail
         }
      grammar := &null		# no saved grammar yet
         break break
         }
      }
  
   close(input)

   clear_saved()

   symbol := goal

   refresh()

   return

end

#  Load grammar.

procedure load_grammar()
   local input, line, note, token, sym, syms

   input := open(nav_file) | {
      return FailNotice("Cannot open " || image(nav_file) || ".")
      }

   save_state(undo_list)
   
   symbol_tbl := table()
   symbols_list := copy(symbols_list_full)
   token_tbl := table()

   goal := note := &null

   syms := ''

   every 1 to 4 do {
      line := read(input) | return bad_grammar(input)
      line ? {
         if ="comment:" then note := tab(0)
         else if ="axiom:" then {
            goal := symbol := move(1)
            syms ++:= goal
            }
         }
      }

   if /goal then return bad_grammar(input)

   while line := read(input) do {
      line ? {
         if = "# Token Table" then {	# token table follows
            while line := read(input) do {
               line ? {
                  token := move(1)
                  token_tbl[tab(0)] := token
                  syms ++:= token
                  }
               }
            }
         else if ="name:" then {	# old-style token grammar follows
            every 1 to 2 do
               read(input)		# discard keywords
            while line := read(input) do {
               line ? {
                  token := move(1)
                  if token == goal then next	# don't include
                  ="->" | return bad_grammar(input)
                  token_tbl[tab(0)] := token
                  syms ++:= token
                  }
               }
            break 
            }
         else {
            sym := move(1)
            ="->" | return bad_grammar(input)
            symbol_tbl[sym] := tab(0)
            syms ++:= sym ++ symbol_tbl[sym]
            }
         }
      }

   every remove_symbol(!syms)
 
   workspace_string := \symbol_tbl[goal] | return bad_grammar(input)

   close(input)

   refresh()

   grammar := 1

   clear_saved()

   return

end

procedure make_grammar(value)

   workspace_string := value

   symbol_tbl := table()
   symbols_list := copy(symbols_list_full)

   symbol := goal

   every remove_symbol(!cset(workspace_string))
      tokenize() | {		# tokenize reserved characters
      undo()
      fail
      }

   refresh()

   return

end

procedure new_grammar()

   if \touched then save_grammar()

   make_grammar(workspace_string)

   return

end

#  Save grammar.

procedure save_grammar()
   local symbol, output, token, axiom, file, toks
   static lf

   initial lf := "\n"

   repeat {
      case SaveDialog("Save grammar:", nav_file) of {
         "Cancel"  :  fail
         "No"      :  return
         }
      file := dialog_value
      if not overwrite(file) then next
      output := open(file, "w") | {
         Notice("Cannot open file for writing.")
         next
         }
      nav_file := file
      break
      }

   write(output,
      "name:", nav_file, lf,		# name *must* be first
      "comment:", note, lf,
      "axiom:", goal, lf,
      "gener:", gdepth()
      )

   every symbol := !keylist(symbol_tbl) do
      write(output, symbol, "->", symbol_tbl[symbol])

   if *token_tbl > 0 then {
      write(output, "# Token Table")
   
      toks := sort(token_tbl, 4)

      while token := get(toks) do
         write(output, symbol := get(toks), token)
      }

   close(output)

   grammar := 1

   nav_refresh()			# refresh files in navigator

   refresh()

   return

end

#  Set up new grammar.  CHECK USAGE; USE ELSEWHERE.

procedure setup_grammar()

   clear_saved()
   symbol_tbl := table()
   token_tbl := table()
   symbol := goal
   workspace_string := ""

   refresh()

   return

end