* title snobol test program #7 -- symbol table generator
*
*	 this program demonstrates the storage of symbol tables
*	 using a techique in which names are stored as linked lists
*	 of characters.	the data function is used to form the
*	 required nodes	which contain appropriate pointers to be
*	 used on failure or success of the character by	character match
*
	 data('symb(char,link,alt,assoc,succ)')
	 input(.input,,72)
	 spc = '     ::'
	 alph =	"abcdefghijklmnopqrstuvwxyz"
clear	 head =
	 switch1 = .first
	 x = 0
reada	 output	=
read	 card =	trim(input)			 :f(end1)
	 output	= card
	 differ(card)				 :f(badcard)
	 card pos(0) '$' =			 :s(control)
	 card notany(alph)			 :f(incx)
badcard	 output	= '  card above	is illegal'	 :(read)
incx	 x = x + 1				 :($switch1)
first	 switch1 = .search
f1	 card len(1) . ch =			 :f(err)
	 head =	symb(ch)
	 current = head
f2	 card len(1) . ch =			 :f(insert)
f3	 succ(current) = symb(ch,current)
	 current = succ(current)		 :(f2)
insert	 assoc(current)	= assoc(current) x ","	 :(read)
search	 card len(1) . ch =			 :f(err)
	 lgt(char(head), ch)			 :s(s7)
	 ident(char(head),ch)			 :s(s5)
*
*  first character of head is <	first char of char just	read
*  if alt(head)	null then must extend structure
*
	 ident(alt(head))			 :s(s3)
	 current = alt(head)
s1	 lgt(char(current),ch)			 :s(s6)
	 ident(char(current),ch)		 :s(s4)
	 ident(alt(current))			 :s(s2)
	 current = alt(current)			 :(s1)
*
*  new alternative must	be inserted at end
*
s2	 alt(current) =	symb(ch,current)
*
*  then	rest of	word strung out
*
	 current = alt(current)			 :(f2)
*
*  new alternative must	be inserted at head of list
*
s3	 alt(head) = symb(ch,head)
	 current = alt(head)			 :(f2)
-eject
*
*  character has been found. now look at next hcaracter	of word
*
s4	 card len(1) . ch  =			 :f(insert)
*  if no successors, string out	rest of	word
*
	 ident(succ(current))			 :s(f3)
*
*  otherwise continue examination
*
	 current = succ(current)		 :(s1)
s5	 current = head				 :(s4)
*
*  char	is smaller than	current	alternative
*
s6	 y = link(current)
	 alt(y)	= ident(alt(y),current)	symb(ch,y)	   :f(s6a)
	 y = alt(y)				 :(s6b)
s6a	 succ(y) = symb(ch,y)
	 y = succ(y)
s6b	 alt(y)	= current
	 link(current) = y
	 current = y				 :(f2)
*
*  new alternative must	be linked to head, at top of list
*
s7	 y = head
	 head =	symb(ch)
	 link(y) = head
	 alt(head) = y
	 current = head				 :(f2)
control	 ident(card,"*")			 :f(c1)
	 output	=
	 output	= '  (structure	is cleared)'
	 output	=				 :(clear)
c1	 ident(card,'$')			 :f(c2)
	 output	=
	 output	= '  (printout of entire structure follows...)'
	 output	=
	 ident(head)				 :s(c4)
	 hold =
	 start = head				 :(listem)
c2	 ident(card)				 :s(badcard)
	 card notany(alph)			 :s(badcard)
-eject
*
*  here	to print words starting	with specified head
*
	 output	=
	 output	= '  (printout of all words beginning with "'
+	   card	'"...)'
	 output	=
	 hold =	card
	 current = head
	 card len(1) . ch =
c3	 ident(char(current),ch)		 :s(next)
	 current = alt(current)
	 ident(current)				 :f(c3)
c4	 output	= '  (no words)'		 :(reada)
next	 card len(1) . ch =			 :f(setup)
	 current = succ(current)
	 ident(current)				 :s(c4)f(c3)
setup	 output	= differ(assoc(current)) spc hold '  ' assoc(current)
	 start = differ(succ(current)) succ(current)  :f(c4)
listem	 n = 0
	 current = start
l1	 hold =	hold char(current)
l2	 output	= differ(assoc(current)) spc hold '  ' assoc(current)
	 current = differ(succ(current)) succ(current)	:s(l1)
backup	 current = differ(alt(current))	alt(current)  :f(b1)
	 n = n + 1
	 $('stack' n) =	link(current)
	 hold len(1) rpos(0) = char(current)	 :(l2)
b1	 y = link(current)
	 ident(y)				 :s(reada)
	 ident(y,start)	ident(alt(y),current)	 :s(reada)
	 ident(y,start)	ident(alt(y))		 :s(reada)
	 current = y
	 hold differ($('stack' n),y)  len(1) rpos(0) =	:s(backup)
	 n = n - 1				 :(b1)
end1	 output	=
	 output	= '(all	data processed)'
end
abc
abcd
abcde
bcdef
$$
$*
elastic
happily
box
fox
cars
gaiters
all
dump
june
in
$$
$*
sister
susie
sells
sea
shells
by
the
sea
shore
$$
$s
$sh
some
sea
shells
send
sailors
swimming
$$
$s
$se
$*
$$
cattle
carp
cat
gorge
monster
money
car
dog
metal
cave
cake
cat
$$
$mon
$m
$c
$ca
$cat
$catt
$cax
$$