ycl

Artifact 3feaa0ad1a4472b1a35bf4575b5ad4e2cbbd9370:

• File packages/eav/lib/sqlite.tcl — part of check-in [694cd14e71] at 2020-03-03 22:29:49 on branch trunk — ycl chan

  ycl dir

  updates to reflect changes to object system

  ycl eav make [gen] duplicates choose the entity with the lowest number as the "original" (user: pooryorick size: 91397)

#! /bin/env tclsh

package require {ycl db sqlite util}
package require sqlite3

namespace import [yclprefix]::db::sqlite::util::lossless

package require {ycl ns}


proc eav {name args} {
	if {![string match ::* $name]} {
		set name [string trimright [uplevel 1 {namespace current}] :]::$name
	}

	try [string map [list \
		:arg: [lossless :arg] \
		:array: [lossless :array] \
		:attribute: [lossless :attribute] \
		:count: [lossless :count] \
		:eid: [lossless :eid] \
		:entity: [lossless :entity] \
		:entity2: [lossless :entity2] \
		:id: [lossless :id] \
		:index: [lossless :index] \
		:record: [lossless :record] \
		:systemattribute: [lossless :systemattribute] \
		:value: [lossless :value] \
	] {

		variable sql_eav_array_value_exists {
			select 1 from @array@ where id == :index:
		}

		variable sql_eav_array_exists {
			select 1 from arrays where record = :id:
		}

		variable sql_eav_array_select_by_id {
			select v from @array@ where id == :index:
		}

		variable sql_eav_array_select_by_record {
			select v from @array@ where id == :index:
		}

		variable sql_eav_array_id {
			select array from arrays where record == :eid:
		}

		variable sql_eav_array_insert {
			insert into @array@ values (:index: ,:value:)
		}

		variable sql_eav_array_update {
			update @array@ set v = :value:
				where rowid == :index:
		}

		variable sql_eav_arrays_delete {
			delete from arrays where record == :record:
		}

		variable sql_eav_arrays_delete_by_e {
			delete from arrays where record in (
				select id from eav where e == :entity:
			)
		}

		variable sql_eav_arrays_delete_by_ea {
			delete from arrays where record in (
				select id from eav where e == :entity:
				and a == :arg:
			)
		}

		variable sql_eav_arrays_insert {
			insert into arrays values(NULL ,:id: , :array:)
		}

		variable sql_eav_arrays_select {
			select array from arrays where record == :record:
		}

		variable sql_eav_arrays_select_by_ea {
			select array from arrays where record in (
				select id from eav where e == :entity:
				and a == :arg:
			) order by id desc
		}

		variable sql_eav_arrays_select_by_e {
			select array from arrays where record in (
				select id from eav where e == :entity:
			) order by id desc
		}

		variable sql_eav_clone_insert {
			insert into eav select NULL ,:entity2: ,a ,v
				from eav where e = :entity:
		}

		variable sql_eav_delete_by_e {
			delete from eav where e == :entity:
		}

		variable sql_eav_delete_by_ea {
			delete from eav where e == :entity:
			and a == :arg:
		}

		variable sql_eav_insert {
			insert into eav values
				(NULL ,:entity: , :attribute: ,:value:)
		}

		variable sql_eav_setvalue {
			update eav set v = :value: where id == :id:
		}

		variable sql_eav_incr_update {
			update eav set v = v + :count:
				where e == :entity: and a = :attribute:
		}

		variable sql_eav_incr_insert {
			insert into eav values (NULL ,:entity: , :attribute: ,:count:)
		}

		variable sql_eav_select_by_e {
			select a ,v from eav where e == :entity: order by id
		}

		variable sql_eav_select_by_ea {
			select id from eav where e == :entity: 
				and a == :attribute: order by id
		}

		variable sql_eav_select_eav {
			select id from eav where e == :entity:
				and a == :attribute: and v == :value: order by id
		}

		variable sql_eav_sysguard {
			select 1 from eav where e == :entity:
				and a == :systemattribute:
		}

		variable sql_eav_select_av_by_e_sysguard "
			select a ,v from eav
				where e == :entity: and not exists ($sql_eav_sysguard)
					order by id
		"

		variable sql_eav_select_v_by_ea {
			select v from eav where e == :entity:
				and a == :attribute: order by id
		}

		variable sql_eav_select_v_by_ea_sysguard "
			select v from eav where e == :entity: and a == :attribute:
			and not exists ($sql_eav_sysguard) order by id
		"

		variable sql_eav_select_id_by_ea {
			select id from eav where e == :entity:
				and a == :attribute: order by id
		}

	}]


	namespace eval $name {
		namespace import [yclprefix]::db::sqlite::util::gen::strquote
		namespace import [yclprefix]::db::sqlite::util::lossless
		namespace eval doc {}

		namespace path [list [uplevel 1 {::namespace current}]]

		namespace upvar [uplevel 1 {::namespace current}] \
			sql_eav_array_value_exists sql_eav_array_value_exists \
			sql_eav_array_exists sql_eav_array_exists \
			sql_eav_array_id sql_eav_array_id \
			sql_eav_array_insert sql_eav_array_insert \
			sql_eav_array_select_by_id sql_eav_array_select_by_id \
			sql_eav_array_update sql_eav_array_update \
			sql_eav_arrays_delete sql_eav_arrays_delete \
			sql_eav_arrays_delete_by_e sql_eav_arrays_delete_by_e \
			sql_eav_arrays_delete_by_ea sql_eav_arrays_delete_by_ea \
			sql_eav_arrays_insert sql_eav_arrays_insert \
			sql_eav_arrays_select sql_eav_arrays_select \
			sql_eav_arrays_select_by_e sql_eav_arrays_select_by_e \
			sql_eav_arrays_select_by_ea sql_eav_arrays_select_by_ea \
			sql_eav_clone_insert sql_eav_clone_insert \
			sql_eav_delete_by_e sql_eav_delete_by_e \
			sql_eav_delete_by_ea sql_eav_delete_by_ea \
			sql_eav_insert sql_eav_insert \
			sql_eav_incr_update sql_eav_incr_update \
			sql_eav_incr_insert sql_eav_incr_insert \
			sql_eav_select_by_ea sql_eav_select_by_ea \
			sql_eav_select_eav sql_eav_select_eav \
			sql_eav_select_by_e sql_eav_select_by_e \
			sql_eav_select_av_by_e_sysguard sql_eav_select_av_by_e_sysguard \
			sql_eav_select_id_by_ea sql_eav_select_id_by_ea \
			sql_eav_select_v_by_ea sql_eav_select_v_by_ea \
			sql_eav_select_v_by_ea_sysguard sql_eav_select_v_by_ea_sysguard \
			sql_eav_setvalue sql_eav_setvalue \
			sql_eav_sysguard sql_eav_sysguard

		namespace ensemble create -map {
			and and
			array array_ clone clone db db ddestroy ddestroy dexists dexists
			dget dget dinsert dinsert dset dset dunset dunset ensure ensure
			entities entities except except exists exists find find findm findm
			flatten flatten gen gen get get id id incr incr_ init init
			insert insert intersect intersect let let or or set set_
			redpill redpill report report revision revision the the 
			trace trace_ union union unset unset_
		}


		variable doc::and {
			description {
				Like [or] but composes an intersection query instead of a union
				query
			}
		}
		proc and {report args} {
			set t1name [namespace current]::[info cmdcount]_and_t1name
			transform .new $t1name 
			try {
				gen $t1name {*}[join $args]
				set report [report $report $t1name]
				uplevel 1 [list [namespace which findm] $report $t1name]
			} finally {
				unset $t1name
			}
		}


		variable doc::array_ {
			description {
				The value of an record may be a reference to an array .
				Multiple records may reference the same array . An array is
				automatically deleted when there are no more references to it .
			}
		}
		namespace eval array_ {
			namespace export *
			namespace ensemble create
			namespace ensemble configure [namespace current] -map {
				eval eval_ exists exists id id link link set set_ size size
				sweep sweep unlink unlink unset unset_ 
			}

			namespace eval doc {}

			namespace import [namespace parent]::checkargs
			namespace import [yclprefix]::db::sqlite::util::idquote
				
			namespace import [yclprefix]::db::sqlite::util::lossless

			namespace upvar [uplevel 1 {::namespace current}] \
				sql_eav_array_value_exists sql_eav_array_value_exists \
				sql_eav_array_exists sql_eav_array_exists \
				sql_eav_array_id sql_eav_array_id \
				sql_eav_array_insert sql_eav_array_insert \
				sql_eav_array_select_by_id sql_eav_array_select_by_id \
				sql_eav_array_update sql_eav_array_update \
				sql_eav_arrays_delete sql_eav_arrays_delete \
				sql_eav_arrays_insert sql_eav_arrays_insert \
				sql_eav_arrays_select sql_eav_arrays_select

			variable doc::eval_ {} {
				usage {
					eval ARRAYS VARNAMES SCRIPT
				}
				description {
					Iterate over a set of arrays by rowid, evaluating a script
					for each row, which is comprised of the values in the
					arrays at the current rowid.

					ARRAYS is a dictionary where each key is an entity, and
					each value is a list of attributes, each of which is an
					array.  If a value is "*" (asterisk), all the attributes of
					that entity that are array values are included.  If a key
					is a list containing more than one item, the first item is
					the entity, and the second item is string to prepend to the
					name attribute to form the variable name.

					SCRIPT is evaluated as a Tcl script once for each
					row where a value exists for that rowid in one of the
					columns, and for each column, a variable having the same
					name as the column is assigned in the current level.  The
					empty string is assigned to the corresponding variable for
					each column in the row that does not have a value at the
					current rowid.
					
					VARNAMES is a list of names, in this order:

						(optional) The name of a variable in which to store
						the rowid

						(optional) The name of an array variable to populate
						instead of creating individual variables in the calling
						level.  
				}
			}
			proc eval_ {arrays varnames script} {
				db transaction {
					if {[llength $varnames] == 1} {
						lassign $varnames idxname
					} elseif {[llength $varnames] == 2} {
						lassign $varnames idxname varname
					} else {
						error [list {wrong # args}]
					}

					set i -1
					set tables {}
					dict for {entity attributes} $arrays {
						set prefix {}
						if {[string is list $entity] && [llength $entity] > 1} {
							lassign $entity entity prefix
						}
						if {[llength $attributes] == 1 && [lindex $attributes 0] eq {*}} {
							set attributes [dict keys [
								[namespace parent] set $entity]]
						}
						[namespace parent] find $attributes entity == $entity \
							eval found {

							set idx [lsearch -exact $attributes $found(a)]
							set attributes [
								lreplace $attributes[set attributes {}] $idx $idx]
							lappend names "array_$found(v).v as [
								idquote $prefix$found(a)]"
							lappend tables array_$found(v)
						}
						if {[llength $attributes]} {
							error [list {arrays not found for entity} \
								$entity $attributes]
						}
					}

					set with "with rows as ( [join [lmap table $tables {
						lindex "select rowid from $table"}] { union }] ) "
					set from [list from rows]
					foreach newtable $tables {
						lappend from left join $newtable on \
							rows.rowid == $newtable.rowid
						
					}
					set query "$with select rows.rowid as $idxname"
					if {[info exists names]} {
						append query ", [join $names ,]"
					}
					append query " [join $from { }] order by rows.rowid"

					if {[info exists varname]} {
						set res [uplevel 1 [
							list [namespace current]::db transaction [
								list [namespace current]::db eval \
								$query $varname $script]]]
					} else {
						set res [uplevel 1 [
							list [namespace current]::db transaction [
								list [namespace current]::db eval $query $script]]]
					}
				}
			}


			variable doc::exists {
				description {
					Indicates whether a value exists at a given index in an
					array , or if $index is not provided, whether the attribute
					is the name of an existing array.
				}
			}
			proc exists {entity attribute args} {
				variable sql_eav_array_value_exists
				variable sql_eav_array_exists
				db transaction {
					if {[llength $args]} {
						lassign $args index
						set array [id $entity $attribute]
						db exists [string map [list @array@ array_$array] \
							$sql_eav_array_value_exists]
					} else {
						[namespace parent] find $attribute entity == $entity \
							like $attribute % eval {} {
							break
						}
						if {[info exists id]} {
							return [db exists $sql_eav_array_exists]
						}
						return 0
					}
				}
			}


			variable doc::id {
				description {
					Given an entity and an attribute, returns the id of the
					corresponding array
				}
			}
			proc id {entity attribute} {
				variable sql_eav_array_id
				db transaction {
					set eid [[namespace parent] id $entity $attribute]
					db eval $sql_eav_array_id {}
					if {![info exists array]} {
						error [list {not an array} $entity $attribute]
					}
				}
				return $array
			}


			variable doc::link {
				description {
					Link an array into another attribute . The source attribute
					provides the array reference , but beyond that there is no
					relationship between the original attribute and the
					attribute that becomes linked to the array .
				}
			}
			proc link {entity1 attribute1 entity2 attribute2} {
				variable sql_eav_arrays_insert
				db transaction {
					if {![exists $entity1 $attribute1]} {
						error [list {no such array} entity $entity1 \
							attribute $attribute1]
					}
					set array [id $entity1 $attribute1]

					if {[exists $entity2 $attribute2]} {
						if {[id $entity2 $attribute2] eq $array} {
							# Already linked
							return
						}
						[namespace parent] unset $entity2 $attribute2
					}
					[namespace parent] set $entity2 $attribute2 $array
					set id [[namespace parent] id $entity2 $attribute2]
					# {to do} add something to the test suite for this
					db eval $sql_eav_arrays_insert
				}
			}


			variable doc::removeindex {
				description {
					remove the index from an array
				}
			}
			proc removeindex {entity attribute} {
				set array [id $entity $attribute]
				db transaction "drop index if exists idx_${array}_v on array_${array}"
			}


			variable doc::set_ {
				description {
					Create a new array , or retrieve the values in an array .
					If the array doesn't already exist , the array is is
					created .

					If only $entity and $attribute are provided , the entire
					array is returned as a list .

					If only $entity , $attribute , and $index are provided ,
					the value in the array at $index is returned .

					If $values is provided , the items in $values are inserted
					into the array starting at $index

					If more than thee arguments are provided, the last argument
					is a list of values to insert into the array

					$index can be any of the forms documented for Tcl string
					indices . If the array doesn't already exist , and the
					index is one of the "end" forms, it must evaluate to a
					positive integer . 

					If the arrary is modified, the entity is returned.
					Otherise, the value at the indicated index is returned.

				}
				synopsis {
					array set entity attribute
					array set entity attribute index 
					array set entity attribute index ?type $type? ?$values? 
				}
				args {
					type {
						description {
							The type affinity of the data in the array . 
						}
						validate {
							$type in {blob integer numeric real text}
						}
					}
					values {
						description {
							A list of values to place in the array
						}
					}
				}
			}
			proc set_ {entity attribute args} {
				variable sql_eav_array_select_by_id
				variable sql_eav_array_insert
				variable sql_eav_array_update
				variable sql_eav_arrays_insert

				db transaction {
					if {![llength $args]} {
						set array [id $entity $attribute]
						return [db eval "select v from array_$array order by id"]
					}

					# Operate on the last matching record
					if {$entity > -Inf} {
						if {[[namespace parent] exists $entity $attribute]} {
							if {[exists $entity $attribute]} {
								set array [id $entity $attribute]
							}
						}
					}

					set args [lassign $args[set args {}] index]
					if {![string is entier $index]} {
						set terms [scan $index {end%[+-]%lld%s} sign addend junk]
						if {$terms == 2} {
							set origindex $index
							set index end
							if {$sign eq {-}} {
								if {[exists $entity $attribute]} {
									if {[size $entity $attribute]} {
										set index [db eval "select max(id)
											from array_$array"]
									} else {
										set index 0 
									}
								}
								set index [expr {$index - $addend}]
							} else {
								if {[exists $entity $attribute]} {
									if {[size $entity $attribute]} {
										set index [db eval "select max(id)
											from array_$array"]
									} else {
										if {$addend == 0} {
											# index never ends up being greater
											# than -1 in this case, i.e. isn't past
											# the "end" of the non-existant array 
											error [list {bad index} $origindex]
										 }
										set index -1
									}
								} else {
									if {$addend == 0} {
										# index never ends up being greater
										# than -1 in this case, i.e. isn't past
										# the "end" of the non-existant array 
										error [list {bad index} $origindex]
									}
									set index -1
								}
								set index [expr {$index + $addend}]
								
							}
						} elseif {$index eq {end}} {
							if {[exists $entity $attribute]} {
								if {[size $entity $attribute]} {
									set index [db eval "select max(id)
										from array_$array"]
								} else {
									error [list {does not exist in array} \
										index $index]
								}
							} else {
								error [list {does not exist in array} \
									index $index]
							}
						} else {
							#This handles index expressions
							set index [expr $index]

							if {![string is entier $index]} {
								error [list {bad index} $index]
							}
						}
					}

					if {![llength $args]} {
						if {![string is entier $array]} {
							error [list {not an array} \
								entity $entity attribute $attribute]
						}
						set query [string map [list @array@ array_$array] \
							$sql_eav_array_select_by_id]
						if {![db exists $query]} {
							error [
								list {does not exist in array} index $index]
						}
						return [db eval $query] 
					}

					if {[llength $args] % 2} {
						set values [lindex $args end]
						set args [lrange $args[set args {}] 0 end-1]
					}

					set args [dict merge {type {}} $args]
					dict update args type type {}
					dict unset args type
					if {[llength [dict keys $args]]} {
						error [list {unknown arguments} [
							dict keys $args]]
					}

					if {![info exists array]} {

						if {[db exists {select 1 from arrays}]} {
							set array [db eval {
								select max(array) + 1 from arrays
							}]
						} else {
							set array 0
						}
						db eval "create table array_$array (
							id integer primary key ,v $type)
							; create index idx_array_v_$array
								on array_$array (v)
						"
						set entity [
							[namespace parent] set $entity $attribute $array]

						# Operate on the last matching record
						set id [[namespace parent] id $entity $attribute]
						db eval $sql_eav_arrays_insert
					}

					foreach value $values {
						db eval [string map [
							list @array@ array_$array] $sql_eav_array_update]
						if {![db changes]} {
							db eval [string map [list @array@ array_$array] \
								$sql_eav_array_insert]
						}
						incr index
					}
					return $entity
				}
			}


			variable doc::size {
				description {
					Returns the number of elements in the array
				}
			}
			proc size {entity attribute} {
				db transaction {
					set array [id $entity $attribute]
					db eval "select count(*) from array_$array"
				}
			}


			proc sweep args {
				db transaction {
					foreach arg $args {
						if {[db exists {
							select 1 from arrays where array == :arg}]} continue
						db eval "drop table if exists array_$arg"
					}
				}
			}


			variable doc::unlink {
				description {
					Unlinks an eav record and an array . If no more links to
					the array remain , it is deleted .
				}
			}
			proc unlink record {
				variable sql_eav_arrays_select
				variable sql_eav_arrays_delete
				db transaction {
					set array [db eval $sql_eav_arrays_select]
					if {[llength $array]} {
						# {to do} add something to the test suite for this
						db eval $sql_eav_arrays_delete
						if {[info exists array]} { sweep $array }
					}
				}
			}


			variable doc::unset_ {
				description {
					unset elements in an array, held by $entity and $attribute,
					where additional arguments are 1 or 2-item lists indicating
					a range of id's, inclusive.  If there is only one item in
					the list, it indicates a specific id. 
				}
			}
			proc unset_ {entity attribute args} {
				db transaction {
					set array [id $entity $attribute]
					set sql {}
					foreach arg $args {
						if {[llength $arg] == 1} {
							set first [lindex $arg 0]
							set last $first
						} elseif {[llength $arg] == 2} {
							lassign $arg first last
						} else {
							error [list {bad index specification} $arg]
						}
						if {![string is entier $array]} {
							error [list {bad array identifier} $array]
						}
						if {![string is entier $first]} {
							error [list {bad index} $first]
						}
						if {![string is entier $last]} {
							error [list {bad index} $last]
						}
						set first[incr i] $first
						set last$i $last
						lappend sql "delete from array_$array where
							id >= [lossless :first$i] and id <= [lossless :last$i]"
					}
					db eval [join $sql {;}]
				}
			}
		}


		proc clone entity {
			variable sql_eav_clone_insert
			db transaction {
				set entity2 [nextentity]
				db eval $sql_eav_clone_insert 
				return $entity2
			}
		}


		variable doc::combine {
			description {
				A convenience wrapper over findm.  Each argument is a list of
				arguments that are fed to [gen] to produce a query, after which
				they are all fed to [findm].
			}
		}
		proc combine {op transformvar args} {
			upvar $transformvar transform
			queriestotables lasttables transform $args
			combine2 $op lasttables transform
		}


		proc combine2 {op lasttablesvar transformvar} {
			upvar $transformvar transform
			set counts [dict get $transform counts]
			set finaltables [dict get $transform tables]
			upvar $lasttablesvar lasttables
			set op [dict get {
				except except
				intersect intersect
				union union
			} $op]
			set firsttable [lindex $lasttables 0]
			if {[llength $lasttables] > 1} {
				lappend combine $op [lindex $lasttables 1]
				foreach name [lrange $lasttables 2 end] {
					lappend combine $op $name
				}
			}
			set others $combine
			lassign $counts i j
			set mytablename eav[incr i]
			set query [dict create name $mytablename tables [
				dict create $firsttable {}] combine $others]
			gen_query_finished transform i finaltables eav lasttable \
				mytablename query 1
			transform set transform tables $finaltables
			transform set transform counts [list $i $j {*}[lrange $counts 2 end]]
			return
		}


		variable doc::combine_do {
			description {
				Uses combine to compose a union query of [gen] queries and
				execute it via [findm]. 
			}
		}
		proc combine_do {op report args} {
			set t1name [namespace current]::[info cmdcount]_combine_t1name
			transform .new $t1name 
			try {
				combine $op $t1name {*}$args
				set report [report $report $t1name]
				uplevel 1 [list [
					namespace which findm] $report $t1name]
			} finally {
				unset $t1name
			}
		}


		proc dotraces {op entity attribute index value} {db transaction {
			variable system
			variable active_traces
			if {$system > 0} return
			variable systemattribute
			incr system
			try {
				set traces [union * [
					list == type trace == op $op == entity {} == attribute {} \
						exists $systemattribute] [
					list == type trace == op $op == entity {} == attribute $attribute \
						exists $systemattribute] [
					list == type trace == op $op == entity $entity == attribute {} \
						exists $systemattribute] [
					list == type trace == op $op == entity $entity \
						== attribute $attribute exists $systemattribute]]
			} on error {cres copts} {
				incr system -1 
				return -options $copts $cres
			}

			foreach {id e a v p l} $traces[set traces {}] {
				dict lappend traces $e $a $v
			}

			try {
				foreach trace [dict values $traces] {
					{*}[dict get $trace cmdprefix] [
						namespace current] $op $entity $attribute $index $value
				}
			} finally {
				incr system -1 
			}
		}}


		variable doc::dget {
			description {
				like [get] , but $path is processed as described for [dset] .
			}
		}
		proc dget {entity path args} {db transaction {
			if {![llength $args] && [llength $path]} {
				lappend args [lindex $path end]
				set path [lrange $path[set path {}] 0 end-1]
			}
			while {[llength $path]} {
				set path [lassign $path[set path {}] arg]
				if {[array_ exists $entity $arg]} {
					set path [lassign $path[set path {}] index]
					if {[array_ exists $entity $arg $index]} {
						set entity $index
					} else  {
						error [
							list {no such index in array} $index]
					}
				} else {
					set entity [set_ $entity $arg]
				}
			}
			get $entity {*}$args
		}}


		variable doc::ddestroy {
			description {
				Like [unset entity] , but follows $path to the entity to unset
				.  And also unsets the attribute in $path that referenced the
				entity (the penultimate item in $path)
			}
		}
		proc ddestroy {entity args} {db transaction {
			set entity [dget $entity [lrange $args 0 end-1] [lindex $args end]]
			dunset $entity [lrange $args 0 end-1] [lindex $args end]
			unset_ $entity
		}}


		variable doc::dexists {
			description {
				Like [exists], but $path is processed as described for [dset]
			}
		}
		proc dexists {entity path args} {db transaction {
			try {
				dget $entity $path {*}$args
			} on error {cres copts} {
				switch [lindex $cres 0] {
					{no such index in array} - {no such attribute} 
						- {no such attributes} {
						return 0
					}
					default {
						return -options $copts $cres
					}
				}
			}
			return 1
		}}


		variable doc::dinsert {
			summary {
				Deep [insert]
			}
			description {
				Like [insert]
					but follows $path to the target entity
					
					the first item in $path is the starting entity, and each
					subsequent item is an attribute whose value is the next
					entity 
			}
		}
		proc dinsert {entity path args} {
			dset2 $entity insert $path {*}$args
		}


		variable doc::dset {
			summary {
				Deep [set]
			}
			description {
				like [set]
					but follows $path to the target entity

				the first item in $path is the starting entity

				each subsequent item is an attribute whose value is the
				identifier of the next entity
			}
		}


		proc dset {entity path args} {
			dset2 $entity set_ $path {*}$args
		}
		proc dset2 {entity op path args} {db transaction {
			set index 0 
			foreach arg $path {
				if {![exists $entity $arg]} break 
				set entity [set_ $entity $arg]
				incr index
			}
			if {$index < [llength $path]} {
				if {![llength $args]} {
					error [list {unknown attribute} [lindex $path $index]]
				}
				foreach arg [lrange $path $index end-1] nextarg [
					list {*}[lrange $path $index+1 end]] {
					set newentity [set_ {} $nextarg {}]
					set_ $entity $arg $newentity
					set entity $newentity
				}
				set args [lassign $args[set args {}] attribute val]
				set newentity [set_ {} $attribute $val]
				set_ $entity [lindex $path end] $newentity
				set entity $newentity
				if {[llength $args]} {
					$op $entity {*}$args
				}
				return $entity
			} else {
				$op $entity {*}$args
			}
		}}


		variable doc::dunset {
			description {
				like [unset], but $path is processed as described for [dset]
			}
		}
		proc dunset {entity path args} {db transaction {
			if {![llength $args] && [llength $path]} {
				lappend args [lindex $path end]
				set path [lrange $path[set path {}] 0 end-1]
			}
			if {[llength $path]} {
				# Use [dset] here, not [dget] .
				lappend newpath $entity
				set entity [dset $entity [lrange $path 0 end-1] [lindex $path end]]
			}
			unset_ $entity {*}$args 
		}}


		variable doc::ensure {
			description {
				If no entity exists with the specified attributes and values ,
				a new one is created .
			}
			value {
				The last entity having attribute $attribute and value
				$value .
			}
		}
		proc ensure args {db transaction {
			set args2 {}
			foreach {attribute value} $args {
				lappend args2 == $attribute $value
			}
			set entities [find {} {*}$args2]
			if {![llength $entities]} {
				lappend entities [set_ {} {*}$args]
			}
			return [lindex $entities end]
		}}


		variable doc::entities {
			description {
				Returns the number of entities in the database
			}
		}
		proc entities {} {db transaction {
			db eval {select count(*) from (select distinct e from eav)}
		}}


		if 0 {
			to do

			[except] should either be moved to a generic sql utility package or
			should be reimplemented to operate on [find] specifications rather
			than [gen] specificaionts

				i.e. [except] should be performed on the output of the report
				query 

			the "except" operator to [gen] already provides most (all?) of the
			functionality that this [except] routine provides
		}
		variable doc::except {
			description {
				Uses combine to compose a except query of [gen] queries and
				execute it via [findm]. 
			}
		}
		proc except {report args} {
			uplevel 1 [list [
				namespace which combine_do] except $report {*}$args]
		}


		variable doc::exists {
			description {
				Efficiently determine whether an entity exists , or whether an
				attribute for a certain etity exists .  For more flexibility ,
				see [find] .
			}
		}
		proc exists {entity args} {db transaction {
			if {[llength $args]} {
				lassign $args attribute
				return [db exists {
					select 1 from eav where e == :entity
						and a == :attribute}]
			} else {
				return [db exists {
					select 1 from eav where e == :entity
					}]
			}
		}}


		proc field_sql {resvar datavar fieldvar} {
			upvar $resvar res
			upvar $datavar data
			upvar $fieldvar field
			set res {}
			switch [llength $field] {
				1 {
					lappend res [lindex $field 0]
				}
				0 {
					error {not enough arguments}
				}
				2 {
					lappend res "[lindex $field 1] as [
						lindex $field 0]"
				}
				default {
					gen_query sql2 data [lindex $field 1]
					lappend res "( {*}$sql2 ) as [
						lindex $field 0]"

				}
			}
			return
		}


		proc fields_sql {sqlvar fieldsvar datavar} {
			upvar $sqlvar sql $fieldsvar fields $datavar data
			if {[info exists fields]} {
				foreach field $fields {
					field_sql sqlfield data field
					lappend sqlfields {*}$sqlfield
				}
			} else {
				lappend sqlfields *
			}

			if {![llength $sqlfields]} {
				error [list {no fields}]
			}
			lappend sql {*}[join $sqlfields { , }]
			return
		}


		variable doc::find {
			description {
				A wrapper over [gen] and [findm].  Selects entities based on
				some critera , and report the requested attributes . If a
				matching entity is missing some attribute specified in $report,
				that attribute will be missing in the results. 

				See also, [or] .


			}
			args {
				args {
					report {
						description {
							names of attributes to include in the result 
							a name may be

								an asterisk (*)
									indicates all attributes

								the empty string
									indicates the identifier for the entity
									itself
						}
					}
					args {
						search criteria
							a seqence of operations

								each operation is composed of 

									an operator

										defines its own semantics for some
										number subsequent arguments

						If there is only one arg
							it is the name of an attribute




						operators

							behaviours

								description

									behaviours are not necessarily
									mutually-exclusive

								list of behaviours

									compositor

										the operator uses new data to transform the
										structure

									developer

										the operator transforms a structure 
										into some abitrary structure

									expander

										the operator transforms a structure 
										by adding pieces onto it

									trimmer

										the operator transforms a structure by
										removing pieces of it

								


							list

								{== >  < - !=}  {
									description {
										The next argument is the name of an
										attribute , and the argument after that is
										the value of the attribute .
									}
								}

								ascend {
									description {
										given an entity
											follows an attribute of that entity
												recursively

										example

											child == name Bob 

												for entities having the name
													Bob
												follows any attributes
													named child 
														where the value corresponds
														to the attribute named
															child
														of another entity
									}
								}

								descend {
									description {

										given an entity

											find things that have that entity as a
											given attribute

												recursively

										Selects matching records from a hierarchy
										of entities . The next argument is the name
										of an attribute to descend on .  The
										argument after that is an operator
										indicating how the descent attribute in a
										candidate node must match the key argument
										in the parent node . The argument after
										that is the name of the key attribute in
										the parent node , which is matched using
										the same operator as for the key attribute
										in a candidate node . The argument after
										that is the value descent attribute in a
										root must match .

										For example
										
											parent == name Bob

										indicates that an entity having a "parent"
										attribute of Bob is a root node in the
										hierarchy , and that the "parent" attribute
										of a child entity == the value of the
										"name" attribute in its parent .

										This operator changes the default sort
										order of the results to "depth". To set it
										to "breadth" or the normal "rowid" , use
										the "order" operator .
										
									}
								}

								entity {
									description {
										Selects certain entities.  The next
										argument is an operator, and the subsequent
										operand is a natural number.
									}
								}

								eval {
									description {
										The next argument is a variable name to 
										pass to [db eval] of sqlite,  and the
										argument after that is a script. 

										The variables from the database are "id",
										"e", "a", and "v".
									}
								}

								exists {
									description {
										The next argument is the name of an
										attribute.  Only entities that have a
										record for the indicated attribute are
										selected.
									}
								}

								id {
									description {
										Selects certain records.
										The next argument is an operator, and the
										subsequent operand is a natural number.
									}
								}

								is {
									
									description {
										The next argument expresses some quality of
										the attribute , and the argument after
										that is the name of an attribute .
									}
									entity {
										The next argument identifies the entity.
									}
									qualities {
										missing {
											The entity does not have such an
											attribute .
										}
									}
								}

								like {
									description {
										The next argument is the name of an
										attribute , and the argument after that is
										a pattern to match .
									}
								}

								matching {
									description {
										constrain results to those entities whose
										values for the given set of attributes are
										not unique in the eav .
									}
								}

								order {
									description {
										A list of operators specifying the sort
										order of the results . By default , results
										are in the order of insertion . 

										operators

											depth {
												description {
													If a "descend" operator is
													present , results are in
													hierarchical order,
													depth-first.
												}
											}

											breadth {
												description {
													If a "descend" operator is
													present , results are in
													hierarchical order,
													breadth-first. 
												}
											}

											attribute {
												description {
													The next item in the list is
													the attribute to sort on.  If
													the item after that is "asc" or
													"desc", it indicates whether
													the sort is ascending or
													descending .
												}
											}

									}
								}
					}
				}
			}
		}
		proc find {report args} {
			set t1name [namespace current]::[info cmdcount]_find_t1name
			if {[llength $args] == 1} {
				set args [list entity == $report[
					set report [lindex $args 0]; list]]
			}
			transform .new $t1name 
			try {
				lassign [uplevel 1 [
					list [namespace current]::gen $t1name {*}$args]]
				set report [report $report $t1name]
				uplevel 1 [list [namespace which findm] $report $t1name]
			} finally {
				unset $t1name
			}
		}


		variable doc::findm {
			description {
				accepts one or more queries
					as produced by [gen]

					stitches them together to form a union query with the
					semantics of SQL's "union"
						as opposed to "union all" operation

				If multiple "script" operators are given, only the last one  is
				effective. 
			}
			args {
				args {
					description {
						The first item is a query like the second to last items
						in the list returned by [find].  The second item is a
						SQL compoound select operator such as "union", "union
						all", "intersect", or "except".

					}
				}
			}
		}
		proc findm {report transformvar} {db transaction {
			upvar $transformvar transform
			set tables [dict get $transform tables]
			findm_prepare data sql $report $tables
			dict with data {}
			if {[info exists script]} {
				set res2 {}
				set res [db eval $sql]
				if {[info exists recordvar]} {
					upvar $recordvar recordvarvar
					db eval $sql recordvarvar [list uplevel 1 $script]
				} else {
					db eval $sql recordvarvar "
						foreach {key val} \[array get recordvarvar] {
							uplevel 1 \[list set \$key \$val]
						}
						uplevel 1 [list $script]
					"
				}
			} else {
				set res2 [db eval $sql]
				if {[dict exists $transform flat]
					&& [dict get $transform flat]} {
					flatten res2
				}
			}
			return $res2
		}}


		proc findm_filter_matching {attname tablename} {
			list $tablename.e in ( \
				select filter.e from $tablename as filter \
				where \
					filter.a = {*}[lossless :$attname] \
					and filter.v == ( \
						select v from $tablename as filter2 \
						where \
						filter2.e = $tablename.e \
						and filter2.a = {*}[lossless :$attname] \
					) \
				order by filter.e limit -1 offset 1 \
			)
		}


		proc findm_prepare {datavar queryvar report queries} {
			upvar $datavar finaldata $queryvar query

			set selects {}
			set finaldata {}

			gen_tables_sql queries sql finaldata

			if 0 {
				foreach {tablename select} $select[set select {}] {
					dict with data {}

					if 0 {
						previously
							complete select statements were passed to this routine

							when the strategy changed to passing table
							specifications to compose with clause from

							this bit became obsolete

								# Skirt the issue of SQLite constraints on things like ORDER BY
								# rules in compound select statements by encapsulating each
								# statement as its own subquery
								lappend selects "select * from ($select) as eav"
					}
					lappend selects "$tablename as  ( $select )" 
				}
			}

			append query with { } recursive { } [join $sql { , }]
			gen_query finalreport finaldata $report
			append query { } $finalreport
			return
		}


		proc flatten varname {
			upvar $varname var
			set res {}
			foreach {id e a v p l} $var[set var {}] {
				dict update var $e entity {
					lappend entity $a $v
				}
			}
			return
		}


		proc function args {
			namespace eval :: $args
		}

		variable doc::gen {
			description {

				Generate a SQL query and a dictionary containing the data it
				references .

			}
			args {
				counts {
					description {

						The next numbers available for forming unique data
						variable names .  Use {0 0} for the first call to
						[gen], and whatever [gen] produces for subsequent
						calls.

					}
				}

				report {
					description {
						Same as for [find] .
					}
				}

				args {
					description {
						Same as for [find] .
					}
				}
			}
			value {
				A list containing three items

					counts

						Pass to to other [gen] commands to avoid name
						collisions . 

					query

						The generated Query .

					data

						A dictionary containing data referenced by the query .
						To import the data into the current level , pass it to
						[dict with] .
			}
		}


		proc gen {transformvar args} {
			variable system
			variable systemattribute

			# To do:  With a little bookkeeping, it should be possible to
			# massage this code into allowing the caller to specify attributes
			# to sort on , and in ascending or descending order . 

			upvar 1 $transformvar transform
			set counts [dict get $transform counts]

			set computed 0
			set limit -1 
			set missing {}
			set offset {}
			set breadthdepth desc
			lassign $counts i j
			if {$i > 0} {
				set eavtable oldeav$i
			} else {
				set eavtable eav
			}
			set exceptspecs {}
			set filters {}
			set orders {}
			set sort asc
			set subqueries {}
			set union {}
			set with {}
			set oldeav oldeav[incr i]

			set tables [dict get $transform tables]
			set tableroot eav


			if {[llength $counts] > 2} {
				set tablename [lindex $counts 2]
			} else {
				set tablename $tableroot
			}
			set mytablename $tableroot[incr i]
			set query [dict create name $mytablename tables [
				dict create $tablename {}] fields {} terms {} data {}]
			if {$tablename eq $tableroot} {
				# make the original table a table with a level and a parent
				query_defaultfields query $tableroot

				if {!$system} {
					set attname [gen_query_data_add query $systemattribute] 
					set term [list $tableroot.e not in ( \
						select e from $tableroot  \
						where \
							a == {*}[lossless :$attname] \
							and \
							v == {*}[lossless :$attname]) \
					]
					gen_query_term_add query term
				}

				gen_query_finished transform i tables $tableroot tablename \
					mytablename query 1
			}
			set origtablename $tablename

			set queryfinished 1
			set chain 1
			while {[llength $args]} {
				set args [lassign $args[set args {}] arg]
				set chain 1
				set entjoin ==
				if {$computed == 1} {
					incr computed
				} elseif {$computed ==2} {
					set computed 0
				}
				set query1 {}
				set term {}
				set join1 {}
				set entity 0
				set queryfinished 1
				set union1 {}
				if 0 {
					to do

					add $ tablename subtitution to more operations
				}
				switch $arg {
					| {
						set computed 1
						set queryfinished 0
					}
					== - > - >= - < - <= - != - like {
						set args [takeargs $args[set args {}] attribute pattern]
						set attname [gen_query_data_add query $attribute] 
						if {$pattern eq {$}} {
							set args [takeargs $args[set args {}] tablename2]
							set query1 [list $tablename.e in ( \
									select e from $tablename t2 where \
										t2.a = {*}[lossless :$attname] \
										and t2.v $arg  \
										( select * from $tablename2 ) \
								) \
							]
						} else {
							set query1 [list $tablename.e in ( \
								select $tablename.e from $tablename \
									where $tablename.a = {*}[
								lossless :$attname] and $tablename.v $arg]

							set pattname [gen_query_data_add query $pattern] 
							lappend query1 {*}[lossless :$pattname]
							lappend query1 )
						}
						gen_query_term_add query query1
						gen_query_finished transform i tables $tableroot \
							tablename mytablename query 1
					}

					as {
						set args [takeargs $args[set args {}] arg]
						#lassign $arg as$i func attribute$i
						lassign $arg as func attribute
						set attname [gen_query_data_add query $attribute] 
						set asname [gen_query_data_add query $as] 

						set term1 [list a != {*}[lossless :$asname]]
						gen_query_term_add query term1

						set table1 $mytablename

						gen_query_finished transform i tables $tableroot \
							tablename mytablename query 0

						set term1 [list a = {*}[lossless :$attname]]
						gen_query_term_add query term1

						switch $func {
							max {
								set vexpr [list \
									( select ${func}(t2.v) \
										from $tablename as t2 \
										where a = {*}[lossless :$attname] \
									) 
								]
							}
							abs - hex - length - lower - max - trim - upper {
								set vexpr [list ${func}($tablename.v)]
							}
							default {
								error [list {unknown function} $func]
							}
						}
						newfields newfields [
							dict get [lindex $tables end] fields]
						gen_as_newfields newfields $as $vexpr
						dict set query fields $newfields
						set union1 [list select * from $table1]
						dict lappend query unions $union1
					}


					ascend {
						set args [takeargs $args[set args {}] ascend]
						set ascend [uplevel 1 [namespace which list] $ascend]
						set ascend [takeargs $ascend[
							set ascend {}] follow op pattern]
						set followname [gen_query_data_add query $follow] 
						if {$op eq {entity}} {
							#dict set query distinct 1
							set op $pattern
							set ascend [takeargs $ascend[set ascend {}] pattern]
							set patternname [gen_query_data_add query $pattern] 
							dict set query spec {
								e parent level path
							} 
							dict set query fields [list  \
								$tablename.v [list p [list ( \
									select v from $tablename as t1 \
										where t1.e = $tablename.v \
										and a = {*}[lossless :$followname] \
								)]] 0 {{printf(' %s ' ,e)}} \
							]
							set term1 [list $tablename.e = {*}[
								lossless :$patternname]]
							gen_query_term_add query term1
							set term1 [list a = {*}[lossless :$followname]]
							gen_query_term_add query term1

							if 0 {
								to do

								add breadthdepth control here 
							}
							set union1 [list \
								select $tablename.v ,( \
									select v from $tablename as t1 \
										where t1.e = $tablename.v \
										and a = {*}[lossless :$followname] \
								) ,$mytablename.level+1 \
									, printf(' %s %s ' ,$mytablename.path ,v) \
										from $tablename join $mytablename using(e) \
								where $tablename.a = {*}[lossless :$followname] \
								and instr($mytablename.path ,printf(' %s ' ,$tablename.v)) == 0 \
							]
							dict lappend query unions $union1
							dict lappend query order [list 3]
							#dict lappend query order [list 3 {*}$breadthdepth]
							gen_query_finished transform i tables $tableroot \
								tablename mytablename query 1

							dict set query fields [list \
								$tablename.e $tablename.parent \
								$tablename.level \
								[list rownum [list row_number() over ()]] \
								$tablename.path \
							]

							gen_query_finished transform i tables $tableroot \
								tablename mytablename query 1

							set jterm [list $origtablename.e = $tablename.e]
							lappend jterms $jterm
							dict set join1 terms $jterms

							dict set query tables $tablename join [list $origtablename $join1]

							dict set query fields [list \
								$origtablename.id $origtablename.e \
								$origtablename.a $origtablename.v  \
								$tablename.parent $tablename.level \
								[list rownum [list ( \
									select min (t2.rownum) \
									from $tablename as t2  \
									where $tablename.e = t2.e \
								) ]] \
								$tablename.path \
							]

							transform add transform order [
								list $mytablename rownum]
							#gen_query_finished transform i tables $tableroot \
							#	tablename mytablename query 0


							if 0 {
								# the old version
								lappend join1 ( with recursive \
									r$i\(e ,parent ,level ,path) as ( \
										select v  ,( \
											select v from $oldeav as eav1 \
												where eav1.e = $oldeav.v \
												and a = {*}[lossless :follow$i] \
										) ,0 ,printf(' %s ' ,e) \
										from $oldeav where e = {*}[lossless :$patternname] \
											and a = {*}[lossless :follow$i] \
										union \
										select $oldeav.v ,( \
											select v from $oldeav as eav1 \
												where eav1.e = $oldeav.v \
												and a = {*}[lossless :follow$i] \
										) ,r$i.level+1 \
											, printf(' %s %s ' ,r$i.path ,v) \
												from $oldeav join r$i using(e) \
										where $oldeav.a = {*}[lossless :follow$i] \
										and instr(r$i.path ,printf(' %s ' ,$oldeav.v)) == 0 \
										order by 2 \
									) \
								select r$i.e, parent, level from r$i \
								order by r$i.level \
								) as eav$i on $oldeav.e == eav$i.e
							}
						} else {
							set attribute $pattern
							set attname [gen_query_data_add query $attribute] 
							set ascend [takeargs $ascend[set ascend {}] pattern]
							set patternname [gen_query_data_add query $pattern] 
							dict set query spec {
								e name parent level path
							} 
							dict set query fields [list \
								$tablename.e $tablename.v [list p [list ( \
									select e from $tablename as t1 where \
										a = {*}[lossless :$attname] and \
										t1.v = ( \
											select v from $tablename as t2 \
											where e = $tablename.e \
											and a = {*}[lossless :$followname] \
										) \
									) \
								]] 0 {{printf(' %s ' ,e)}} \
							]

							set term1 [list $tablename.a = {*}[
								lossless :$attname]]
							gen_query_term_add query term1
							set term1 [list \
								$tablename.v = ( \
									select v from $tablename \
									where a = {*}[lossless :$followname] \
									and e in ( \
										select e from $tablename \
										where a = {*}[lossless :$attname] \
										and v = {*}[lossless :$patternname] \
									) \
								) \
							]
							gen_query_term_add query term1

							set union1 [list  \
								select $tablename.e ,$tablename.v ,( \
									select e from $tablename as eav1 where \
										e != $tablename.e \
										and a = {*}[lossless :$attname] \
										and v = ( \
											select v from $tablename as eav2 \
											where e = $tablename.e \
											and a = {*}[
												lossless :$followname] \
										) \
									) ,$mytablename.level+1 \
									, printf(' %s %s ' ,$mytablename.path ,v) \
									from $tablename ,$mytablename  \
									where \
									$tablename.e = $mytablename.parent \
									and a = {*}[lossless :$attname] \
									and instr( \
										$mytablename.path \
										,printf(' %s ' ,$tablename.v) \
									) == 0 order by 4 \
							]
							dict lappend query unions $union1
							gen_query_finished transform i tables $tableroot \
								tablename mytablename query 1

							dict set query fields [list \
								$tablename.e $tablename.parent \
								$tablename.level \
								[list rownum [list row_number() over ()]] \
								$tablename.path \
							]


							gen_query_finished transform i tables $tableroot \
								tablename mytablename query 1

							dict set query tables $origtablename {}

							dict set query fields [list \
								$origtablename.id $origtablename.e \
								$origtablename.a $origtablename.v  \
								$tablename.parent $tablename.level \
								[list rownum [list ( \
									select min (t2.rownum) \
									from $tablename as t2  \
									where $tablename.e = t2.e \
								) ]] \
								$tablename.path \
							]
							set term1 [list \
								$origtablename.e = $tablename.e
							]
							gen_query_term_add query term1


							transform add transform order [
								list $mytablename rownum]
						}
					}

					att {
						set args [takeargs $args[set args {}] attribute]
						dict set query fields v 
						if {$attribute eq {$}} {
							set args [takeargs $args[
								set args {}] tablename2 attribute]
							set attname [gen_query_data_add query $attribute] 
							dict set query tables [dict create $tablename2 {}]
							set term1 [list $tablename2.a = :$attname]
							gen_query_term_add query term1
							set chain 0
							set queryfinished 0
						}  else {
							error [list what are we doing in this branch?]
							set attname [gen_query_data_add query $attribute] 
							set term1 [list $tablename.a = :$attname]
							gen_query_term_add query query1
						}
					}

					descend {
						# Until such time as SQLite detects cycles, the
						# limits in the queries below guard against cycles
						# Update: Now using printf and path to detect cycles
						#set dlimit 1000 
						set dlimit -1
						set args [takeargs $args[set args {}] descend]
						if {$descend eq {limit}} {
							set args [takeargs $args[set args {}] dlimit descend]
						}
						set descend [uplevel 1 list $descend]
						if {[llength $descend] == 4} {
							lassign $descend \
								follow op attribute pattern

							set followname [gen_query_data_add query $follow] 
						} elseif {[llength $descend] == 3} {
							lassign $descend \
								op attribute pattern
						} else {
							error [list {wrong # args}]
						}

						# In the queries below, the initial values for both
						# level and parent must be 0 so that they match the
						# output of non-recursive selects when they are used
						# in complex queries, i.e. those involving "except" .

						# If tempted to add additional sorting, beware of 
						# breaking hierarchically-ordered results .

						set patternname [gen_query_data_add query $pattern] 

						dict set query distinct 1
						# rownum is a dummy here
						# the next query provides the rownum of this traversal
						dict set query spec {
							id e a v parent level rownum path
						} 
						dict set query fields [list  \
								$tablename.id $tablename.e $tablename.a \
								$tablename.v 0 0 0 \
								{{printf(' %s ' ,e)}} \
						]

						if {$op eq {entity}} {
							set realop $attribute
							if {$realop ni {!= ==}} {
								error [
									list {operator should be ==} not $realop]
							}
						} else {
							set realop $op
						}

						if {[info exists followname]} {
							dict lappend query terms [list \
								$tablename.e in ( \
									select e from $tablename \
									where \
									a = {*}[lossless :$followname] \
									and v $realop {*}[lossless :$patternname] \
								)
							]
						} else {
							dict lappend query terms [list \
								$tablename.e in ( \
									select e from $tablename \
									where \
									v $realop {*}[lossless :$patternname] \
								)
							]
						}

						set union1 [list \
							select distinct $tablename.id ,$tablename.e ,$tablename.a \
								,$tablename.v ,$mytablename.e ,$mytablename.level+1 \
								,0 ,printf(' %s %s ' ,$mytablename.path ,$tablename.e) \
							from $tablename , $mytablename where \
						]

						if {$op eq {entity}} {
							if {[info exists followname]} {
								lappend union1 \
									$tablename.e in ( \
										select e from $tablename as t2 where \
										t2.a = {*}[lossless :$followname] \
										and t2.v $realop $mytablename.e \
									)
							} else {
								lappend union1 \
									$tablename.e in ( \
										select e from $tablename as t2 where \
										t2.v $realop $mytablename.e \
									)
							}
						} else {
							set attributename [gen_query_data_add query $attribute] 

							lappend union1 \
								$mytablename.a = {*}[lossless :$attributename] \
								and exists ( \
									select * from $tablename as t2 \
									where t2.e == $tablename.e \
									and t2.a = {*}[lossless :$followname] \
									and t2.v $realop $mytablename.v \
								) 
						}
						lappend union1 and instr($mytablename.path , \
							printf(' %s ' ,$tablename.e) ) == 0
						dict lappend query unions $union1
						dict lappend query order [list 6 {*}$breadthdepth]
						dict set query limit $dlimit

						gen_query_finished transform i tables $tableroot \
							tablename mytablename query 1

						dict set query fields [list \
							$tablename.id $tablename.e $tablename.a $tablename.v  \
							$tablename.parent $tablename.level \
							[list rownum [list row_number() over ()]] \
							$tablename.path \
						]

						gen_query_finished transform i tables $tableroot \
							tablename mytablename query 1

						dict set query fields [list \
							$tablename.id $tablename.e $tablename.a $tablename.v  \
							$tablename.parent $tablename.level \
							[list rownum [list ( \
								select min (t2.rownum) \
								from $tablename as t2  \
								where $tablename.e = t2.e \
							) ]] \
							$tablename.path \
						]

						transform add transform order [
							list $mytablename rownum]
						if 0 {
							to do

							can this call to gen_query_finished be deleted?
						}
						gen_query_finished transform i tables $tableroot \
							tablename mytablename query 0

					}

					duplicated {
						set args [takeargs $args[set args {}] attribute]
						set attname [gen_query_data_add query $attribute]
						set query1 [findm_filter_matching $attname $tablename]
						gen_query_term_add query query1
						gen_query_finished transform i tables $tableroot \
							tablename mytablename query 1
					}

					entity {
						set args [takeargs $args[set args {}] attribute pattern]
						set pattname [gen_query_data_add query $pattern] 
						switch $attribute {
							== - > - >= - < - <= - != - like {
								lappend query1 $tablename.e $attribute {*}[
									lossless :$pattname]
								gen_query_term_add query query1
							}
							default {
								error [list {unknown operator} $attribute]
							}
						}
					}

					eval {
						set args [takeargs $args[set args {}] recordvar script]
						dict set query data script $script
						if {$recordvar ne {}} {
							dict set query data recordvar $recordvar
						}
					}

					except {
						set args [takeargs $args[set args {}] exceptspec]
						set tname [namespace current]::[
							info cmdcount]_gen_except 
						transform .new $tname 
						try {
							transform set $tname counts [list $i $j {*}[
								lrange $counts 2 end]]
							gen $tname {*}$exceptspec 
							set newtables [dict get [set $tname] tables]
							transform set $transform tables $newtables
							set newcounts [dict get [set $tname] counts]
							lassign $newcounts i j
							transform set $transform counts [list $i $j {*}[
								lrange $counts 2 end]]

							set report [report * $tname]
						} finally {
							unset $tname
						}
						findm_prepare newdata newsql $report $newtables
						dict set query data [dict merge [
							dict get $query data] $newdata]
						set rtable [lindex $newtables end-1]
						set query1 [list $tablename.e not in ( \
							 select e from ( {*}$newsql ) \
						 ) ]
						gen_query_term_add query query1
					}

					exists {
						set args [takeargs $args[set args {}] attribute]
						set attname [gen_query_data_add query $attribute] 
						set query1 [list $tablename.e in ( \
							select e from $tablename \
							where a == {*}[lossless :$attname] \
						)]
						gen_query_term_add query query1
					}

					id {
						set args [takeargs $args[set args {}] attribute pattern]
						set pattname [gen_query_data_add query $pattern] 
						switch $attribute {
							== - > - >= - < - <= - != - like {
								set term1 [list $tablename.id $attribute {*}[
									lossless :$pattname]]
									gen_query_term_add query term1
							}
							default {
								error [list {unknown operator} $attribute]
							}
						}
					}

					in {
						set args [lassign $args[set args {}] attribute pattern]
						set attname [gen_query_data_add query $attribute] 
						foreach inpattern $pattern {
							set pattname [gen_query_data_add query $inpattern] 
							lappend query1 [list $tablename.e in  ( \
								select e from $tablename as t2 \
								where t2.a == {*}[lossless :$attname] \
								and t2.v == {*}[lossless :$pattname] ) ]
						}
						set query1 ([join $query1 { or }])
						gen_query_term_add query query1
					}

					is {
						set args [lassign $args[set args {}] attribute$i pattern$i]
						switch [set attribute$i] {
							missing {
								lappend missing :pattern$i
							}
							default {
								error [list {unknown pattern for "is"} [
										set attribute$i]]
							}
						}
					}

					limit {
						set args [lassign $args[set args {}] limit]
						if {[dict exists $query offset]} {
							gen_query_finished transform i tables $tableroot \
								tablename mytablename query 1
						}
						dict set query limit $limit
						set queryfinished 0
					}

					offset {
						set args [takeargs $args[set args {}] offset]
						if {[dict exists $query offset]} {
							gen_query_finished transform i tables $tableroot \
								tablename mytablename query 1
						}
						dict set query offset $offset
						set queryfinished 0
					}

					order {
						set args [takeargs $args[set args {}] neworder]
						if 0 {
							to do

							isn't this routine mixing up two different "order"
							controls?
						}
						switch $neworder {
							depth {
								set breadthdepth desc
							}
							breadth {
								set breadthdepth {}
							}
							default {
								dict lappend transform userorder [
									list $tablename {*}$neworder]
							}
						}
					}

					sort {
						set args [takeargs $args[set args {}] neworder]
						switch [lindex $neworder end] {
							asc - desc {
								transform add transform userorder [
									list $tablename {*}$neworder]
							}
							default {
								error [list {unknown order} $neworder]
							}
						}
					}

					walk {
						set args [takeargs $args[set args {}] follow]
						set followname [gen_query_data_add query $follow] 


						dict set query spec {
							id e a v parent level
						} 
						dict set query fields [list $tablename.id \
							$tablename.e $tablename.a $tablename.v \
							$tablename.parent [list level 0]]
						set term1 [list $tablename.e in ( \
							select t2.v from $tablename as t2 \
							where t2.e in ( \
									select t3.e from $tablename as t3 \
									where t3.e = {*}[lossless :$followname] \
								) \
							)  \
						]
						gen_query_term_add query term1 
						#dict lappend query order [list $tablename.e] [
						#	list $tablename.id]

						set union1 [list all \
							select distinct $tablename.id ,$tablename.e \
								,$tablename.a ,$tablename.v ,$mytablename.e \
								,$mytablename.level + 1 \
								from $tablename ,$mytablename \
								where $tablename.e = $mytablename.v \
								order by $tablename.e ,$tablename.id]

						dict lappend query unions $union1

						gen_query_finished transform i tables $tableroot \
							tablename mytablename query 1


						if 0 {
							to do

								add cycle detection
						}
						dict set query fields [list \
							$tablename.id $tablename.e $tablename.a $tablename.v  \
							$tablename.parent $tablename.level \
							[list rownum [list row_number() over ()]] \
						]

						transform add transform order [
							list $mytablename rownum]
					}

					default {
						error [list {unknown operator} $arg]
					}
				}
				if {$query1 ne {}} {
					lappend join inner join $oldeav as eav$i on \
						$oldeav.e $entjoin eav$i.e and {*}$query1
				}
				if {$join1 ne {}} {
					lappend join join {*}$join1
				}
				if {$union1 ne {}} {
					lappend union $union1
				}
				incr i

				if {$queryfinished} {
					gen_query_finished transform i tables $tableroot \
						tablename mytablename query $chain
				}
			}

			if {!$queryfinished} {
				gen_query_finished transform i tables $tableroot tablename \
					mytablename query $chain 
			}


			if 0 {
				to do

				make sure $join is properly processed
			}

			transform set transform counts [
				list $i $j {*}[lrange counts 2 end]]
			transform set transform tables $tables
			return
		}


		proc gen_as_newfields {newfieldsvar as vexpr} {
			upvar $newfieldsvar newfields
			foreach newfield $newfields[set newfields {}] {
				switch [lindex $newfield 0] { 
					a {
						lappend newfields [list a [strquote $as]]
					}
					id {
						lappend newfields [list id 0]
					}
					v {
						if 0 {
							to do

							eliminate this join somehow
						}
						lappend newfields [list v [join $vexpr]] 
					}
					default {
						lappend newfields $newfield
					}
				}
			}
		}


		proc gen_as_newfields2 {newfieldsvar as vexpr} {
			upvar $newfieldsvar newfields
			foreach newfield $newfields[set newfields {}] {
				switch [lindex $newfield 0] { 
					a {
						lappend newfields [list a [strquote $as]]
					}
					id {
						lappend newfields [list id 0]
					}
					v {
						if 0 {
							to do

							eliminate this join somehow
						}
						lappend newfields [list v [join $vexpr]] 
					}
					default {
						lappend newfields $newfield
					}
				}
			}
		}


		proc gen_orderspec {queryvar tablename orders} {
			upvar $queryvar query
			foreach order1 $orders {
				if {[llength $order1] < 2} {
					error [list [list order should have at least \
						a table name and a column name]]
				}
				if {[llength $order1] > 3} {
					error [list {too many words in order}]
				}
				lassign $order1 otable ocolumn odir
				if {![dict exists tables $otable]} {
					dict set query tables $otable {}
				}
				set term1 [list $tablename.id = $otable.id]
				gen_query_term_add query term1
				set spec $otable.$ocolumn
				dict lappend query order [list $spec {*}$odir]
			}
			return
		}


		proc gen_query {sqlvar datavar qinfo} {
			upvar $sqlvar sql $datavar data
			set sql {}

			set sqlfields {}
			dict update qinfo combine combine distinct distinct \
				fields fields limit limit name name offset offset \
				order order spec spec tables tables terms terms \
				unions unions with with {}

			if {[info exists name]} {
				lappend sql $name 
				if {[info exists spec]} {
					lappend sql ( {*}[join $spec { , }] )
				}
				lappend sql as (
			}

			if {[info exists with]} {
				lappend sql {*}$with
			}

			lappend sql select

			if {[info exists distinct] && $distinct} {
				lappend sql distinct
			}

			fields_sql sql fields data  

			lappend sql from
			set sqltables [list]
			foreach {tablename tinfo} $tables {
				set sqltable {}
				if {[dict exists $tinfo being]} {
					set being [dict get $tinfo being]
					switch [llength $being] {
						1 {
							lappend sqltable [lindex $being 0]
						}
						0 {
							error [list {empty alias}]
						}
						default {
							lappend sqltable ( {*}$being )
						}
					}
					lappend sqltable as $tablename
				} else {
					lappend sqltable $tablename
				}

				if {[dict exists $tinfo join]} {
					foreach {joinname jinfo} [dict get $tinfo join] {
						if {[dict exists $jinfo being]} {
							set alias $joinname
							set joinname [dict get $jinfo being]
						}
						lappend sqltable join
						switch [llength $joinname] {
							0 {
								error [list {empty join}]
							}
							1 {
								lappend sqltable [lindex $joinname 0]
							}
							default {
								gen_query sql2 data $joinname
								lappend sqltable ( {*}$sql2 )
							}
						}
						if {[dict exists $jinfo being]} {
							lappend sqltable as $alias 
						}
						lappend sqltable on
						set jterms [dict get $jinfo terms]
						lappend sqltable {*}[join $jterms { and }]
					}
				}

				if {[llength $sqltable]} {
					lappend sqltables $sqltable
				}
			}
			lappend sql {*}[join $sqltables { , }]

			if 0 {
				limit
					applies
						to entities

						not to individual attributes
			}
			if {[info exists offset]} {
				if {![info exists limit]} {
					set limit -1
				}
				set offset [linsert $offset[set offset {}] 0 offset]
			} else {
				set offset {}
			}
			if {[info exists limit]} {
				lappend terms [list  $tablename.e in ( \
					select distinct e from $tablename limit {*}$limit \
					{*}$offset \
				)]
			}

			if {[info exists terms] && [llength $terms]} {
				lappend sql where (
				lappend sql {*}[join $terms { ) and ( }]
				lappend sql )
			}

			if {[info exists unions]} {
				foreach union $unions {
					lappend sql union {*}$union
				}
			}

			if {[info exists order]} {
				lappend orders {*}[join [lmap order1 $order {
					join $order1 { }
				}] { , }]
			}

			if {[info exists orders]} {
				lappend sql order by  {*}$orders
			}

			if {[info exists combine]} {
				foreach {op table} $combine {
					lappend sql $op select * from $table
				}
			}

			if {[info exists name]} {
				lappend sql )
			}

			if {[dict exists $qinfo data]} {
				set data [dict merge $data[set data {}] [
					dict get $qinfo data]]
			}
			return
		}


		proc gen_query_finished {
			transformvar countervar tablesvar tableroot tablenamevar
			mytablenamevar queryvar chain
		} {
			upvar $countervar counter $mytablenamevar mytablename \
				$tablenamevar tablename $tablesvar tables \
				$queryvar query $transformvar transform
			if {[dict size $query]} {
				if {[dict exists $query fields]} {
					set fields [dict get $query fields]
				}
				if {![info exists fields] || ![llength $fields]} {
					set qtables [dict get $query tables]
					set tablename [lindex [lindex [dict keys $qtables] end] 0]
					#set fields [list $tablename.*]
					set fields [list id e a v parent level path]
					dict set query fields $fields
				}
				lappend tables $mytablename $query
				if {$chain} {
					set tablename $mytablename
					transform table last transform $tablename
				}
				set mytablename $tableroot[incr counter]

				if 0 {
					to do

						don't create a new query here

						and then rewrite the loop in [gen] to be a little less
						awkward
						
				}

				set prev $query
				set query [dict create name $mytablename tables [
					dict create $tablename {}] fields {} terms {} data {}]
				newfields newfields [dict get $prev fields]
				dict set query fields $newfields 
			}
			return
		}


		proc gen_query_data_add {queryvar value} {
			variable counter
			upvar $queryvar query
			set name d_${value}_[incr counter]
			# the counter ensures this transformation doesn't corrupt the input
			# data set
			regsub -all {[^[:alnum:]_]} $name[set name {}] {} name
			dict set query data $name $value
			return $name
		}


		proc gen_query_join_add {queryvar tablename joinname jinfo} {
			upvar $queryvar query
			set tinfo [dict get $query tables $tablename]
			dict lappend tinfo join $joinname $jinfo
			dict set query tables $tablename $tinfo
			return
		}


		proc gen_query_term_add {queryvar componentvar} {
			upvar $queryvar query $componentvar component
			dict lappend query terms $component
			set component {}
			return
		}


		proc gen_tables_sql {tablesvar sqlvar datavar} {
			upvar $tablesvar tables $sqlvar sql $datavar data
			set sql [list] 
			foreach {queryname qinfo} $tables {
				gen_query query data $qinfo
				lappend sql $query
			}
			return
		}


		variable doc::get {
			description {
				Retrieve certain attributes of an entity , as a list, in the
				same order as specified . If there are multiple records for an
				attribute only the last is returned .
			}
		}
		proc get {entity args} {db transaction {
			if {[llength $args]} {
				set res {}
				foreach {id atts} [find $args entity == $entity] { 
					foreach {a v} $atts {
						set idx [lsearch $args $a]
						set args [lreplace $args[set args {}] $idx $idx]
						dict set res $a $v
					}
				}
				if {[llength $args]} {
					error [list {no such attributes} $args]
				}
				return [dict values $res]
			} else {
				set res [dict values [set_ $entity]]
			}
			return $res
		}}


		proc incr_ {entity attribute args} {db transaction {
			variable sql_eav_incr_update
			variable sql_eav_incr_insert
			if {[llength $args]} {
				set count [lindex $args 0]
			} else {
				set count 1
			}
			db eval $sql_eav_incr_update
			if {![db changes]} {
				db eval $sql_eav_incr_insert
			}
			set res [set_ $entity $attribute]
			return $res
		}}


		variable doc::init {
			description {
			}
			args {
				fname {
					description {
						The name of the database file . If not provided , the
						database will be in-memory . 
					}
				}
				dbinit {
					description {
						An initialization routine for the database
					}
				}
				systemattribute {
					description {

						Entities with a record where the attribute is
						$systemattribute are reserved for internal use by the
						system, and can not be accessed by clients using the
						commands that constitute the API to system .

						id (rowid) is guaranteed to be lower for records
						inserted earlier .
					}
				}

				enable_traces {
					description {
						A boolean value that indicates whether traces should be
						enabled .
					}
				}
			}
		}
		proc init args {
			variable system 0
			variable active_traces {} 
			variable systemattribute
			variable enable_traces
			dict update args dbinit dbinit fname fname systemattribute systemattribute {}
			foreach arg [dict keys $args] {
				if {$arg ni {dbinit fname systemattribute}} {
					error [list {unknown argument} $arg]
				}
			}
			if {![info exists fname]} {
				set fname :memory:
			}
			if {![info exists systemattribute]} {
				set systemattribute \x10
			}
			if {![info exists enable_traces]} {
				set enable_traces 1 
			}
			sqlite3 [namespace current]::db $fname
			db function eav [namespace current]::function
			namespace export db
			namespace eval array_ {
				namespace import [namespace parent]::db
			}
			namespace export {}

			if {[info exists dbinit]} {
				db eval $dbinit
			}

			db transaction {
				# autoincrement ensures a monotonic rowid , even in the face of
				# record delteion . eav semantics depend on this monotonic
				# rowid .
				db eval {
					PRAGMA cache_size=-50000
					; create table if not exists eav (
						id integer primary key autoincrement
						, e integer 
						, a text
						, v
					)
					; create index if not exists idx_eav_att on eav (a)
					; create index if not exists idx_eav_att_val on eav
						(a ,v)
					; drop index if exists idx_eav_ent
					; drop index if exists idx_eav_ent_att
					; create index if not exists idx_eav_eav on eav
						(e ,a ,v)
					; create index if not exists idx_eav_ent_val on eav
						(e ,v)
					; create index if not exists idx_eav_val on eav (v)
					; create table if not exists arrays (
						id integer primary key autoincrement
						, record numeric
						, array numeric
						, unique (record , array)
					)
					; create index if not exists idx_arrays_record on arrays (record)
					; create index if not exists idx_arrays_array on arrays (array)
				}

				set state [redpill {
					ensure $systemattribute $systemattribute type eav
				}]
			}
		}


		variable doc::id {
			description {
				Return a unique identifier for the record in the eav table for
				the given attribute of the given entity, or, -1 if there is no
				such attribute.  If both and attribute and a value are
				specified, only an attribute having the specified value
				matches.
			}
		}
		proc id {entity args} {db transaction {
			variable sql_eav_select_by_ea
			variable sql_eav_select_eav
			if {[llength $args] == 2} {
				lassign $args attribute value
				# {to do} {write a test that fails if this isn't ordered by id}
				db eval $sql_eav_select_eav {
					# $id gets set
					# Find the last matching $id
				}
				if {[info exists id]} {
					return $id
				}
				error [list {no id found}]
			} elseif {[llength $args] == 1} {
				lassign $args attribute
				db eval $sql_eav_select_by_ea {
					# $id gets set
					# Find the last matching $id
				}
				if {[info exists id]} {
					return $id
				}
				error [list {no id found}]
			}
			error [list {wrong # args}]
		}}


		proc insert {entity attribute value} {db transaction {
			db eval {
				insert into eav values (NULL ,:entity ,:attribute ,:value)
			}
			set_ $entity $attribute
		}}


		variable doc::intersect {
			description {
				Uses combine to compose a union query of [gen] queries and
				execute it via [findm]. 
			}
		}
		proc intersect {report args} {
			uplevel 1 [list [
				namespace which combine_do] intersect $report {*}$args]
		}


		proc let {transformvar name args} {
			upvar $transformvar transform
			if {[dict exists $transform tables $name]} {
				error [list {already exists} $name]
			}
			if {[dict exists $transform lasttable]} {
				set current [transform table last transform]
			}
			gen transform {*}$args
			if {[info exists current]} {
				transform table last transform current
			} else {
				if {[dict exists $transform lasttable]} {
					dict unset transform lasttable
				}
			}
			set tables [dict get $transform tables]
			set lastname [lindex [dict keys $tables] end]
			if {[dict exists $transform tables $name]} {
				dict unset $transform $tables $lasname 
				error [list {already exists} $name]
			}
			set lasttable [dict get $transform tables $lastname]
			dict set lasttable name $name
			dict set transform tables $name $lasttable
			return
		}


		proc nextentity {} {db transaction {
			# Make sure the cached representation is numeric . Otherwise ,
			# sqlite can end up storing the value as a non-numeric value ,
			# which could cause things like

			if {[db exists {select 1 from eav}]} {
				set entity [
					db onecolumn {select max(e) + 1 from eav}]
			} else {
				set entity [expr 1]
			}
			return $entity
		}}


		proc newfields {resvar fields} {
			upvar $resvar res
			set res {}
			foreach field $fields {
				set field [lindex [
					split [lindex $field[set field {}] 0] .] end]
				lappend res [lindex $field 0]
			}
			return
		}


		variable doc::queriestotables {
			description {
				transform a list of eav queries into a dictionary of sql
				queries
			}
		}
		proc queriestotables {lasttablesvar transformvar exprs} {
			upvar $lasttablesvar lasttables $transformvar transform
			set counts [dict get $transform counts]
			set finaltables [dict get $transform tables]
			while {[llength $exprs]} {
				set exprs [lassign $exprs[set exprs {}] arg]
				set t1name [namespace current]::[info cmdcount]_queriestotables_t1name
				transform .new $t1name 
				transform set $t1name counts $counts
				try {
					gen $t1name {*}$arg
					set counts [dict get [set $t1name] counts]
					set tables [dict get [set $t1name] tables]
				} finally {
					unset $t1name
				}
				lappend finaltables {*}$tables
				lappend lasttables [lindex $tables end-1]
			}
			transform set transform tables $finaltables
			transform set transform counts $counts
			return
		}


		proc query_defaultfields {queryvar from} {
			upvar $queryvar query
			dict set query fields [
				list id e a v {parent 0} {level 0} {path ''}
			]
		}

		proc redpill script {
			variable system
			incr system
			try {
				uplevel 1 $script
			} finally {
				incr system -1
			}
		}


		proc report {report transformvar} {
			upvar 1 $transformvar transform
			set tables [dict get $transform tables]
			#set tablename [lindex $tables end-1]
			set tablename [dict get $transform lasttable] 

			if 0 {
				# useful for testing

				set finaldata {}
				gen_tables_sql tables sql2 finaldata
				dict with finaldata {}
				set sql2 "with recursive [join $sql2 { , }]"
				set t2 [lindex $tables end-3]
				append sql2 \n
				append sql2 [list select * from $t2]
				db eval $sql2 r {
					# debugging statements
				}
			}

			dict set query tables [dict create $tablename {}]
			switch $report {
				* - {} {
					dict set query flat 0
					dict set query fields [list $tablename.id $tablename.e \
						$tablename.a $tablename.v \
						$tablename.parent $tablename.level]
					switch $report {
						{} {
							if 0 {
								to do

								look into what it would take to get rid of
								distinct here
							}
							dict set query distinct 1
							dict set query fields [list $tablename.e]
						}
					}
				}
				default {
					dict set transform flat 1
					dict set query fields [
						list $tablename.id $tablename.e $tablename.a \
							$tablename.v $tablename.parent $tablename.level]
					if {[llength $report]} {
						set orjoins {}
						foreach item $report {
							set valname  [gen_query_data_add query $item] 
							lappend orjoins [list $tablename.a = {*}[
								lossless :$valname]]
						}
						set query1 [join $orjoins { or }]
						gen_query_term_add query query1
					}
				}
			}


			if 0 {
				recursive queries create a traversal order
					rownum preserves this order
				
				$tablename.id provides a critical feature of the system
				    records added later occur later in the results
				    i.e. if an entity as two values for an attribute
				        the most recent value occurs in the results last
			}


			if {[dict exists $transform userorder]} {
				gen_orderspec query $tablename [
					dict get $transform userorder]
			}

			set orders [dict get $transform order]

			if {[llength $orders]} {
				#if {[dict exists tables eav]} {
				#	set query2name eav[incr i]
				#	set query2 [dict create $name $query2name tables eav]
				#	set term1 [list $eav.id = $tablename.id]
				#	gen_query_term_add query2 term1
				#	query_defaultfields query2 eav
				#	dict set tables $query2name $query2
				#}

				gen_orderspec query $tablename $orders
			}

			#dict lappend query order [list $tablename.rownum asc]
			#dict lappend query order [list $tablename.level asc]
			dict lappend query order [list $tablename.e asc]
			dict lappend query order [list $tablename.id asc]
			return $query
		}


		variable doc::revision {
			desciption {
				Execute a command with revision set to $revision .
			}
		}
		proc revision {tmprevision args} {
			variable revision
			set prevrevision $revision
			catch [list uplevel 1 [namespace current] {*}$args] cres copts
			set revision $prevrevision
			return -options $copts $cres
		}


		variable doc::set_ {
			synopsis {
				set entity
				set entity attribute
				set entity attribute value ...
			}

			description {
				Assign or retrieve attributes and values for an entity . If an
				indicated attribute already exists , the new value is assigned
				to all existing records for that attribute . Otherwise , a new
				attribute record is created with that value .
			}

			value {
				The value of the last record for $entity where attribute is
				$attribute , or if no specific attribute is requested , a
				dictionary of attributes and values for the entity .
			}
		}
		proc set_ {entity args} {db transaction {
			variable enable_traces
			variable sql_eav_insert
			variable sql_eav_setvalue
			variable system
			variable systemattribute
			variable sql_eav_select_by_e
			variable sql_eav_select_av_by_e_sysguard
			variable sql_eav_select_id_by_ea
			variable sql_eav_sysguard
			variable sql_eav_select_v_by_ea
			variable sql_eav_select_v_by_ea_sysguard 
			if {[llength $args] == 0} {
				set where [list e == :entity]
				if {$system > 0} {
					# {to do} add something to the test suite for this
					return [db eval $sql_eav_select_by_e]
				} else {
					# Order by id to ensure that the returned list is ordered
					# according to insertion sequence
					set res [db eval $sql_eav_select_av_by_e_sysguard]
					if {![llength $res]} {
						error [list {no such entity} $entity]
					}
					return $res
				}
			} elseif {[llength $args] == 1} {
				set attribute [lindex $args 0]
			} elseif {[llength $args] % 2} {
				error {wrong # args}
			} else {
				if {![string is entier -strict $entity]} {
					set entity [nextentity]
				}
				if {$system < 1 && [db exists $sql_eav_sysguard]} {
					error [
						list {unauthorized attempt to modify a system entity}]
				}
				foreach {attribute value} $args {
					if {$system < 1 && $attribute == $systemattribute} {
						error [list \
							{unauthorized attempt to create a system entity}]
					}
					dotraces write $entity $attribute {} $value

					# Operate on the last matching record
					set id {}
					db eval $sql_eav_select_id_by_ea record {
						set id $record(id)
					}
					if {![string is entier -strict $id]} {
						db eval $sql_eav_insert
					} else {
						db eval $sql_eav_setvalue

						# Even if the new value is the same as the old value
						# the fact that [set_] was called rather than array set
						# indicates that the new value is not a reference to an
						# array .
						array_ unlink $id
					}
				}
				return $entity
			}
			if {$system > 0} {
				set res [db eval $sql_eav_select_v_by_ea]
			} else {
				set res [db eval $sql_eav_select_v_by_ea_sysguard]
			}
			if {![llength $res]} {
				if {![exists $entity]} {
					error [list {no such entity} $entity]
				}
				error [list {no such attribute} $attribute]
			}
			return [lindex $res end]
		}}


		proc takeargs {values args} {
			if {[llength $values] < [llength $args]} {
				error {wrong # args}
			}
			uplevel 1 [list lassign $values {*}$args]
		}


		variable doc::the {
			description {
				like [find]
					but returns an error if there is more than one matching entity
			}
		}
		proc the {names args} {
			set res [dict create] 
			set res [find $names {*}$args]
			if {![llength $names]} {
				if {[llength $res] > 1} {
					error [list {more than one entity found}]
				}
				return [lindex $res 0]
			}
			if {[llength $names] == 1 & [lindex $names 0] eq {*}} {
				flatten res
			}

			if {[dict size $res] == 1} {
				set res2 [lindex [dict values $res] 0]
				if {[llength $names] == 1} {
					switch [lindex $names 0] {
						* {
							return $res2
						}
					}
					return [lindex [dict values $res2] 0]
				} elseif {[llength $names] == 0} {
					switch $names {
						{} {
							return [lindex [dict keys $res] 0]
						}
						default {
							error [list {blank space instead of attributes}]
						}
					}
				}
				return $res2 
			} elseif {[dict size $res] == 0} {
				error [list {entity not found}]
			} else {
				error [list {more than one entity found}]
			}
			error [list {this error is impossible}]
		}


		variable doc::trace_ {
			description {
				Register a trace .

			}
			args {

				op {
					description {
						The operator to set the trace on

						values

							write

							unset
					}
				}

				entity {
					description {
						The id of the entity to call the trace for . The empty
						string indicates any entity .
					}
				}

				attribute {
					description {
						The attribute to call the trace for . The empty string
						indicatesany attribute .
					}
				}

				cmdprefix {
					description {
						A list of words comprising the first part of a command
						to call when the trace is triggered . If cmdprefix is
						empty , the specified trace is removed .
					}
				}

			}
		}
		proc trace_ {op entity attribute cmdprefix} {db transaction {
			variable system
			variable systemattribute
			variable types
			if {$op ni {write unset}} {
				return code error [list {unknown operation} $op]
			}
			redpill {
				if {[llength $cmdprefix]} {
					ensure $systemattribute 1 type trace op $op \
						entity $entity attribute $attribute cmdprefix $cmdprefix
				} else {
					set trace [find {} == type trace == op $op \
						== entity $entity \
						== attribute $attribute exists $systemattribute]
					unset_ $trace
				}
			}
		}}


		variable doc::union {
			description {
				Uses combine to compose a union query of [gen] queries and
				execute it via [findm]. 
			}
		}
		proc union {report args} {
			uplevel 1 [list [
				namespace which combine_do] union $report {*}$args]
		}


		proc unset_ {entity args} {db transaction {
			variable sql_eav_arrays_delete_by_e
			variable sql_eav_arrays_delete_by_ea
			variable sql_eav_arrays_select_by_e
			variable sql_eav_arrays_select_by_ea
			variable sql_eav_delete_by_e
			variable sql_eav_delete_by_ea
			if {[llength $args]} {
				foreach arg $args {
					dotraces unset $entity $arg {} {}
					# Seems reasonable to order descending to delete arrays in
					# reverse order of creation .
					set arrays [db eval $sql_eav_arrays_select_by_ea]
					db eval $sql_eav_arrays_delete_by_ea
					db eval $sql_eav_delete_by_ea
					if {[llength $arrays]} {
						array_ sweep {*}$arrays
					}
				}
			} else {
				dotraces unset $entity {} {} {}
				db transaction {
					set arrays [db eval $sql_eav_arrays_select_by_e] 
					db eval $sql_eav_arrays_delete_by_e 
					db eval $sql_eav_delete_by_e
					if {[llength $arrays]} {
						array_ sweep {*}$arrays
					}
				}
			}
		}}
	}
	$name init {*}$args
	return $name
}


namespace eval transform {
	namespace export *
	namespace ensemble create

	namespace eval . {
		namespace export *

		proc .new datavar {
			upvar 1 $datavar data
			set data [dict create counts {0 0} order {} tables {} \
				tableroot eav]
			return
		}


		proc add {datavar key val} {
			upvar $datavar data
			switch $key {
				order - userorder {
					if {[dict exists $data $key]
						&& $val in [dict get $data $key]} {
						error [list {already exists} $val]
					}
					dict lappend data $key $val
				}
				default {
					error [list {bad key} $key]
				}
			}
		}


		proc merge {t1var t2var} {
			upvar $t1var t1 $t2var t2
			if {[dict exists $t2 counts]} {
				dict set t1 counts [dict get $t2 counts]
			}
			if {[dict exists $t2 order]} {
				dict lappend t1 order {*}[dict get $t2 order]
			}
			if {[dict exists $t2 tables]} {
				dict lappend t1 tables {*}[dict get $t2 tables]
			}
			dict set t1 lasttable [dict get $t2 lasttable]
			return
		}

		namespace ensemble create -command table -map {
			add table_add
			last table_last
			unique table_unique
		}

		
		proc table_add {transformvar key val} {
			upvar $transformvar transform
			set counts [dict get $transform counts]
			set tables [dict get $transform tables]
			if {[dict exists $tables $key]} {
				error [list {table exists} $key]
			}
			dict set tables $key $val
			dict set transform tables $tables
			return
		}


		proc table_last {transformvar args} {
			upvar $transformvar transform
			switch [llength $args] { 
				0 {}
				1 {
					dict set transform lasttable [lindex $args 0]
				}
				default {
					error [list {wrong # args}]
				}
			}
			dict get $transform lasttable
		}

		proc table_unique {transformvar resvar} {
			upvar $transformvar transform
			upvar $resvar res
			set counts [dict get $transform counts]
			lassign $counts i
			incr i
			lset counts 0 $i
			set tableroot [dict get $transform tableroot]
			set res $tableroot$i
			return
		}


		proc set_ {datavar key args} {
			upvar 1 $datavar data
			switch $key {
				counts - tables {
					switch [llength $args] {
						1 {
							dict set data $key [lindex $args 0]
						}
						0  {}
						default {
							error [list {wrong # args}]
						}
					}
					dict get $data $key
				}
				default {
					error [list {bad key} $key]
				}
			}
		}
	}

	namespace import .::.new
	namespace import .::add
	namespace import .::merge
	namespace import .::table

	namespace import .::set_
	rename [namespace current]::set_ set
}