# Many of these functions are also useful in test and debug code
# running on an external Tcl interpreter.
 
# LIST FUNCTIONS
proc head {args} {lindex [join $args] 0}
proc tail {args} {join [lrange [join $args] 1 end]}

# SET FUNCTIONS

# Set membership
proc setmem {el A} {
  expr {[lsearch $A $el] >= 0}
}

# Set difference: A\B, members of A that are not in B
proc setdiff {A B} {
  foreach el $A {
    if {[lsearch -exact $B $el] == -1} {
      lappend missing $el;
    }
  }
  if {[info exists missing]} {
    return $missing;
  }
}

proc _intersection {lista listb} {
  set result {}
  foreach elem [join $listb] {
    if { [lsearch -exact $lista $elem] != -1 } {
      lappend result $elem
    }
  }
  return $result
}

proc intersection {lista args} {
  if {[llength $args] == 0} {return $lista}
  if {[llength $args] == 1} {return [_intersection $lista $args]}
  return [intersection [_intersection $lista [head $args]] [tail $args]];
}


# TYPE CHECKING
# This is an enhanced set membership function.
# It can check that an element is a member of a list or
# of a named type
proc isoneof {element setb} {
  global simpleType;
  set result 0;

  foreach elb $setb {
    switch $elb {
      alpha {set result [string is alpha $element]}
      text {set result [string is wordchar $element]}
      print {set result [string is print $element]} 
      float {set result [string is double $element]}
      int {set result [string is integer $element]}
      default {set result [expr {$element == $elb}]}
    }
    if {$result == 1} {return 1}
  }
  return 0;
}

# Returns 'sicslist' output in lower case, this may be useful in macros.
# This function is used a lot in the hdbbuilder
proc tolower_sicslist {args} {
  set result [eval sicslist $args]
  return [string tolower $result];
}

# \brief Enables or disables the debug_msg command
#
# \param mode on turns on debugging, off turns off debugging
# 
# \see debug_msg
# TODO Set a callstack global variable
proc debug_mode {mode} {
  switch $mode {
    on {
      proc debug_msg {args} {
        switch [info level] {
          0 {
            # This happens when debug_msg is used with trace
            clientput $args
          }
          1 {
            # This probably only occurs if you debug_msg directly. Why would you do that?
            set cmdinfo [info level 0]
            set cmd [lindex $cmdinfo 0]
            set nscmd [namespace origin $cmd] 
            clientput "DEBUG, ${nscmd}::$cmdinfo]$args"
          }
          2 {
            set cmdinfo [info level -1]
            set cmd [lindex $cmdinfo 0]
            set nscmd [namespace origin $cmd] 
            clientput "DEBUG, ${nscmd}::$cmdinfo]$args"
          }
          3 - default {
            set cmdinfo [info level -1]
            set cmd [lindex $cmdinfo 0]
            set nscmd [namespace origin $cmd] 
            set callerinfo [info level -2]
            set caller [lindex $callerinfo 0]
            set nscaller [namespace origin $caller] 
            clientput "DEBUG, ${nscaller}::$callerinfo\n\t${nscmd}::$cmdinfo]$args"
          }
        }
      }
    }
    off {
      proc debug_msg {args} {};
    }
  }
}

## \brief You can use debug_msg in place of 'puts' for debug info in Tcl macros.  
#
# Add debug messages on the fly with
# strace add execution <proc> enter debug_msg
proc debug_msg {args} {};
publish debug_mode mugger

proc todo_msg {args} {
  set cmdinfo [info level -1]
  set cmd [lindex $cmdinfo 0]
  clientput "TODO <$cmd> $args"
}

proc error_msg {args} {
  set cmdinfo [info level -1]
  set cmd [lindex $cmdinfo 0]
  set arglist [lrange $cmdinfo 1 end]
  error "ERROR: [namespace origin $cmd] $arglist: $args"
}