Return to gset.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / cmd

Annotation of 43BSD/contrib/icon/src/cmd/gset.icn, revision 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

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