Appendix - An Intermediate Representation for Lexical Analysis.
<word-line.icn>=
record word_line(file, line, column, word)
procedure put_word_line(ofl, wl)
(type(wl) == "word_line") |
stop("illegal put_word_line(" || type(wl) || ") call.")
write(ofl, wl.file, " ", wl.line, " ", wl.column, " ", wl.word)
return
end # put_word_line
procedure get_word_line(ifl)
local wl, line
(line := read(ifl)) | fail
wl := word_line()
line ? {
wl.file := tab(upto(' ')) & move(1)
wl.line := tab(upto(' ')) & move(1)
wl.column := tab(many('012345678'))
wl.word := if tab(many(' ')) then tab(0) else ""
}
return wl
end # get_word_line
<wordify.icn>=
define ws ' \t'
procedure main(args)
if *args > 0
then every print_words(!args)
else print_words()
end # main
procedure print_words(fname)
local current_line, wl, inf
if \fname then {
if not(inf := open(fname)) then {
write(&error, "Can't open \"", fname, "\".")
return
}
}
else {
inf := &input
fname := "<stdin>"
}
current_line := ""
wl := word_line()
wl.file := fname
wl.line := 0
wl.column := 1
repeat {
current_line ?
(wl.column +:= *tab(many(ws)) & (current_line := tab(0)))
if current_line ? pos(0) then
if current_line := read(inf) || " "
then {
wl.line +:= 1
wl.column := 1
next
}
else break
current_line ? ((wl.word := tab(upto(ws) | 0)) & (current_line := tab(0)))
put_word_line(&output, wl)
wl.column +:= *wl.word
}
if inf === &input then close(inf)
end # get_word
<fixword.icn>=
define alnum (&lcase ++ '0123456789')
link options
procedure main(args)
local wl, stop_words, skipped, mark_missing
opts := options(args, "-mm!", badopt)
stop_words := set(
["the", "to", "and", "all", "and", "are", "as", "be", "by", "for", "from",
"in", "is", "of", "on", "shall", "this", "used", "via", "will", "also",
"or", "an", "with", "no", "if", "that", "was", "when", "you", "that",
"it", "which"])
while wl := get_word_line(&input) do {
wl.word := map(wl.word, &ucase, &lcase)
wl.word ?
(pre := tab(upto(alnum)) & (wl.word := tab(0)) & (wl.column +:= *pre))
reverse(wl.word) ? (tab(upto(alnum)) & (wl.word := reverse(tab(0))))
if (*wl.word > 1) & (wl.word ? upto(&lcase)) & not(member(stop_words, wl.word))
then {
\opts["mm"] & put_word_line(&output, \skipped) & (skipped := &null)
put_word_line(&output, wl)
}
else {
skipped := wl
skipped.word := ""
}
}
end # main
procedure badopt(e)
write(&errout, e, ". Known options are")
write(&errout, " -mm - mark missing words with a blank word.")
exit(1)
end # bopt
<countwords.icn>=
link options
procedure main(args)
local words, w, gsize
opts := options(args, "-gs:", badopt)
words := table(0)
gsize := (\opts["gs"] | 1)
q_init(gsize)
while w := get_word_line() do
if *w.word = 0
then q_reset()
else {
q_push(w.word)
if q_size() = gsize then words[q_string()] +:= 1
}
every w := !sort(words) do
write(right(w[2], 4), " ", w[1])
end # main
global queue, queue_max_size
procedure q_init(q_size)
queue_max_size := q_size;
queue := []
end # q_init
procedure q_reset()
queue := []
end # q_reset
procedure q_size()
return *queue
end # q_size
procedure q_push(wd)
put(queue, wd)
if *queue > queue_max_size then get(queue)
end # q_push
procedure q_string()
local s, sep
sep := ""
s := ""
every s ||:= sep || !queue do sep := " "
return s
end # q_string
procedure badopt(e)
write(&errout, e, ". Known options are")
write(&errout, " -gs - count groups of n words.")
exit(1)
end # badopt
<concordance.icn>=
record pageref(no, cnt)
procedure main()
local words, word, page, w, pn
words := table(set([]))
page := pageref()
while w := get_word_line() do
words[w.word] ++:= set([w])
every w := !sort(words) do {
sep := " "
writes(w[1], ": ")
every p := !w[2] do {
writes(sep, p.file, " ", p.line, " ", p.column)
sep := ", "
}
write("")
}
end # main
<make-nouns.icn>=
procedure main()
local g, w
while g := read_word_group() do {
w := ""
every w ||:= (!g).word || " "
write(w)
}
end # main
procedure read_word_group()
static last_line
local g, lno
/last_line := (get_word_line() | fail)
while *(last_line.word) = 0 do (last_line := get_word_line()) | fail
lno := last_line.line
g := []
repeat {
put(g, last_line)
(last_line := get_word_line()) | break
if *(last_line.word) = 0 then {
last_line := &null
break
}
if (last_line.line > lno + 1) then break
if last_line.line = lno + 1
then if last_line.column > 1
then break
else lno +:= 1
}
return g
end # read_word_group