#!/bin/sh
# \
    exec tcl "$0" -- ${1+"$@"}

if {[cequal [lindex $argv 0] "--"]} { lvarpop argv ; incr argc -1 }

# ######################################################################
proc givehelp {} {

    set prog [lindex [file split $::argv0] end]

    puts "$prog implements basic set operators, so that you can easily
do things like
	% grep somestring `sets *.c -not xxx.c`
which greps for somestring in all C files except xxx.c.

The general format is

	% sets e1... op1 e2... op2 e3...

where op's are operators and e's are any elements not in the operator list.
The output is the elements formed by evaluating the operators left-to-right.

The valid operators are
	-i (intersection)
	-u (union)
	-not (remove words from left wordgroup if they are in right wordgroup)"
}

# ######################################################################
# lst2lists:
#	takes two lists: one is a list to be divided into sublists,
#	and the second is a list of "operators".  The first list is split
#	into sublists at the operators, and this list of lists is returned.
#
# The list to be divided is of the form
#
#	e [ ... ] op e [ ... ] [op e [ ... ] ]
#
# where each element e is any value not in the operator list,
# and each element op is a value from the operator list.
#
# For example, if the operators are "-and", "-or", and "-not", and the list is
#
#	a b c d -or e f g h -not f d
#
# the returned list is
#	{a b c d} {-or} {e f g h} {-not} {f d}
#
proc list2lists {wordlist oplist} {
    set sublist {}	; # Accumulates a sublist of words
    set outlist {}	; # Accumulates all sublists
    while {![lempty $wordlist]} {
	set word [lvarpop wordlist]
	set i [lsearch -exact $oplist $word]
	if {$i != -1} {
	    # Word is an op.  Append the sublist accumulator to the outlist,
	    # then append the op.
	    lappend outlist $sublist [lindex $oplist $i]
	    set sublist {}
	} else {
	    # Word is not an operator.  Append to sublist
	    lappend sublist $word
	}
    }
    # At end of wordlist.
    if {![lempty $sublist]} {
	lappend outlist $sublist
    }
}

# ######################################################################
# Use: sets wordgroup1... op1 wordgroup2... op2 wordgroup3...
#
# Returns the list formed by evaluating the operations left-to-right, ie
# ((wordgroup1 op1 wordgroup2) op2 wordgroup3) ...
#
# The valid operators are
#	-i (intersection)
#	-u (union)
#	-not (in l1 but not l2)
# If there is a trailing operator, a last operator of the empty set is
# used.
proc sets {words} {
    set lists [list2lists $words {-u -i -not}]
    set left [lvarpop lists]
    while {![lempty $lists]} {
	set op [lvarpop lists]
	set right [lvarpop lists]
	switch -exact -- $op {
	-i { set left [intersect $left $right] }
	-u { set left [union $left $right] }
	-not { set left [lindex [intersect3 $left $right] 0] }
	}
    }
    return $left
}

# ######################################################################

if {[llength $argv] == 0} {
    givehelp
} else {
    puts [join [sets $argv]]
}