########################
#
# "rel domainop" domain [ -relop command ] [ -orderop command ]
# "rel is" <rel> - returns <rel'> or {}
#
# Relational routines
#
# ::rel::is tests the parameter for relation form
# it returns a relation in a pseudo-canonical form in the form (domainlist, valuelist)
# a relation in the form (valuelist, domainlist) is swapped around
# in addition the value list is tested to ensure correct tuple size and put thru [ lsort -uinque ]
# if ::rel::is failes to recognise a valid relation it returns {}
# otherwise it returns the pseudo-canonical relation.
# see notes at the bottom of this file regards the pseudo-canonical status
#
# a relation is a variable which is a list of two components.
# 0 - value
# 1 - domain spec
# there is also a reldomain array with an element for each domain type.
# Each array element has a value which is a list of 3 functional expressions { is == and } specified as lambda expressions
# if the value is {} for any of these the tcl (c) equivalent is assumed.
########################
proc "rel domainop" {a args} {
global "rel domain"
set arg(-relop) {}
set arg(-orderop) {}
array get arg $args
if { ![ info exists "rel domain($a)" ] } { set "rel domain($a)" { {} {} } }
if { [ info exists arg(-relop) ] } { set "rel domain($a)" [ list $arg(-relop) [ lindex "rel domain($a)" 1 ] ]
if { [ info exists arg(-orderop) ] } { set "rel domain($a)" [ list [ lindex "rel domain($a)" 0 ] $arg(-orderop) ] ]
return "rel domain($a)"
}
# "rel is" returns 1 if the list is a normal relation which may contain {} elements
# later extend to verify that the tuple values are elements of their domains
proc "rel is" rel {
if { [ llength $rel ] != 2 } { return {} }
set error 0
set l [llength [lindex $rel 1 ] ]
foreach i [ lindex $rel 0] {
if { $i != {} && [ llength $i ] != $l } {
set error 1
break
}
}
if { $error == 0 } { return [ list [ lsort -unique [ lindex $rel 0 ] ] [ lindex $rel 1 ] ] }
set l [llength [lindex $rel 0 ]
foreach i [ lindex $rel 1 ] {
if { $i == {} } continue
if { [ llength $i ] == $l } continue
return {}
}
return [ list [ lsort -unique [ lindex $rel 1 ] ] [lindex $rel 0 ] ]
}
# at this stage this procedure is not totally correct
# Uniqueness is only determined on a character basis, rather than using the equality relation based on the domain type. |