|
|
1.1 root 1: # GSET(1)
2: #
3: # Perform set operations on file specifications
4: #
5: # Thomas R. Hicks
6: #
7: # Last modified 8/23/84
8: #
9:
10: procedure main(args)
11: local i, fyls, arglist
12: if *args = 0 then return
13: if *args > 1 then
14: every i := 2 to *args do
15: args[1] ||:= (" " || args[i])
16: (arglist := parse(args[1])) |
17: stop("Invalid file specification expression")
18: case type(arglist) of {
19: "string" : fyls := mkflst(arglist)
20: "list" : fyls := exec(arglist)
21: default : stop("Main: bad type -can't happen")
22: }
23: fyls := sort(fyls)
24: every write(!fyls," ")
25: end
26:
27: procedure Exp() # file spec expression parser
28: local a
29: suspend (a := [Factor(),=Op(),Factor()] & [a[2],a[1],a[3]]) |
30: Factor() |
31: (a := [="(",Exp(),=")"] & .a[2])
32: end
33:
34: procedure Factor() # file spec expression parser
35: local a
36: suspend (a := [Term(),=Op(),Term()] & [a[2],a[1],a[3]]) |
37: Term() |
38: (a := [="(",Factor(),=")"] & .a[2])
39: end
40:
41: procedure Name() # file spec name matcher
42: static valid
43: initial valid := ~'()'
44: suspend (any(~valid) || fail) | tab(find(Op()) | many(valid))
45: end
46:
47: procedure Non() # file spec expression parser
48: local a
49: suspend a := [Name(),=Op(),Name()] & [a[2],a[1],a[3]]
50: end
51:
52: procedure Op() # file spec operation matcher
53: suspend !["++","--","&&"]
54: end
55:
56: procedure Term() # file spec expression parser
57: local a
58: suspend (a := [="(",Non(),=")"] & .a[2]) |
59: Name()
60: end
61:
62: procedure bldflst(arg) # build file list
63: local line
64: line := read(open("echo " || arg,"rp"))
65: return str2lst(line,' ')
66: end
67:
68: procedure exec(lst) # recurseively process file spec list
69: return setops(lst[1])(exec2(lst[2]),exec2(lst[3]))
70: end
71:
72: procedure exec2(arg) # helping procedure for exec
73: case type(arg) of {
74: "string" : return mkflst(arg)
75: "list" : return exec(arg)
76: default : stop("exec2: can't happen")
77: }
78: end
79:
80: procedure lstlu(key,lst) # lookup key string at top level of list
81: local v
82: every v := !lst do
83: if key == v then return
84: fail
85: end
86:
87: procedure mkflst(fspec) # make file list using file specification
88: if fspec == "*" then
89: fspec := "* .*"
90: return uniq(bldflst(fspec))
91: end
92:
93: procedure parse(str) # top level of parsing procedures
94: local res
95: str ? (res := Exp() & pos(0)) | fail
96: return res
97: end
98:
99: procedure sdiff(f1,f2) # set difference
100: local a, x
101: a := []
102: if *f1 = 0 then return a
103: if *f2 = 0 then return copy(f1)
104: every x := !f1 do
105: if not lstlu(x,f2) then put(a,x)
106: return a
107: end
108:
109: procedure setops(op) # return correct set operation procedure
110: case op of {
111: "++" : return sunion
112: "&&" : return sinter
113: "--" : return sdiff
114: }
115: end
116:
117: procedure sinter(f1,f2) # set intersection
118: local a, x
119: a := []
120: if (*f1 | *f2) = 0 then return a
121: if *f1 < *f2 then {
122: every x := !f1 do
123: if lstlu(x,f2) then put(a,x)
124: }
125: else {
126: every x := !f2 do
127: if lstlu(x,f1) then put(a,x)
128: }
129: return a
130: end
131:
132: procedure str2lst(str,delim) # convert delimited string into a list
133: local lst, f
134: lst := []
135: str ? {
136: while f := (tab(upto(delim))) do {
137: put(lst,f)
138: move(1)
139: }
140: if "" ~== (f := tab(0)) then
141: put(lst,f)
142: }
143: return lst
144: end
145:
146: procedure sunion(f1,f2) # set union
147: local a, x
148: a := []
149: if *f1 = 0 then return copy(f2)
150: if *f2 = 0 then return copy(f1)
151: if *f1 < *f2 then {
152: every put(a,!f2)
153: every x := !f1 do
154: if not lstlu(x,f2) then put(a,x)
155: }
156: else {
157: every put(a,!f1)
158: every x := !f2 do
159: if not lstlu(x,f1) then put(a,x)
160: }
161: return a
162: end
163:
164: procedure uniq(lst) # remove duplicates, filtering out . and ..
165: local t, a, x
166: t := table()
167: every x := !lst do
168: if (x ~== "." & x ~== "..") then
169: t[x] := x
170: a := []
171: every put(a,!t)
172: return a
173: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.