4.3BSD/usr/contrib/icon/src/cmd/gset.icn

#	GSET(1)
#
#	Perform set operations on file specifications
#
#	Thomas R. Hicks
#
#	Last modified 8/23/84
#

procedure main(args)
   local i, fyls, arglist
   if *args = 0 then return
   if *args > 1 then
      every i := 2 to *args do
         args[1] ||:= (" " || args[i])
   (arglist := parse(args[1])) |
      stop("Invalid file specification expression")
   case type(arglist) of {
      "string"	: fyls := mkflst(arglist)
      "list"	: fyls := exec(arglist)
      default	: stop("Main: bad type -can't happen")
      }
   fyls := sort(fyls)
   every write(!fyls," ")
end

procedure Exp()			# file spec expression parser
   local a
   suspend (a := [Factor(),=Op(),Factor()] & [a[2],a[1],a[3]]) |
      Factor() |
      (a := [="(",Exp(),=")"] & .a[2])
end

procedure Factor()		# file spec expression parser
   local a
   suspend (a := [Term(),=Op(),Term()] & [a[2],a[1],a[3]]) |
      Term() |
      (a := [="(",Factor(),=")"] & .a[2])
end

procedure Name()		# file spec name matcher
   static valid
   initial valid := ~'()'
   suspend (any(~valid) || fail) | tab(find(Op()) | many(valid))
end

procedure Non()			# file spec expression parser
   local a
   suspend a := [Name(),=Op(),Name()] & [a[2],a[1],a[3]]
end

procedure Op()			# file spec operation matcher
   suspend !["++","--","&&"]
end

procedure Term()		# file spec expression parser
   local a
   suspend (a := [="(",Non(),=")"] & .a[2]) |
      Name()
end

procedure bldflst(arg)		# build file list
   local line
   line := read(open("echo " || arg,"rp"))
   return str2lst(line,' ')
end

procedure exec(lst)		# recurseively process file spec list
   return setops(lst[1])(exec2(lst[2]),exec2(lst[3]))
end

procedure exec2(arg)		# helping procedure for exec
   case type(arg) of {
      "string"	: return mkflst(arg)
      "list"	: return exec(arg)
      default	: stop("exec2: can't happen")
      }
end

procedure lstlu(key,lst)	# lookup key string at top level of list
   local v
   every v := !lst do
      if key == v then return
   fail
end

procedure mkflst(fspec)		# make file list using file specification
   if fspec == "*" then
      fspec := "* .*"
   return uniq(bldflst(fspec))
end

procedure parse(str)		# top level of parsing procedures
   local res
   str ? (res := Exp() & pos(0)) | fail
   return res
end

procedure sdiff(f1,f2)		# set difference
   local a, x
   a := []
   if *f1 = 0 then return a
   if *f2 = 0 then return copy(f1)
   every x := !f1 do
      if not lstlu(x,f2) then put(a,x)
   return a
end

procedure setops(op)		# return correct set operation procedure
   case op of {
      "++"	: return sunion
      "&&"	: return sinter
      "--"	: return sdiff
      }
end

procedure sinter(f1,f2)		# set intersection
   local a, x
   a := []
   if (*f1 | *f2) = 0 then return a
   if *f1 < *f2 then {
      every x := !f1 do
         if lstlu(x,f2) then put(a,x)
      }
   else {
      every x := !f2 do
         if lstlu(x,f1) then put(a,x)
      }
   return a
end

procedure str2lst(str,delim)	# convert delimited string into a list
   local lst, f
   lst := []
   str ? {
      while f := (tab(upto(delim))) do {
         put(lst,f)
         move(1)
         }
      if "" ~== (f := tab(0)) then
         put(lst,f)
      }
   return lst
end

procedure sunion(f1,f2)		# set union
   local a, x
   a := []
   if *f1 = 0 then return copy(f2)
   if *f2 = 0 then return copy(f1)
   if *f1 < *f2 then {
      every put(a,!f2)
      every x := !f1 do
         if not lstlu(x,f2) then put(a,x)
      }
   else {
      every put(a,!f1)
      every x := !f2 do
         if not lstlu(x,f1) then put(a,x)
      }
   return a
end

procedure uniq(lst)		# remove duplicates, filtering out . and ..
   local t, a, x
   t := table()
   every x := !lst do
      if (x ~== "." & x ~== "..") then
         t[x] := x
   a := []
   every put(a,!t)
   return a
end