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