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