![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rsg.icn CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / port|
Return to rsg.icn CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / port |
1.1 root 1: # This program generates randomly selected sentences from
2: # user-specified grammars. It is an extension of a program
3: # given in Chapter 20 of the Icon book and is included in
4: # the Icon program library.
5:
6: global defs, ifile, in, limit, tswitch, prompt
7: record nonterm(name)
8: record charset(chars)
9: record query(name)
10: procedure main(x)
11: local line, plist
12: plist := [define,generate,grammar,source,comment,prompter,error]
13: defs := table()
14: defs["lb"] := [["<"]]
15: defs["rb"] := [[">"]]
16: defs["vb"] := [["|"]]
17: defs["nl"] := [["\n"]]
18: defs[""] := [[""]]
19: defs["&lcase"] := [[charset(&lcase)]]
20: defs["&ucase"] := [[charset(&ucase)]]
21: defs["&digit"] := [[charset('0123456789')]]
22: i := 0
23: while i < *x do {
24: s := x[i +:= 1] | break
25: case s of {
26: "-t": tswitch := 1
27: "-l": limit := integer(x[i +:= 1]) | stop("usage: [-t] [-l n]")
28: default: stop("usage: [-t] [-l n]")
29: }
30: }
31: ifile := [&input]
32: prompt := ""
33: while in := pop(ifile) do {
34: repeat {
35: if *prompt ~= 0 then writes(prompt)
36: line := read(in) | break
37: while line[-1] == "\\" do line := line[1:-1] || read(in) | break
38: (!plist)(line)
39: }
40: close(in)
41: }
42: end
43:
44: procedure comment(line)
45: if line[1] == "#" then return
46: end
47:
48: procedure define(line)
49: return line ?
50: defs[(="<",tab(find(">::=")))] := (move(4),alts(tab(0)))
51: end
52:
53: procedure defnon(sym)
54: if sym ? {
55: ="'" &
56: chars := cset(tab(-1)) &
57: ="'"
58: }
59: then return charset(chars)
60: else if sym ? {
61: ="?" &
62: name := tab(0)
63: }
64: then return query(name)
65: else return nonterm(sym)
66: end
67:
68: procedure error(line)
69: write("*** erroneous line: ",line)
70: return
71: end
72:
73: procedure gener(goal)
74: local pending, genstr, symbol
75: repeat {
76: pending := [nonterm(goal)]
77: genstr := ""
78: while symbol := get(pending) do {
79: if \tswitch then write(&errout,genstr,symimage(symbol),listimage(pending))
80: case type(symbol) of {
81: "string": genstr ||:= symbol
82: "charset": genstr ||:= ?symbol.chars
83: "query": {
84: writes("*** supply string for ",symbol.name," ")
85: genstr ||:= read() | {
86: write(&errout,"*** no value for query to ",symbol.name)
87: suspend genstr
88: break next
89: }
90: }
91: "nonterm": {
92: pending := ?\defs[symbol.name] ||| pending | {
93: write(&errout,"*** undefined nonterminal: <",symbol.name,">")
94: suspend genstr
95: break next
96: }
97: if *pending > \limit then {
98: write(&errout,"*** excessive symbols remaining")
99: suspend genstr
100: break next
101: }
102: }
103: }
104: }
105: suspend genstr
106: }
107: end
108:
109: procedure generate(line)
110: local goal, count
111: if line ? {
112: ="<" &
113: goal := tab(upto('>')) \ 1 &
114: move(1) &
115: count := (pos(0) & 1) | integer(tab(0))
116: }
117: then {
118: every write(gener(goal)) \ count
119: return
120: }
121: else fail
122: end
123:
124: procedure getrhs(a)
125: local rhs
126: rhs := ""
127: every rhs ||:= sform(!a) || "|"
128: return rhs[1:-1]
129: end
130:
131: procedure grammar(line)
132: local file, out
133: if line ? {
134: name := tab(find("->")) &
135: move(2) &
136: file := tab(0) &
137: out := if *file = 0 then &output else {
138: open(file,"w") | {
139: write(&errout,"*** cannot open ",file)
140: fail
141: }
142: }
143: }
144: then {
145: (*name = 0) | (name[1] == "<" & name[-1] == ">") | fail
146: pwrite(name,out)
147: if *file ~= 0 then close(out)
148: return
149: }
150: else fail
151: end
152:
153: procedure listimage(a)
154: local s, x
155: s := ""
156: every x := !a do
157: s ||:= symimage(x)
158: return s
159: end
160:
161: procedure alts(defn)
162: local alist
163: alist := []
164: defn ? while put(alist,syms(tab(many(~'|')))) do move(1)
165: return alist
166: end
167:
168: procedure prompter(line)
169: if line[1] == "=" then {
170: prompt := line[2:0]
171: return
172: }
173: end
174:
175: procedure pwrite(name,ofile)
176: local nt, a
177: static builtin
178: initial builtin := ["lb","rb","vb","nl","","&lcase","&ucase","&digit"]
179: if *name = 0 then {
180: a := sort(defs)
181: every nt := !a do {
182: if nt[1] == !builtin then next
183: write(ofile,"<",nt[1],">::=",getrhs(nt[2]))
184: }
185: }
186: else write(ofile,name,"::=",getrhs(\defs[name[2:-1]])) |
187: write("*** undefined nonterminal: ",name)
188: end
189:
190: procedure sform(alt)
191: local s, x
192: s := ""
193: every x := !alt do
194: s ||:= case type(x) of {
195: "string": x
196: "nonterm": "<" || x.name || ">"
197: "charset": "<'" || x.chars || "'>"
198: }
199: return s
200: end
201:
202: procedure source(line)
203: return line ? (="@" & push(ifile,in) & {
204: in := open(file := tab(0)) | {
205: write(&errout,"*** cannot open ",file)
206: fail
207: }
208: })
209: end
210:
211: procedure symimage(x)
212: return case type(x) of {
213: "string": x
214: "nonterm": "<" || x.name || ">"
215: "charset": "<'" || x.chars || "'>"
216: }
217: end
218:
219: procedure syms(alt)
220: local slist
221: slist := []
222: alt ? while put(slist,tab(many(~'<')) |
223: defnon(2(="<",tab(upto('>')),move(1))))
224: return slist
225: end
226:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.