Annotation of 43BSD/contrib/icon/src/cmd/gset.icn, revision 1.1.1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.