From: goer@ellis.uchicago.edu (Richard L. Goerwitz)
Newsgroups: comp.lang.icon
Subject: parser generator, part 4
Date: 3 Jan 93 21:19:56 GMT
Reply-To: goer@midway.uchicago.edu
Organization: University of Chicago

---- Cut Here and feed the following to sh ----
#!/bin/sh
# this is ibpag.04 (part 4 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file itokens.icn continued
#
if test ! -r _shar_seq_.tmp; then
	echo 'Please unpack part 1 first!'
	exit 1
fi
(read Scheck
 if test "$Scheck" != 4; then
	echo Please unpack part "$Scheck" next!
	exit 1
 else
	exit 0
 fi
) < _shar_seq_.tmp || exit 1
if test ! -f _shar_wnt_.tmp; then
	echo 'x - still skipping itokens.icn'
else
echo 'x - continuing file itokens.icn'
sed 's/^X//' << 'SHAR_EOF' >> 'itokens.icn' &&
X#      non-whitespace character, whitespace being defined as
X#      membership of a given character in the whitespace argument (a
X#      cset). 
X#
Xprocedure do_whitespace(getchar, whitespace)
X
X#   write(&errout, "it's junk")
X    while any(whitespace, next_c) do
X	next_c := @getchar
X    return
X
Xend
X
X
X#
X#  do_identifier:  coexpression x table    -> TOK record
X#                  (getchar, reserved_tbl) -> t
X#
X#      Where getchar is the coexpression that pops off characters from
X#      the input stream, reserved_tbl is a table of reserved words
X#      (keys = the string values, values = the names qua symbols in
X#      the grammar), and t is a TOK record containing all subsequent
X#      letters, digits, or underscores after next_c (which must be a
X#      letter or underscore).  Note that next_c is global and gets
X#      reset by do_identifier.
X#
Xprocedure do_identifier(getchar, reserved_tbl)
X
X    local token
X    # global next_c
X
X#   write(&errout, "it's an indentifier")
X    token := next_c
X    while any(&letters ++ &digits ++ '_', next_c := @getchar)
X    do token ||:= next_c
X    return TOK(\reserved_tbl[token], token) | TOK("IDENT", token)
X    
Xend
X
X
X#
X#  do_operator:  coexpression x list      -> TOK record
X#                getchar      x operators -> t
X#
X#      Where getchar is the coexpression that produces the next
X#      character on the input stream, and t is a TOK record
X#      describing the operator just scanned.  Calls recognop, which
X#      creates a DFSA to recognize valid Icon operators.  Arg2
X#      (operators) is the list of lists containing valid Icon operator
X#      string values and names (see above).
X#
Xprocedure do_operator(getchar, operators)
X
X    local token, elem
X
X    token := next_c
X
X    # Go until recognop fails.
X    while elem := recognop(operators, token, 1) do
X	token ||:= (next_c := @getchar)
X#   write(&errout, ximage(elem))
X    if *\elem = 1 then
X	return TOK(elem[1][2], elem[1][1])
X    else fail
X
Xend
X
X
Xrecord dfstn_state(b, e, tbl)
Xrecord start_state(b, e, tbl, master_list)
X#
X#  recognop: list x string x integer -> list
X#            (l, s, i)               -> l2
X#
X#      Where l is the list of lists created by the calling procedure
X#      (each element contains a token string value, name, and
X#      beginner/ender string), where s is a string possibly
X#      corresponding to a token in the list, where i is the position
X#      in the elements of l where the operator string values are
X#      recorded, and where l2 is a list of elements from l that
X#      contain operators for which string s is an exact match.
X#      Fails if there are no operators that s is a prefix of, but
X#      returns an empty list if there just aren't any that happen to
X#      match exactly.
X#
X#      What this does is let the calling procedure just keep adding
X#      characters to s until recognop fails, then check the last list
X#      it returned to see if it is of length 1.  If it is, then it
X#      contains list with the vital stats for the operator last
X#      recognized.  If it is of length 0, then string s did not
X#      contain any recognizable operator.
X#
Xprocedure recognop(l, s, i)
X
X    local   current_state, master_list, c, result, j
X    static  dfstn_table
X    initial dfstn_table := table()
X
X    /i := 1
X    # See if we've created an automaton for l already.
X    /dfstn_table[l] := start_state(1, *l, &null, &null) & {
X	dfstn_table[l].master_list := sortf(l, i)
X    }
X
X    current_state := dfstn_table[l]
X    # Save master_list, as current_state will change later on.
X    master_list   := current_state.master_list
X
X    s ? {
X	while c := move(1) do {
X
X	    # Null means that this part of the automaton isn't
X	    # complete.
X	    #
X	    if /current_state.tbl then
X		create_arcs(master_list, i, current_state, &pos)
X
X	    # If the table has been clobbered, then there are no arcs
X	    # leading out of the current state.  Fail.
X	    #
X	    if current_state.tbl === 0 then
X		fail
X	    
X#	    write(&errout, "c = ", image(c))
X#	    write(&errout, "table for current state = ", 
X#		  ximage(current_state.tbl))
X
X	    # If we get to here, the current state has arcs leading
X	    # out of it.  See if c is one of them.  If so, make the
X	    # node to which arc c is connected the current state.
X	    # Otherwise fail.
X	    #
X	    current_state := \current_state.tbl[c] | fail
X	}
X    }
X
X    # Return possible completions.
X    #
X    result := list()
X    every j := current_state.b to current_state.e do {
X	if *master_list[j][i] = *s then
X	    put(result, master_list[j])
X    }
X    # return empty list if nothing the right length is found
X    return result
X
Xend
X
X
X#
X#  create_arcs:  fill out a table of arcs leading out of the current
X#                state, and place that table in the tbl field for
X#                current_state
X#
Xprocedure create_arcs(master_list, field, current_state, POS)
X
X    local elem, i, first_char, old_first_char
X
X    current_state.tbl := table()
X    old_first_char := ""
X    
X    every elem := master_list[i := current_state.b to current_state.e][field]
X    do {
X	
X	# Get the first character for the current position (note that
X	# we're one character behind the calling routine; hence
X	# POS-1).
X	#
X	first_char := elem[POS-1] | next
X	
X	# If we have a new first character, create a new arc out of
X	# the current state.
X	#
X	if first_char ~== old_first_char then {
X	    # Store the start position for the current character.
X	    current_state.tbl[first_char] := dfstn_state(i)
X	    # Store the end position for the old character.
X	    (\current_state.tbl[old_first_char]).e := i-1
X	    old_first_char := first_char
X	}
X    }
X    (\current_state.tbl[old_first_char]).e := i
X
X    # Clobber table with 0 if no arcs were added.
X    current_state.tbl := (*current_state.tbl = 0)
X    return current_state
X
Xend
SHAR_EOF
echo 'File itokens.icn is complete' &&
true || echo 'restore of itokens.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= debugme.icn ==============
if test -f 'debugme.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping debugme.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting debugme.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'debugme.icn' &&
Xlink structs
X
X#
X# dump_lists:  file x list x list -> (null)
X#              (f, gl, al)        -> (null)
X#
X#     Where f is an open file, gl is the goto list, and al is the
X#     action list.  Writes to file f a human-readable dump of the goto
X#     and action list.
X#
Xprocedure dump_lists(f, al, gl)
X
X    local TAB, look_list, red_list, i, sym, act
X
X    TAB := "\t"
X    look_list := list()
X    red_list := list()
X
X    every i := 1 to *al do {
X	every INSERT(look_list, key(\al[i]))
X	if /al[i] then
X	    write(&errout, "dump_lists:  warning!  state ", i, " is null")
X    }
X
X    writes(f, TAB)
X    every i := 1 to *look_list do
X	writes(f, look_list[i], TAB)
X    write(f)
X    every i := 1 to *al do {
X	writes(f, i, TAB)
X	act := ""
X	every sym := !look_list do {
X	    if \al[i][sym] then {
X		# al[i][sym][1] will fail for the accept action; hence
X		# the "".  Otherwise al[i][sym][1] selects that state
X		# field of a SH or RE record.
X		writes(f, map(type(al[i][sym])), al[i][sym][1] | "")
X		if type(al[i][sym]) == "RE" then {
X		    INSERT(red_list, al[i][sym].sym)
X		    writes(f, al[i][sym].sym)
X		}
X	    }
X	    writes(f,TAB)
X	}
X	write(f)
X    }
X    write(f)
X
X    writes(f, TAB)
X    every i := 1 to *red_list do
X	writes(f, red_list[i], TAB)
X    write(f)
X    every i := 1 to *gl do {
X	writes(f, i, TAB)
X	act := ""
X	every sym := !red_list do {
X	    if \(\gl[i])[sym] then
X		writes(f, gl[i][sym])
X	    writes(f, TAB)
X	}
X	write(f)
X    }
X
Xend
X
X#
X# INSERT:  set or list x record -> set or list
X# 	   (sset, rec)          -> sset
X#
X#     Where sset is a homogenous set or list of records, rec is a
X#     record, and the return value is sset, with rec added, iff an
X#     equivalent record was not there already.  Otherwise, sset is
X#     returned unchanged. INSERT(), _unlike insert(), FAILS IF REC
X#     IS ALREADY PRESENT IN SSET.
X#
X#     This procedure is used by dump_lists() above.  If you delete
X#     dump_lists(), delete this as well, as also Equiv() below.
X#
Xprocedure INSERT(sset, rec)
X
X    local addto, Eq
X    #
X    # Decide how to add members to sset, depending on its type.
X    #
X	case type(sset) of {
X	    "set"   : { addto := insert; Eq := equiv }
X	    "list"  : { addto := put; Eq := Equiv }
X	    default : stop("INSERT:  wrong type argument (",type(sset),")")
X	}
X
X    # Rudumentary error check to be sure the object to be inserted
X    # into sset is of the same time as the objects already there.
X    #
X    if *sset > 0 then
X	type(rec) == type(sset[1]) |
X	    stop("INSERT:  unexpected type difference")
X
X    #
X    # If a rec-like item isn't in sset, add it to sset.
X    #
X    if Eq(!sset, rec) then fail
X    else return addto(sset, rec)
X
Xend
X	
X
X#
X# Equiv: struct x struct -> struct
X#        (x1, x2)        -> x2
X#
X#     Where x1 and x2 are arbitrary structures.  Returns x2 if x1 and
X#     x2 are structurally equivalent (even if not identical).  Taken
X#     from the IPL file "structs.icn," and gutted so that it assumes
X#     all structures are "ordered" (i.e. not sets or tables).  Has no
X#     way of handling procedures or files, either.  (Pretty limited,
X#     huh?)
X#
Xprocedure Equiv(x1, x2, done)
X
X   local code, i
X
X   if x1 === x2 then return x2		# Covers everything but structures.
X   if type(x1) ~== type(x2) then fail	# Must be same type.
X   if *x1 ~= *x2 then fail
X
X   image(x1) ? (code := (="record" | type(x1)))
X   case code of {
X       "list" | "record"    :
X	   every i := *x1 to 1 by -1 do
X	       Equiv(x1[i],x2[i]) | fail
X       "set" | "table"      : stop("error:  Equiv used (wrongly) for equiv.")
X       "procedure" | "file" : stop("error:  Equiv used (wrongly) for equiv.")
X       default              : fail
X   }
X   return x2
X
Xend
SHAR_EOF
true || echo 'restore of debugme.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= errors.icn ==============
if test -f 'errors.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping errors.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting errors.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'errors.icn' &&
X#
X# oh_no:  print error message to stderr & abort
X#
Xprocedure oh_no(s, n)
X
X    local i, msg
X    static errlist
X    initial {
X        errlist := [[1,  "malformed LHS"],
X		    [2,  "unexpected termination of right-hand side"],
X                    [3,  "missing left parenthesis"],
X                    [4,  "malformed start_symbol declaration"],
X                    [5,  "unexpected end of input"],
X		    [6,  "invalid symbol spec in right-hand side"],
X                    [7,  "rule declaration within another rule"],
X		    [8,  "procedure declaration within a rule"],
X                    [9,  "unmatched left parenthesis"],
X                    [10, "mangled right-hand side"],
X		    [11, "missing priority"],
X		    [12, "missing associativity"],
X
X		    [50, "illegal conflict for nonassociative rules"],
X		    [51, "reduce/reduce conflict"],
X		    [52, "symbol lacks termination in the grammar"]
X                   ]
X    }
X    every i := 1 to *errlist do
X        if errlist[i][1] = n then msg := errlist[i][2]
X    writes(&errout, "error ", n, " (", msg, ")")
X    if \s then {
X	write(&errout, ":  ")
X	every write("\t", rewrap(s) | rewrap())
X    }
X    else write(&errout, "")
X    exit(n)
X
Xend
SHAR_EOF
true || echo 'restore of errors.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= slashupto.icn ==============
if test -f 'slashupto.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping slashupto.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting slashupto.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'slashupto.icn' &&
X############################################################################
X#
X#	Name:	 slashupto.icn
X#
X#	Title:	 slashupto (upto with backslash escaping)
X#
X#	Author:	 Richard L. Goerwitz
X#
X#	Version: 1.2
X#
X############################################################################
X#
X#  Slashupto works just like upto, except that it ignores backslash
X#  escaped characters.  I can't even begin to express how often I've
X#  run into problems applying Icon's string scanning facilities to
X#  to input that uses backslash escaping.  Normally, I tokenize first,
X#  and then work with lists.  With slashupto() I can now postpone or
X#  even eliminate the traditional tokenizing step, and let Icon's
X#  string scanning facilities to more of the work.
X#
X#  If you're confused:
X#
X#  Typically UNIX utilities (and probably others) use backslashes to
X#  "escape" (i.e. remove the special meaning of) metacharacters.  For
X#  instance, UNIX shells normally accept "*" as a shorthand for "any
X#  series of zero or more characters.  You can make the "*" a literal
X#  "*," with no special meaning, by prepending a backslash.  The rou-
X#  tine slashupto() understands these backslashing conventions.  You
X#  can use it to find the "*" and other special characters because it
X#  will ignore "escaped" characters.
X#
X############################################################################
X#
X#  Links: none
X#
X#  See also: slashbal.icn
X#
X############################################################################
X
X#
X# slashupto:  cset x string x integer x integer -> integers
X#             (c, s, i, j) -> Is (a generator)
X#    where Is are the integer positions in s[i:j] before characters
X#    in c that is not preceded by a backslash escape
X#
Xprocedure slashupto(c, s, i, j)
X
X    if /s := &subject
X    then /i := &pos
X    else /i := 1
X    /j := *s + 1
X    
X    /c := &cset
X    c ++:= '\\'
X    s[1:j] ? {
X        tab(i)
X        while tab(upto(c)) do {
X            if ="\\" then {
X		move(1)
X		next
X	    }
X            suspend .&pos
X            move(1)
X        }
X    }
X
Xend
X
SHAR_EOF
true || echo 'restore of slashupto.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= rewrap.icn ==============
if test -f 'rewrap.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping rewrap.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting rewrap.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'rewrap.icn' &&
X############################################################################
X#
X#	Name:	 rewrap.icn
X#
X#	Title:	 advanced line rewrap utility
X#
X#	Author:	 Richard L. Goerwitz
X#
X#	Version: 1.4
X#
X############################################################################
X#
X#  The procedure rewrap(s,i), included in this file, reformats text
X#  fed to it into strings < i in length.  Rewrap utilizes a static
X#  buffer, so it can be called repeatedly with different s arguments,
X#  and still produce homogenous output.  This buffer is flushed by
X#  calling rewrap with a null first argument.  The default for
X#  argument 2 (i) is 70.
X#
X#  Here's a simple example of how rewrap could be used.  The following
X#  program reads the standard input, producing fully rewrapped output.
X#
X#  procedure main()
X#      every write(rewrap(!&input))
X#      write(rewrap())
X#  end
X#
X#  Naturally, in practice you would want to do things like check for in-
X#  dentation or blank lines in order to wrap only on a paragraph-by para-
X#  graph basis, as in
X#
X#  procedure main()
X#      while line := read(&input) do {
X#          if line == "" then {
X#              write("" ~== rewrap())
X#              write(line)
X#          } else {
X#              if match("\t", line) then {
X#                  write(rewrap())
X#                  write(rewrap(line))
X#              } else {
X#                  write(rewrap(line))
X#              }
X#          }
X#      }
X#  end
X#
X#  Fill-prefixes can be implemented simply by prepending them to the
X#  output of rewrap:
X#
X#      i := 70; fill_prefix := " > "
X#      while line := read(input_file) do {
X#          line ?:= (f_bit := tab(many('> ')) | "", tab(0))
X#          write(fill_prefix || f_bit || rewrap(line, i - *fill_prefix))
X#          etc.
X#
X#  Obviously, these examples are fairly simplistic.  Putting them to
X#  actual use would certainly require a few environment-specific
X#  modifications and/or extensions.  Still, I hope they offer some
X#  indication of the kinds of applications rewrap might be used in.
X# 
X#  Note:  If you want leading and trailing tabs removed, map them to
X#  spaces first.  Rewrap only fools with spaces, leaving tabs intact.
X#  This can be changed easily enough, by running its input through the
X#  Icon detab() function.
X#
X############################################################################
X#
X#  See also:  wrap.icn
X#
X############################################################################
X
X
Xprocedure rewrap(s,i)
X
X    local extra_bit, line
X    static old_line
X    initial old_line := ""
X
X    # Default column to wrap on is 70.
X    /i := 70
X    # Flush buffer on null first argument.
X    if /s then {
X	extra_bit := old_line
X	old_line := ""
X	return "" ~== extra_bit
X    }
X
X    # Prepend to s anything that is in the buffer (leftovers from the last s).
X    s ?:= { tab(many(' ')); old_line || trim(tab(0)) }
X
X    # If the line isn't long enough, just add everything to old_line.
X    if *s < i then old_line := s || " " & fail
X
X    s ? {
X
X	# While it is possible to find places to break s, do so.
X	while any(' -',line := EndToFront(i),-1) do {
X	    # Clean up and suspend the last piece of s tabbed over.
X	    line ?:= (tab(many(' ')), trim(tab(0)))
X            if *&subject - &pos + *line > i
X	    then suspend line
X	    else {
X		old_line := ""
X		return line || tab(0)
X	    }
X	}
X
X	# Keep the extra section of s in a buffer.
X	old_line := tab(0)
X
X	# If the reason the remaining section of s was unrewrapable was
X	# that it was too long, and couldn't be broken up, then just return
X	# the thing as-is.
X	if *old_line > i then {
X	    old_line ? {
X		if extra_bit := tab(upto(' -')+1) || (tab(many(' ')) | "")
X		then old_line := tab(0)
X		else extra_bit := old_line & old_line := ""
X		return trim(extra_bit)
X	    }
X	}
X	# Otherwise, clean up the buffer for prepending to the next s.
X	else {
X	    # If old_line is blank, then don't mess with it.  Otherwise,
X	    # add whatever is needed in order to link it with the next s.
X	    if old_line ~== "" then {
X		# If old_line ends in a dash, then there's no need to add a
X		# space to it.
X		if old_line[-1] ~== "-"
X		then old_line ||:= " "
X	    }
X	}
X    }
X    
Xend
X
X
X
Xprocedure EndToFront(i)
X    # Goes with rewrap(s,i)
X    *&subject+1 - &pos >= i | fail
X    suspend &subject[.&pos:&pos <- &pos+i to &pos by -1]
Xend
SHAR_EOF
true || echo 'restore of rewrap.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= strip.icn ==============
if test -f 'strip.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping strip.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting strip.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'strip.icn' &&
X############################################################################
X#
X#	Name:	 strip.icn
X#
X#	Title:	 strip characters from a string
X#
X#	Author:	 Richard L. Goerwitz
X#
X#	Version: 1.1
X#
X############################################################################
X#  
X#  strip(s,c)    - strip characters c from string s
X#
X############################################################################
X#
X#  Links: none
X#
X############################################################################
X
X
Xprocedure strip(s,c)
X
X    # Return string s stripped of characters c.  Succeed whether
X    # any characters c were found in s or not.
X
X    local s2
X
X    s2 := ""
X    s ? {
X	while s2 ||:= tab(upto(c))
X	do tab(many(c))
X	s2 ||:= tab(0)
X    }
X
X    return s2
X
Xend
SHAR_EOF
true || echo 'restore of strip.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= Makefile.dist ==============
if test -f 'Makefile.dist' -a X"$1" != X"-c"; then
	echo 'x - skipping Makefile.dist (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting Makefile.dist (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Makefile.dist' &&
X############################################################################
X#
X#	Name:	 %M%
X#
X#	Title:	 public makefile for IBPAG
X#
X#	Author:	 Richard L. Goerwitz
X#
X#	Version: %I%
X#
X############################################################################
X
X#
X# Change this only if you have some bizzarre naming conflict (which is
X# very unlikely, given the quirky name!).
X#
XPROGNAME = ibpag
X
X
X##########################################################################
X#
X#  User-modifiable section.  Read carefully!  You will almost
X#  certainly have to change some settings here.
X#
X
X#
X# Destination directory for binaries.  Owner and group for public
X# executables.  Leave the trailing slash off of directory name.
X#
X# DESTDIR = $(HOME)/bin
XDESTDIR = /usr/local/bin
X# OWNER = me
XOWNER = root
X# GROUP = my_group
XGROUP = root
X
X#
X# Name of your icon compiler and compiler flags.
X#
XICONC = /usr/icon/v8/bin/icont
X# ICONC = /usr/icon/v8/bin/iconc
X
X#
X# If you get messages like "out of X table space," then you have
X# version 8.0 or less of the interpreter, and will need to adjust the
X# various internal tables manually with -S arguments.  See the icont
X# documentation.  Otherwise, no flags are strictly necessary.
X#
XIFLAGS = -u
X
X#
X# Change these only if you're pretty sure of what you're doing.
X#
XSHELL = /bin/sh
XMAKE = make
X
X
X###########################################################################
X#
X#  Don't change anything below this line.
X#
X
XSRC = $(PROGNAME).icn maketbls.icn preproc.icn itokens.icn debugme.icn \
X	errors.icn slashupto.icn rewrap.icn strip.icn
X
X#
X# Main target
X#
Xall: $(PROGNAME)
X
X$(PROGNAME): $(SRC)
X	$(ICONC) $(IFLAGS) -o $(PROGNAME) $(SRC)
X
X#
X# Cleanup
X#
Xclean:
X	rm -f core *.u1 *.u2
X
Xclobber: clean
X	-rm -f $(PROGNAME) *~
SHAR_EOF
true || echo 'restore of Makefile.dist failed'
rm -f _shar_wnt_.tmp
fi
rm -f _shar_seq_.tmp
echo You have unpacked the last part
exit 0
-- 

   -Richard L. Goerwitz              goer%midway@uchicago.bitnet
   goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer