#
# <20240108.1646.38>

# Here we have some handy basic functions:
#
# Seems tcl does not have a remove function that accepts list indics
# So, here we go...
#
# call:
#
# ldelete list indics
#
# removes the element addressed as in [lindex $list indics].  
#
# if element does not exist, just return what we got
#
proc ldelete {var indics} {
  if {$indics == {} || [lindex  $var $indics] == {}} {
      return $var
  }
  if {[llength $indics] == 1} {
    return [lreplace $var $indics $indics]
  } else {
    
    set entry [lassign $indics next]
    return [concat [lrange $var 0 $next-1]\
		[list [ldelete [lindex $var $next] $entry]]\
		[lrange $var $next+1 end]]
  }
}
#
# Normalize a nested list
#
# This routine replaces all the element delimiting whitespace
# with a single space. This allows lsort to do the right
# thing without triping on delimiting whitespace.
#

proc lnorm {list} {
  set r {}
  foreach el $list {
    if {[llength $el] == 1} {
      lappend r $el
    } else {
      lappend r [lnorm $el]
    }
  }
  return $r
}
# Check equality of two arrays where any list entries
# have no order significance

proc arraysEq {ar1 ar2} {
  upvar $ar1 mar1
  upvar $ar2 mar2
  if {![array exists mar1] ||\
	  ![array exists mar2] ||\
	  [array size mar1] != [array size mar2]} {return 0}
  foreach ent [array names mar1] {
    if {![info exists mar2($ent)] ||\
	    [lsort  $mar1($ent)] != [lsort $mar2($ent)]} {return 0}
  }
  return 1
}

# Here is a function that pops the top element off of a list
# given the var (NOT the value). If the list is empty it returns
# nil ({}).

proc lpop {var} {
  set cmd "set $var \[lassign \[set $var] vvvvvv]"
  uplevel 1 $cmd
  return [uplevel 1 {set vvvvvv}]
}

# Here is a foreach replacement (one list only) that allows the body
# to mess with the list. var and list should both be names, (not values)
# This removes elements from list until it is empty

proc lforeach {var list body} {
  uplevel 1 "while \{\[llength \[set $list]] > 0\} \{
     set $var \[lpop [set list]]
     $body\}" 
}

# for symmetry here is push, pushes <value> on to list named var

proc lpush {var value} {
  uplevel 1 "set $var \[linsert \[set $var] 0 $value]"
}
