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