4.3BSD/usr/contrib/icon/tran/mktoktab.icn

# Build token and operator tables ("toktab.c" and "optab.c")
# from token description file "tokens" and skeleton operator
# state tables in "optab".

global token, tokval, bflag, eflag, head, oper, tail, count
global restable, opertable, flagtable
global tokfile, opfile, toktab, optab

procedure tokpat()
   if tab(many(' \t')) & (token := tab(upto(' \t'))) &
      tab(many(' \t')) & (tokval := (tab(upto(' \t') | 0)))
   then return (tab(upto('b')) & (bflag := move(1))) | (bflag := "") &
      ((tab(upto('e')) & (eflag := move(1))) | (eflag := "")) & pos(0)
end

procedure operpat()
   return (head := tab(upto('['))) & ="[   ]" &
      (tail := (tab(upto('"')) || move(1) ||
      (oper := tab(upto('"'))) || move(1) || tab(0)))
end

procedure main()
   local line, letter, lastletter
   restable := table("")
   opertable := table("")
   flagtable := table("")
   flagtable[""] := "0,"
   flagtable["b"] := "BEGINNER,"
   flagtable["e"] := "ENDER,"
   flagtable["be"] := "BEGINNER+ENDER,"
   count := 0
   lastletter := ""

   tokfile := open("tokens") | stop("tokens file missing")
   opfile := open("optab") | stop("optab file missing")
   toktab := open("toktab.c","w")
   optab := open("optab.c","w")

# Skip the first few (non-informative) lines of "tokens"

   garbage()

# Output header for "toktab.c"
   write(toktab,"#include \"itran.h\"")
   write(toktab,"#include \"lex.h\"")
   write(toktab,"#include \"token.h\"")
   write(toktab)
   write(toktab,"/*")
   write(toktab," * Token table - contains an entry for each token type")
   write(toktab," * with printable name of token, token type, and flags")
   write(toktab," * for semicolon insertion.")
   write(toktab," */")
   write(toktab)
   write(toktab,"struct toktab toktab[] = {")
   write(toktab,"/*  token\t\ttoken type\tflags */")
   write(toktab)
   write(toktab,"   /* primitives */")

# Read primitive tokens and output to "toktab.c"

   repeat {
      write(toktab,makeline(token,tokval,bflag || eflag,count))
      count +:= 1
      line := read(tokfile) | stop("premature end-of-file")
         line ? tokpat() | break
         }

# Skip some more garbage lines

   garbage()

# Output some more comments

   write(toktab)
   write(toktab,"   /* reserved words */")

# Read in reserved words, output them,
# and build table of first letters.

   repeat {
      write(toktab,makeline(token,tokval,bflag || eflag,count))
      letter := token[1]
      if letter ~== lastletter then {
         lastletter := letter
         restable[letter] := count
        }
   count +:= 1
   line := read(tokfile) | stop("premature end-of-file")
   if line ? tokpat() then next else break
   }

# Skip more garbage

   garbage()

# Another comment

   write(toktab)
   write(toktab,"   /* operators */")

# Read in operators, output them, and build table

repeat {
   write(toktab,makeline(token,tokval,bflag || eflag,count))
   opertable[token] := count
   count +:= 1
   line := read(tokfile) | stop("premature end-of-file")
   line ? tokpat() | break
   }
   eof()
end

procedure eof()	# output end of token table and reserveed word first-letter index.
   local line
   write(toktab,makeline("end-of-file","0","",""))
   write(toktab,"   };")
   write(toktab)
   write(toktab,"/*")
   write(toktab," * restab[c] points to the first keyword in toktab which")
   write(toktab," * begins with the letter c.")
   write(toktab," */")
   write(toktab)
   write(toktab,"struct toktab *restab[] = {")
   write(toktab,"                             NULL       , NULL       , /*   _` */")
   write(toktab,makeres("abcd"))
   write(toktab,makeres("efgh"))
   write(toktab,makeres("ijkl"))
   write(toktab,makeres("mnop"))
   write(toktab,makeres("qrst"))
   write(toktab,makeres("uvwx"))
   write(toktab,makeres("yz"))
   write(toktab,"   };")
   close(toktab)

# Read through operator state table skeleton, inserting
# token numbers for operators.

   repeat {
      while line := read(opfile) | break break do {
         if line ? operpat() then break
         else write(optab,line)
         }
      if /opertable[oper] then write("no entry for",oper)
      else write(optab,head,"[",right(opertable[oper],3),"]",tail)
      }
end

procedure makeline(token,tokval,flag,count)	# build an output line for token table.
   local line
   line := left("   \"" || token || "\",",22) || left(tokval ||  ",",15)
   flag := flagtable[flag]
   if count ~=== "" then flag := left(flag,19)
   line ||:= flag
   if count ~=== "" then line ||:= "/* " || right(count,3) || " */"
   return line
end

procedure makeres(lets)	# build an output line for reserved word index.
   local let, letters, line
   line := "   "
   letters := lets
   every let := !lets do
      if restable[let] ~=== "" then line ||:= "&toktab[" ||
         right(restable[let],2) || "], "
      else line ||:= "NULL,        "
   return left(line,55) || "/* " || letters || " */"
end

procedure garbage()
   local line
   while line := read(tokfile) | stop("premature end-of-file") do
      if line ? tokpat() then return
end