package provide listset 0.2

 proc listset {cmd args} {
    if { [info proc "listset $cmd" ] == {} } {
        global errorInfo
        error "No proc: listset $cmd" $errorInfo
         return
    }
    uplevel 1 [linsert $args 0 "listset $cmd" ]
 }

 # listdiff returns a list of 3 sorted  lists  of unique elements 
 #       { {stuff in a not in b } {stuff in both a and b } {stuff in b not in a } }
 # the lists a and b are treated as sets

 proc "listset diff" { a b } {
    set a [ lsort -unique $a ]
    set b [ lsort -unique $b ]
    set l1 {} ; set l2 {}
    foreach i $a {
        set j [ lsearch $b $i ]
        if { $j < 0 } { 
            lappend l1 $i 
        } else {
            lappend l2 $i
            set b [ lreplace $b $j $j ]
        }
    }
    return [ list $l1 $l2 $b ]
 }

 proc "listset or" args { return [ lsort -unique [ eval concat $args ] ] }

 proc "listset and" args { 
    if { [ llength $args ]  == 0 } { return {} }
    if { [ llength $args ] == 1 } { return [lindex $args 0]}
    set a [ lindex [ "listset diff" [lindex $args 0] [lindex $args 1] ] 1]
    return [ eval "listset and"  [lreplace $args 0 1 $a ]]
 }

 proc "listset xor" args {
    if { [ llength $args ]  == 0 } { return {} }
    if { [ llength $args ] == 1 } { return [lindex $args 0] }
    set a [eval {"listset or"} $args]
    set b {}
    for {set i 0} {$i < [llength $args]} {incr i} {
    for {set j [expr $i+1]} {$j < [llength $args]} {incr j} {
        set c ["listset and" [lindex $args $i] [lindex $args $j]]
        set b ["listset or" $b $c ]
    }}
    return [lindex ["listset diff" $a $b] 0 ]
 }

 if 0 { this is a package which provides algebra for infinte as well as finite sets

   all functions and values are typed. They are in the form {type func} or {type value}
   because most of the functions (procs) in this package return sets,
   most of the proc names are of the form {set func}
   this package provides type conversion from list, listset, regexp and lambda to set
   and from set to list/listset

   a list type is the normal form of finite list
   a listset type is the normal form of finite list with the restriction that no values are repeated, 
   however this is never assumed

   a lambda type is a lambda expression, however, depending on the value supplied to the lambda expression 
   it may evaluate to 0, 1 or some other value or generate an error. Values other than 0 or 1 are trapped 
   if they occur and 0 returned instead.

   The fundamental property of a set is that you can tell if a candidate value is an element of the set or not. 
   That is the basic functionality which this package provides.

   Because the sets managed by this package are infinite by default it is not possible to enumerate the 
   elements in any set. However a {listset and} procedure is provided which allows for the intersection of a 
   set with a listset (or list) and returns the finite list representation of the intersection of the two.


    proc {set make} value           - returns a value of type set

    Sample Invocations
         {set make} $a     - where the variable a has a typed valued as in the next examples
         {set make} {list { a s d f g}}
         {set make} [list regexp $regexp_pattern]
         {set make} {regexp x.*}
         {set make} {lambda i {expr{$i%6}==0}}

   {set and} ?set1? ?set2? ...         - returns the set which represnts the intersection of the sets

    Sample Invocations
        {set and} $a $b $c - where the variables a b and c are of type set - of not an error is signalled
        {set and} {lambda i {expr{$i%6}==0} {lambda i {expr{$i%10}==0}

    Example of use:
        % set a [{set make} {lambda i {expr {($i%6)==0}}}]
        % set b [{set make} {lambda i {expr {($i%10)==0}}}]
        % set c [{set and} $a $b]
        % $c 2580
        1
        % $c 31
        0
        % $c 3.2
        can't use floating-point value as operand of "%"

    Thats what comes of allowing wild lambdas!


 }

 proc {set make} a {
    set ob \[
    set cb \]
    set d \$
    set oc \{
    set cc \}
    switch [lindex $a 0] {
        "list" -
        "listset" { # convert list to listset
            # check that a has exactly 2 elements in its list
            if { [llength $a] != 2 } { 
                bgerror "value of arg a = \"$a\" is not of proper list type \n " 
                return {}
            }
            set b [lsort -unique [lindex $a 1]]
            return "lambda i ${oc}expr $oc  ${ob}lsearch  ${ob}list $b $cb ${d}i $cb >= 0 $cc$cc "
        }
        "regexp" {
            # check that a has exactly 2 elements in its list
            if { [llength $a] != 2 } { 
                bgerror "paramweter value \"$a\" is not of proper regexp type " 
                return {}
            }
            # check that the pattern is a valid regexp
            set pattern [lindex $a 1]
            if { [catch { regsub $pattern x {} } msg ] } {
                bgerror "\"$pattern\" is not a valid regexp pattern "
                return {}
            }
            return "lambda i $oc expr $oc $ob regsub $pattern ${d}i {} $cb == {} $cc $cc "
        }
        "lambda" {
            # check that a has exactly 3 elements in its list
            if { [llength $a] != 3 } { 
                bgerror "parameter value \"$a\" is not of proper lambda type " 
                return {}
            }
            # MAYBE LATER check that 2nd element is proper simple (not array or arrya element) tcl variable name
            # HOW ELSE can this be made less WILD ?
            # we try to normalise the result by orring it with zero
            return "lambda i $oc expr $oc 0 || $ob $a ${d}i $cb $cc$cc "
        }
        default { 
            bgerror "\"[lindex $a 0]\" is an unrecognised type and cannot be made into a set. "
            return {}
        }
    }
 }

 if 0 {
    # test data
    set a [{set make} {list { 3 4 5 6 33 44 55 66}}]
    set b [{set make} {regexp 6*}]
    set c [{set make} {lambda i {expr {[string length $i] %2 }}}]
    {set make} 1 2 3
    {set make} {lambda i j { expr $i +$j}}
    {set make} {regexp asd[asd }
    {set make} {regexp 1 2 3}
    {set make} {list 1 2 3 4}
 }

 if 0 {
     "set or" is set union. The args must all be boolean lambdas, that is, made by "set make".
 }

 proc {set or} args {
    # check type - for now they must simply be lambdas
    foreach i $args {
        if { "[lindex $i 0]" != "lambda" } {
            bgerror "parameter \"$i\" is not a lambda of type \"set\" "
            return
        }
    }
    set or ""
    set oc \{
    set cc \}
    set ob \[
    set cb \]
    set d \$
    if { [llength $args] == 0 } {
        bgerror "\"set or\" musy have at least one argument"
        return {}
    }
    if { [llength $args] == 1 } {
        return [lindex $args 0]
    }
    set str "lambda i $oc expr $oc"
    foreach j $args {
        append str " $or $ob $j ${d}i $cb"
        set or ||
    }
    append str " $cc$cc"
    return $str
 }

 if 0 {
    set ab [{set or} $a $b] 
    $ab 77
    set abc [{set or} $a $b $c ]
    $abc 77
 }

 if 0 {
    This is set intersection. The arguments must all be boolean lambdas, that is, made by "set make"
 }

 proc {set and} args {
    # check type - for now they must simply be lambdas
    foreach i $args {
        if { "[lindex $i 0]" != "lambda" } {
            global errorInfo
            set e $errorInfo
            bgerror "parameter \"$i\" is not a lambda of type \"set\" \n $e"
            return
        }
    }
    set and ""
    set oc \{
    set cc \}
    set ob \[
    set cb \]
    set d \$
    set str "lambda i $oc expr $oc"
    if { [llength $args] == 0 } {
        bgerror "\"set and\" must have at least one argument"
        return {}
    }
    if { [llength $args] == 1} {
        return [lindex $args 0]
    }
    foreach j $args {
        append str " $and $ob $j ${d}i $cb"
        set and &&
    }
    append str " $cc$cc"
    return $str
 }

 if 0 {
    set ab [{set and} $a $b] 
    $ab 6
    set abc [{set and} $a $b $c ]
    $ab 6
 }

 if 0 {
    set diff returns a list of 3 lists  of disjoint elements 
             { {stuff in a not in b } {stuff in both a and b } {stuff in b not in a } }
     a and b must be boolean lambdas (made by "set make")
 }

 proc {set diff} { a b } {
    # check type - for now they must simply be lambdas
    foreach i [list $a $b] {
        if { "[lindex $i 0]" != "lambda" } {
            global errorInfo
            set e errorInfo
            bgerror "parameter \"$i\" is not a lambda type of \"set\" \n $e"
            return
        }
    }
    set oc \{
    set cc \}
    set ob \[
    set cb \]
    set d \$
    set e1 "lambda i $oc expr $oc"
    set e2 $e1
    set e3 $e1
    append e1 " $ob $a ${d}i $cb && ! $ob $b ${d}i $cb$cc$cc"
    append e2 " $ob $a ${d}i $cb && $ob $b ${d}i $cb$cc$cc"
    append e3 " ! $ob $a ${d}i $cb && $ob $b ${d}i $cb$cc$cc"

    return [ list $e1 $e2 $e3 ]
 }

 if 0 {
    set g [{set diff} $a $b]
    set a_b [lindex $g 0]
    $a_b 33
    $a_b 66
    set ab [lindex $g 1]
    $ab 66
    $ab 666
    set b_a [lindex $g 2]
    $b_a {}
    $b-a 6
 }

 if 0 {
    "set xor" is a generalised exclusive or - the result set consists of elements 
    each of which exists in only one of the candidate sets. 
    Again the args must all be boolean lambdas created by "set make"
 }

 proc "set xor" args {
    # check type - for now they must simply be lambdas
    foreach i $args {
        if { "[lindex $i 0]" != "lambda" } {
            global errorInfo
            set e $errorInfo
            bgerror "parameter \"$i\" is not a lambda of type \"set\" \n $e"
            return
        }
    }
  
    set and ""
    set oc \{
    set cc \}
    set ob \[
    set cb \]
    set d \$
    if { [ llength $args ] == 0 } { 
        bgerror "\"set xor\" must have at least one parameter"
        return {}
    }
    if { [ llength $args ] == 1 } { return [lindex $args 0] }
    set a [eval {"set or"} $args]
    set b "lambda i { expr 0}"
    for { set ii 0 } { $ii < [ llength $args] } { incr ii} {
    for { set jj [expr $ii +1] } { $jj < [ llength $args] } { incr jj} {
        set c ["set and" [lindex $args $ii] [lindex $args $jj]]
        set b ["set or" $b $c]
    }}

    return [ lindex ["set diff" $a $b] 0]
 }

 if 0 {
    set d [{set xor} $a $b]
    $d 3
    $d 6
    $d 666

    set f [{set make} {list {f fg fh fgh}}]
    set g [{set make} {list {g fg gh fgh}}]
    set h [{set make} {list {h fh gh fgh}}]
    set e [{set xor}]
    set e [{set xor} $f]
    set e [{set xor} $f $g ]
    set e [{set xor} $f $g $h]
    foreach k { f g h fg fh gh fgh z} {
        puts "[$e $k]"
    }

 }

 if 0 {

 This "listset and" replaces the one above

 Each of the arguments for "listset and" can be a "set" (ie a lambda expression) 
 or a Tcl list. Of course a lambda expression is a special kind of Tcl list and is 
 recognised as such for this purpose. AT LEAST ONE of the arguments MUST BE A TCL LIST 
 otherwise there is no point to the exercise.

 And of course you can make the resulting listset back into a set 
 if you want to use it in more set operations.
 }

 proc "listset and" args {
    set a {}
    set b {}
    foreach i $args {
        if { "[lindex $i 0]" == "lambda"  && [llength $i] == 3} {
            lappend b $i
        } else {
            lappend a $i
        }
    }
    if { [llength $a] == 0 } {
        bgerror "There is no finite set in the arguments - there is no effective computation"
        return {}
    }
    if { [llength $a] == 1 } {
        set c [lindex $a 0]
    } else {
        set c [lindex $a 0]
        foreach i [lrange $a 1 end] {
            set c [lindex ["listset diff" $c $i] 1]
        }
    }
    if { [llength $b ] == 0 } {
        return $c
    }
    set d [eval {"set and"} $b]
    set e {}
    foreach i $c {
        if { [$d $i] } {lappend e $i}
    }
    return $e
 } 

 if 0 {
    set p {1 2 3 4 5 6 7 8 9 }
    set q { 6 7 8 9 10 11 12 13 14 15}
    set c [{set make} {lambda i {expr {[string length $i] %2 == 0}}}]
    set d [{set make} {lambda i {expr {$i %2 == 0}}}]
    "listset and" $p $d
    "listset and" $q $c
    "listset and" $c $q $d
 }