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