# DO NOT EDIT THIS FILE!
# THIS FILE IS AUTOMATICALLY GENERATED FROM A LITERATE PROGRAM SOURCE FILE.
#
# This software is copyrighted 2014-2015 by G. Andrew Mangogna.
# The following terms apply to all files associated with the software unless
# explicitly disclaimed in individual files.
# 
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors and
# need not follow the licensing terms described here, provided that the
# new terms are clearly indicated on the first page of each file where
# they apply.
# 
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES
# THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
# 
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS,
# OR MODIFICATIONS.
# 
# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
# are acquiring the software on behalf of the Department of Defense,
# the software shall be classified as "Commercial Computer Software"
# and the Government shall have only "Restricted Rights" as defined in
# Clause 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing,
# the authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license.

package require Tcl 8.6

package require logger
package require ral
package require ralutil
package require struct::set
package require lambda

proc ::K {x y} {set x}

namespace eval ::rosea {
    namespace export configure
    
    namespace export configureFromChan
    
    namespace export configureFromFile
    
    namespace export generate
    
    namespace export populate
    
    namespace export populateFromChan
    
    namespace export populateFromFile
    
    namespace export save
    
    namespace export restore
    
    namespace export info
    
    namespace export tunnel
    
    namespace export trace
    
    namespace ensemble create

    variable version 1.9.1

    logger::initNamespace [namespace current]

    namespace import\
        ::ral::relation\
        ::ral::tuple\
        ::ral::relformat\
        ::ralutil::pipe
    namespace import ::ral::relvar
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation project ~ Name Type |
        relation dict ~ Name Type
    } headingQuery
    
    pipe {
        relation semijoin $class $Identifier -using {Domain Domain Name Class}\
                $IdentifyingAttribute |
        relation group ~ Attributes Attribute
    } idQuery
    
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation join ~ $UserSuppliedValue -using {Domain Domain Class Class Name Attribute}
    } defaultValuesQuery
    
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation join ~ $SystemSuppliedValue -using {Domain Domain Class Class Name Attribute}
    } suppliedValuesQuery
    
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation join ~ $GeneratedValue -using {Domain Domain Class Class Name Attribute}
    } generatedValuesQuery
    
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation join ~ $ValueCheck -using {Domain Domain Class Class Name Attribute}
    } checkValuesQuery
    
    pipe {
        relation semijoin $class $StateModel -using {Domain Domain Name Model} |
        relation isnotempty
    } hasSMQuery
    
    pipe {
        relation semijoin $class $State -using {Domain Domain Name Model} |
        relation project ~ Name Parameters Action
    } statesQuery
    
    pipe {
        relation join $AttributeReference $refing\
            -using {Domain Domain ReferringClass Class\
            Relationship Relationship ReferringRole Role} |
        relation rename ~ Conditionality ReferringCond\
                Multiplicity ReferringMult |
        relation join ~ $refed -using {Domain Domain\
            ReferencedClass Class Relationship\
            Relationship ReferencedRole Role} |
        relation project ~ Domain Relationship\
            ReferringClass ReferringAttribute\
            ReferencedClass ReferencedAttribute\
            ReferringCond ReferringMult Conditionality |
        relation group ~ ReferringAttrs\
                ReferringAttribute ReferencedAttribute |
        relation extend ~ rfa\
            TagReferringAttrs {Relation {RefOrder int ReferringAttribute string\
                ReferencedAttribute string}} {
                    [relation tag [tuple extract $rfa ReferringAttrs] RefOrder]
                } |
        relation extend ~ wfa\
            SrcAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferringAttribute -ascending RefOrder]
            }\
            DstAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferencedAttribute -ascending RefOrder]
            } |
        relation extend ~ ram\
            ForwAttrs list {
                [Interleave [tuple extract $ram SrcAttrs]\
                    [tuple extract $ram DstAttrs]]
            }\
            RevAttrs list {
                [Interleave [tuple extract $ram DstAttrs]\
                    [tuple extract $ram SrcAttrs]]
            } |
        relation eliminate ~ TagReferringAttrs
    } referencesQuery
    
    pipe {
        relation semijoin $cassocs $AssociatorClass\
                -using {Domain Domain Name Relationship}\
            $ReferringClass $AttributeReference\
                -using {Domain Domain Class ReferringClass\
                Relationship Relationship Role ReferringRole} |
        relation project ~ Domain Relationship ReferringClass ReferringAttribute\
                ReferencedClass ReferencedAttribute ReferencedRole |
        relation join ~ $bothclass -using {Domain Domain Relationship Relationship\
                ReferencedClass Class ReferencedRole Role} |
        relation group ~ ReferringAttrs ReferringAttribute ReferencedAttribute |
        relation extend ~ rfa\
            TagReferringAttrs {Relation {RefOrder int ReferringAttribute string\
                ReferencedAttribute string}} {
                    [relation tag [tuple extract $rfa ReferringAttrs] RefOrder]
                } |
        relation extend ~ wfa\
            SrcAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferringAttribute -ascending RefOrder]
            }\
            DstAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferencedAttribute -ascending RefOrder]
            } |
        relation extend ~ ram\
            ForwAttrs list {
                [Interleave [tuple extract $ram SrcAttrs]\
                    [tuple extract $ram DstAttrs]]
            }\
            RevAttrs list {
                [Interleave [tuple extract $ram DstAttrs]\
                    [tuple extract $ram SrcAttrs]]
            } |
        relation eliminate ~ TagReferringAttrs
    } assocrefsQuery
    
    pipe {
        relation semijoin $rships $Generalization\
                $Subclass -using {Domain Domain Name Relationship}\
                $ReferringClass $AttributeReference\
                    -using {Domain Domain Class ReferringClass\
                    Relationship Relationship Role ReferringRole} |
        relation project ~ Domain Relationship ReferringClass ReferringAttribute\
                ReferencedClass ReferencedAttribute |
        relation group ~ ReferringAttrs\
                ReferringAttribute ReferencedAttribute |
        relation extend ~ rfa\
            TagReferringAttrs {Relation {RefOrder int ReferringAttribute string\
                ReferencedAttribute string}} {
                    [relation tag [tuple extract $rfa ReferringAttrs] RefOrder]
                } |
        relation extend ~ wfa\
            SrcAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferringAttribute -ascending RefOrder]
            }\
            DstAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferencedAttribute -ascending RefOrder]
            } |
        relation extend ~ ram\
            ForwAttrs list {
                [Interleave [tuple extract $ram SrcAttrs]\
                    [tuple extract $ram DstAttrs]]
            }\
            RevAttrs list {
                [Interleave [tuple extract $ram DstAttrs]\
                    [tuple extract $ram SrcAttrs]]
            } |
        relation eliminate ~ TagReferringAttrs
    } subrefsQuery
    
    proc configure {script} {
        namespace upvar Config errcount errcount configlineno configlineno
        set errcount 0
        set configlineno 1
    
        ConfigEvaluate ::rosea::Config $script
    
        if {$errcount > 0} {
            tailcall DeclError CONFIG_ERRORS $errcount
        }
        return $errcount
    }
    proc configureFromChan {chan} {
        tailcall configure [::chan read -nonewline $chan]
    }
    proc configureFromFile {filename} {
        set f [::open $filename r]
        try {
            configureFromChan $f
        } finally {
            ::chan close $f
        }
    }
    proc generate {{pattern *} {prefix {}}} {
        if {$prefix ne {}} {
            if {[string range $prefix 0 1] ne "::"} {
                set prefix [uplevel 1 {namespace current}]::$prefix
            }
            set prefix [string trimright $prefix :]
        } elseif {$prefix eq "::"} {
            set prefix {} ; # <1>
        }
        namespace upvar Config\
            Domain Domain\
            DomainElement DomainElement\
            Class Class\
            Attribute Attribute\
            DefaultValue DefaultValue\
            UserSuppliedValue UserSuppliedValue\
            SystemSuppliedValue SystemSuppliedValue\
            GeneratedValue GeneratedValue\
            ValueCheck ValueCheck\
            Identifier Identifier\
            IdentifyingAttribute IdentifyingAttribute\
            Relationship Relationship\
            Association Association\
            SimpleAssociation SimpleAssociation\
            SimpleReferringClass SimpleReferringClass\
            SimpleReferencedClass SimpleReferencedClass\
            ClassBasedAssociation ClassBasedAssociation\
            AssociatorClass AssociatorClass\
            SourceClass SourceClass\
            TargetClass TargetClass\
            Generalization Generalization\
            Superclass Superclass\
            Subclass Subclass\
            AttributeReference AttributeReference\
            ReferencedIdAttribute ReferencedIdAttribute\
            ReferringClass ReferringClass\
            ReferencedClass ReferencedClass\
            DomainOperation DomainOperation\
            SuppliedOperation SuppliedOperation\
            UserClassOperation UserClassOperation\
            SystemClassOperation SystemClassOperation\
            UserInstanceOperation UserInstanceOperation\
            SystemInstanceOperation SystemInstanceOperation\
            InstanceStateModel InstanceStateModel\
            StateModel StateModel\
            StatePlace StatePlace\
            State State\
            EffectiveEvent EffectiveEvent\
            DeferredEvent DeferredEvent\
            TransitionPlace TransitionPlace\
            StateTransition StateTransition\
            NonStateTransition NonStateTransition\
            AssignerStateModel AssignerStateModel\
            SingleAssigner SingleAssigner\
            MultipleAssigner MultipleAssigner\
            PolymorphicEvent PolymorphicEvent
    
        set genDomain [relation restrict $Domain dom {
            [string match $pattern [tuple extract $dom Name]]
        }]
        relation foreach domain $genDomain {
            set domainName [relation extract $domain Name]
            relvar updateone Config::Domain dtup [list Name $domainName] {
                tuple update $dtup Location $prefix
            }
            
            set domns ${prefix}::$domainName
            namespace eval $domns {
                namespace import\
                    ::ral::relation\
                    ::ral::tuple\
                    ::ral::relformat\
                    ::ralutil::pipe
                ral relvar create __Arch_RefLink {
                    Relationship    string
                    ReferringClass  string
                    ReferencedClass string
                    ReferringAttrs  {Relation
                            {ReferringAttribute string ReferencedAttribute string}}
                } Relationship
                ral relvar create __Arch_AssocRef {
                    Relationship    string
                    AssocClass      string
                    References      {Relation\
                        {Participant string Role string ReferringAttrs {Relation\
                            {ReferringAttribute string ReferencedAttribute string}}}}
                } Relationship
                ral relvar create __Arch_SuperLink {
                    Relationship    string
                    SuperClass      string
                } Relationship
                
                ral relvar create __Arch_SubLink {
                    Relationship    string
                    SubClass        string
                    ReferringAttrs  {Relation\
                        {ReferringAttribute string ReferencedAttribute string}}
                } {Relationship SubClass}
                
                ral relvar association __Arch_R5\
                    __Arch_SubLink Relationship +\
                    __Arch_SuperLink Relationship 1
                ral relvar create __Arch_Link {
                    Name            string
                    SrcClass        string
                } {Name SrcClass}
                ral relvar create __Arch_AssociationLink {
                    Name            string
                    SrcClass        string
                    DstClass        string
                    Attrs           list
                    PrevSrcClass    string
                } {Name SrcClass}
                ral relvar association __Arch_R4\
                    __Arch_AssociationLink {Name PrevSrcClass} ?\
                    __Arch_AssociationLink {Name SrcClass} ?
                ral relvar create __Arch_PartitionLink {
                    Name            string
                    SrcClass        string
                } {Name SrcClass}
                ral relvar partition __Arch_R3 __Arch_Link {Name SrcClass}\
                    __Arch_AssociationLink {Name SrcClass}\
                    __Arch_PartitionLink {Name SrcClass}
                ral relvar create __Arch_PartitionDst {
                    Name            string
                    SrcClass        string
                    DstClass        string
                    Attrs           list
                } {Name SrcClass DstClass}
                ral relvar association __Arch_R2\
                    __Arch_PartitionDst {Name SrcClass} +\
                    __Arch_PartitionLink {Name SrcClass} 1
                ral relvar create __Arch_State {
                    Class string
                    State string
                } {Class State}
                ral relvar create __Arch_Event {
                    Class string
                    Event string
                } {Class Event}
                ral relvar create __Arch_Transition {
                    Class string
                    State string
                    Event string
                    NewState string
                } {Class State Event}
                ral relvar correlation __Arch_R1 __Arch_Transition\
                    {Class State} + __Arch_State {Class State}\
                    {Class Event} + __Arch_Event {Class Event}
                ral relvar create __Arch_InitialState {
                    Class string
                    State string
                } Class
                ral relvar association __Arch_R6\
                    __Arch_InitialState {Class State} ?\
                    __Arch_State {Class State} 1
                ral relvar create __Arch_TerminalState {
                    Class string
                    State string
                } {Class State}
                ral relvar association __Arch_R7\
                    __Arch_TerminalState {Class State} *\
                    __Arch_State {Class State} 1
                ral relvar create __Arch_PolymorphicEvent {
                    Class           string
                    Event           string
                } {Class Event}
            }
            namespace eval $domns namespace path ::rosea::InstCmds
            set domops [relation semijoin $domain $DomainOperation -using {Name Domain}]
            relation foreach domop $domops {
                relation assign $domop\
                    {Name name} {Parameters parameters} {Body body}
                proc ${domns}::$name $parameters [list ::ral relvar eval $body] ; # <1>
            }
            
            namespace eval $domns [list\
                namespace export {*}[relation list $domops Name]\
            ]
            namespace eval $domns namespace ensemble create
            set statemodels [relation semijoin $domain $StateModel\
                -using {Name Domain}]
            
            relvar eval {
                relvar set ${domns}::__Arch_InitialState [pipe {
                    relation project $statemodels Model InitialState |
                    relation rename ~ Model Class InitialState State
                }]
                set states [relation semijoin $domain $StatePlace -using {Name Domain}]
                relvar set ${domns}::__Arch_State [pipe {
                    relation project $states Model Name |
                    relation rename ~ Model Class Name State
                }]
                relvar set ${domns}::__Arch_TerminalState [pipe {
                    relation semijoin $domain $State -using {Name Domain} |
                    relation restrict ~ termtuple {[tuple extract $termtuple IsFinal]} |
                    relation project ~ Model Name |
                    relation rename ~ Model Class Name State
                }]
                set events [relation semijoin $domain $EffectiveEvent\
                    -using {Name Domain}]
                relvar set ${domns}::__Arch_Event [pipe {
                    relation project $events Model Event |
                    relation rename ~ Model Class
                }]
                set alltrans [pipe {
                    relation join $states $events |
                    relation rename ~ Name State
                }] ; # <1>
                set statetrans [relation semijoin $domain $StateTransition\
                    -using {Name Domain}]
                set nontrans [pipe {
                    relation semijoin $domain $NonStateTransition -using {Name Domain} |
                    relation rename ~ TransRule NewState
                }]
                set deftrans [pipe {
                    relation minus $alltrans $TransitionPlace |
                    relation join ~ $StateModel |
                    relation eliminate ~ InitialState |
                    relation rename ~ DefaultTrans NewState |
                    relation update ~ dttup {[tuple extract $dttup State] eq "@"} {
                        tuple update $dttup NewState CH}
                }]
                relvar set ${domns}::__Arch_Transition [pipe {
                    relation union $statetrans $nontrans $deftrans |
                    relation eliminate ~ Domain |
                    relation rename ~ Model Class
                }]
                relvar set ${domns}::__Arch_PolymorphicEvent [pipe {
                    relation semijoin $domain $DeferredEvent\
                        -using {Name Domain} |
                    relation project ~ Model Event |
                    relation rename ~ Model Class
                }]
            }
            variable headingQuery
            variable idQuery
            variable defaultValuesQuery
            variable suppliedValuesQuery
            variable generatedValuesQuery
            variable checkValuesQuery
            variable hasSMQuery
            variable statesQuery
            
            set classes [relation semijoin $domain $DomainElement -using {Name Domain}\
                    $Class -using {Domain Domain Element Name}]
            relation foreach class $classes {
                set className ${domns}::[relation extract $class Name]
                namespace eval $className {
                    namespace import\
                        ::ral::relation\
                        ::ral::tuple\
                        ::ral::relformat\
                        ::ralutil::pipe
                }
                namespace eval $className [list namespace path\
                        [list ::rosea::InstCmds $domns]]
                set heading [eval $headingQuery]
                set idset [list]
                relation foreach id [eval $idQuery] -ascending Number {
                    lappend idset [relation list\
                            [relation extract $id Attributes] Attribute]
                }
                
                relvar create $className $heading {*}$idset
                
                # <1>
                set checkvalues [eval $checkValuesQuery]
                
                if {[relation isnotempty $checkvalues]} {
                    relvar trace add variable $className {insert update set} [list\
                        ::rosea::Helpers::CheckValueTrace\
                        [relation dict $checkvalues Name Expression]\
                    ]
                }
                set defaultvalues [eval $defaultValuesQuery]
                
                if {[relation isnotempty $defaultvalues]} {
                    relvar trace add variable $className insert [list\
                        ::rosea::Helpers::UserDefaultTrace\
                        [relation dict $defaultvalues Name Type]\
                        [relation dict $defaultvalues Name Value]\
                    ]
                }
                set supplied [eval $suppliedValuesQuery]
                
                if {[relation isnotempty $supplied]} {
                    pipe {
                        relation extend $supplied stup ClassName string {
                            [string cat [tuple extract $stup Class] , [tuple extract $stup Name]]
                        } |
                        relation array ~ ${domns}::__Arch_SuppliedDefault ClassName StartValue 
                    } ; # <1>
                    relvar trace add variable $className insert [list\
                        ::rosea::Helpers::SupplyDefaultTrace\
                        [relation dict $supplied Name Type]\
                    ]
                }
                set generatecmds [eval $generatedValuesQuery]
                
                if {[relation isnotempty $generatecmds]} {
                    relvar trace add variable $className insert [list\
                        ::rosea::Helpers::GenerateDefaultTrace\
                        [relation dict $generatecmds Name Type]\
                        [relation dict $generatecmds Name Cmd]\
                    ]
                }
                set hasStateModel [eval $hasSMQuery]
                if {$hasStateModel} {
                    set instid [lindex $idset 0]
                    set instheading [list]
                    foreach attr $instid {
                        lappend instheading $attr [dict get $heading $attr] ; # <1>
                    }
                    lappend instheading __State string
                    relvar create ${domns}::[relation extract $class Name]__STATEINST\
                        $instheading $instid
                    set actns ${className}::__Activity
                    namespace eval $actns {
                        namespace import\
                            ::ral::relation\
                            ::ral::tuple\
                            ::ral::relformat\
                            ::ralutil::pipe
                    }
                    namespace eval $actns [list\
                        namespace path [list\
                            ::rosea::InstCmds\
                            $className\
                            $domns\
                        ]\
                    ]
                    relation foreach state [eval $statesQuery] {
                        relation assign $state\
                            {Name stateName}\
                            {Parameters params}\
                            {Action stateAction}
                        proc ${actns}::$stateName [linsert $params 0 self] $stateAction
                    }
                }
                set opmap [dict create]
                set classops [relation semijoin $class $UserClassOperation\
                    -using {Domain Domain Name Class}]
                relation foreach classop $classops {
                    relation assign $classop\
                        {Name opname}\
                        {Parameters params}\
                        {Body opbody}
                
                    proc ${className}::$opname $params $opbody
                    dict set opmap $opname ${className}::$opname
                }
                
                set sysmap [QuerySystemClassOperations $className false]
                if {$hasStateModel} {
                    set sysmap [dict merge $sysmap [QuerySystemClassOperations $className true]]
                }
                
                namespace ensemble create\
                    -command $className\
                    -map [dict merge $opmap $sysmap]
                set opmap [dict create]
                set instops [relation semijoin $class $UserInstanceOperation\
                    -using {Domain Domain Name Class}]
                relation foreach instop $instops {
                    relation assign $instop\
                        {Name opname}\
                        {Parameters params}\
                        {Body opbody}
                
                    proc ${className}::$opname [linsert $params 0 self] $opbody
                    dict set opmap $opname ${className}::$opname
                }
                set sysmap [QuerySystemInstanceOperations false]
                set hasPolyEvents [relation isnotempty\
                    [relation semijoin $class $PolymorphicEvent\
                        -using {Domain Domain Name Model}]\
                ]
                if {$hasStateModel || $hasPolyEvents} {
                    set sysmap [dict merge $sysmap [QuerySystemInstanceOperations true]]
                }
                
                namespace ensemble create\
                    -command ${className}::Instance\
                    -parameters instref\
                    -map [dict merge $opmap $sysmap]
            }
            set rships [relation semijoin $domain $DomainElement -using {Name Domain}\
                    $Relationship -using {Domain Domain Element Name}]
            
            set sassocs [relation semijoin $rships $Association\
                    $SimpleAssociation]
            set refing [relation semijoin $sassocs $SimpleReferringClass\
                    -using {Domain Domain Name Relationship}]
            set refed [relation semijoin $sassocs $SimpleReferencedClass\
                    -using {Domain Domain Name Relationship}]
            variable referencesQuery
            set references [eval $referencesQuery]
            relvar eval {
                set flink [pipe {
                    relation project $references Relationship ReferringClass |
                    relation rename ~ Relationship Name ReferringClass SrcClass
                }]
                set blink [pipe {
                    relation project $references Relationship ReferencedClass |
                    relation rename % Relationship Name ReferencedClass SrcClass |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%] ; # <1>
                
                relvar union ${domns}::__Arch_Link $flink $blink
                set flink [pipe {
                    relation project $references Relationship ReferringClass\
                            ReferencedClass ForwAttrs |
                    relation rename ~ Relationship Name ReferringClass SrcClass\
                            ReferencedClass DstClass ForwAttrs Attrs |
                    relation extend ~ al PrevSrcClass string {{}}
                }] ; # <1>
                set blink [pipe {
                    relation project $references Relationship ReferringClass\
                            ReferencedClass RevAttrs |
                    relation rename % Relationship Name ReferencedClass SrcClass\
                            ReferringClass DstClass RevAttrs Attrs |
                    relation extend % al PrevSrcClass string {{}} |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                
                relvar union ${domns}::__Arch_AssociationLink $flink $blink
                relvar union ${domns}::__Arch_RefLink [relation project $references\
                    Relationship ReferringClass ReferencedClass ReferringAttrs]
            }
            relation foreach reference $references {
                relation assign $reference\
                    {Relationship relationship}\
                    {ReferringClass referringClass}\
                    {ReferencedClass referencedClass}\
                    {ReferringCond referringCond}\
                    {ReferringMult referringMult}\
                    {Conditionality referencedCond}\
                    {SrcAttrs srcAttrs}\
                    {DstAttrs dstAttrs}
            
                # Create the relvar constraint.
                relvar association ${domns}::$relationship\
                     ${domns}::$referringClass $srcAttrs\
                    [MapCondMultToConstraint $referringCond $referringMult]\
                    ${domns}::$referencedClass $dstAttrs\
                    [MapCondMultToConstraint $referencedCond false]
            
                # All simple associations get a link and unlink command in their ensemble.
                set ensemblemap [dict create\
                    link [list ::rosea::RelCmds::linkSimple $relationship]\
                    unlink [list ::rosea::RelCmds::unlinkSimple $relationship]\
                ]
            
                # Determine if we have any assigners assocated  with the relationship.
                # Single assigners get different commands from multiple assigners.
                set rpath ${domns}::$relationship
                set assigner [relation semijoin $reference $SingleAssigner\
                    -using {Domain Domain Relationship Relationship}]
                if {[relation isnotempty $assigner]} {
                    dict set ensemblemap signal\
                        [list ::rosea::RelCmds::signalAssigner $rpath]
                } else {
                    set assigner [relation semijoin $reference $MultipleAssigner\
                        -using {Domain Domain Relationship Relationship}]
                    if {[relation isnotempty $assigner]} {
                        dict set ensemblemap signal [list\
                            ::rosea::RelCmds::signalMultiAssigner $rpath]
                        dict set ensemblemap create [list\
                            ::rosea::RelCmds::createMultiAssigner $rpath]
                    }
                }
                # Create the relationship ensemble command.
                namespace ensemble create -command $rpath -map $ensemblemap
            }
            set cassocs [relation semijoin $rships $Association\
                    $ClassBasedAssociation]
            set sourceclass [relation semijoin $cassocs $SourceClass\
                -using {Domain Domain Name Relationship}]
            set targetclass [relation semijoin $cassocs $TargetClass\
                -using {Domain Domain Name Relationship}]
            set bothclass [relation union $sourceclass $targetclass] ; # <1>
            variable assocrefsQuery
            set assocrefs [eval $assocrefsQuery]
            relvar eval {
                set aforw [pipe {
                    relation project $assocrefs Relationship ReferringClass |
                    relation rename ~ Relationship Name ReferringClass SrcClass
                }]
                set arev [relation update $aforw lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}]
                set sources [pipe {
                    relation restrict $assocrefs aref {
                        [tuple extract $aref ReferencedRole] eq "source"} |
                    relation eliminate ~ ReferencedRole
                }]
                set sforw [pipe {
                    relation project $sources Relationship ReferencedClass |
                    relation rename ~ Relationship Name ReferencedClass SrcClass
                }]
                set targets [pipe {
                    relation restrict $assocrefs aref {
                        [tuple extract $aref ReferencedRole] eq "target"} |
                    relation eliminate ~ ReferencedRole
                }]
                set trev [pipe {
                    relation project $targets Relationship ReferencedClass |
                    relation rename % Relationship Name ReferencedClass SrcClass |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                relvar union ${domns}::__Arch_Link $aforw $arev $sforw $trev
                set sforw [pipe {
                    relation project $sources Relationship ReferringClass ReferencedClass\
                        RevAttrs |
                    relation rename ~ Relationship Name ReferringClass DstClass\
                        ReferencedClass SrcClass RevAttrs Attrs |
                    relation extend ~ al PrevSrcClass string {{}}
                }]
                set trev [pipe {
                    relation project $targets Relationship ReferringClass ReferencedClass\
                        RevAttrs |
                    relation rename % Relationship Name ReferringClass DstClass\
                        ReferencedClass SrcClass RevAttrs Attrs |
                    relation extend % al PrevSrcClass string {{}} |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                set onerefs [relation rename $sources ReferencedClass OneClass\
                        Conditionality OneCond Multiplicity OneMult\
                        ReferringAttrs OneReferringAttrs SrcAttrs OneSrcAttrs\
                        DstAttrs OneDstAttrs ForwAttrs OneForwAttrs RevAttrs OneRevAttrs]
                set otherrefs [relation rename $targets ReferencedClass OtherClass\
                        Conditionality OtherCond Multiplicity OtherMult ReferringAttrs\
                        OtherReferringAttrs SrcAttrs OtherSrcAttrs DstAttrs OtherDstAttrs\
                        ForwAttrs OtherForwAttrs RevAttrs OtherRevAttrs]
                set bothrefs [relation join $onerefs $otherrefs\
                    -using {Domain Domain ReferringClass ReferringClass\
                        Relationship Relationship}]
                set aforw [pipe {
                    relation project $bothrefs Relationship ReferringClass OtherClass\
                        OtherForwAttrs OneClass |
                    relation rename ~ Relationship Name ReferringClass SrcClass\
                            OtherClass DstClass OtherForwAttrs Attrs OneClass PrevSrcClass
                }]
                set arev [pipe {
                    relation project $bothrefs Relationship ReferringClass OneClass\
                            OneForwAttrs OtherClass |
                    relation rename % Relationship Name ReferringClass SrcClass\
                            OneClass DstClass OneForwAttrs Attrs OtherClass PrevSrcClass |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                relvar union ${domns}::__Arch_AssociationLink $sforw $trev $aforw $arev
                relvar union ${domns}::__Arch_AssocRef [pipe {
                    relation project $assocrefs Relationship ReferringClass\
                        ReferencedClass ReferencedRole ReferringAttrs |
                    relation rename ~ ReferringClass AssocClass ReferencedClass Participant\
                        ReferencedRole Role |
                    relation group ~ References Participant Role ReferringAttrs
                }]
            }
            relation foreach bothref $bothrefs {
                relation assign $bothref\
                    {Relationship relationship}\
                    {ReferringClass associator}\
                    {OneClass sourceClass}\
                    {OneCond sourceCond}\
                    {OneMult sourceMult}\
                    {OneSrcAttrs sourceAssocAttrs}\
                    {OneDstAttrs sourceDstAttrs}\
                    {OtherClass targetClass}\
                    {OtherCond targetCond}\
                    {OtherMult targetMult}\
                    {OtherSrcAttrs targetAssocAttrs}\
                    {OtherDstAttrs targetDstAttrs}
            
                # Create the correlation constraint
                relvar correlation ${domns}::$relationship ${domns}::$associator\
                    $sourceAssocAttrs [MapCondMultToConstraint $targetCond $targetMult]\
                    ${domns}::$sourceClass $sourceDstAttrs\
                    $targetAssocAttrs [MapCondMultToConstraint $sourceCond $sourceMult]\
                    ${domns}::$targetClass $targetDstAttrs ; # <1>
            
                set ensemblemap [dict create\
                    link [list ::rosea::RelCmds::linkAssoc $relationship]\
                    reference [list ::rosea::RelCmds::referenceAssoc $relationship]\
                    unlink [list ::rosea::RelCmds::unlinkAssoc $relationship]\
                ]
                # Determine if we have any assigners
                set rpath ${domns}::$relationship
                set assigner [relation semijoin $bothref $SingleAssigner\
                    -using {Domain Domain Relationship Relationship}]
                if {[relation isnotempty $assigner]} {
                    dict set ensemblemap signal\
                        [list ::rosea::RelCmds::signalAssigner $rpath]
                } else {
                    set assigner [relation semijoin $bothref $MultipleAssigner\
                        -using {Domain Domain Relationship Relationship}]
                    if {[relation isnotempty $assigner]} {
                        dict set ensemblemap signal [list\
                            ::rosea::RelCmds::signalMultiAssigner $rpath]
                        dict set ensemblemap create [list\
                            ::rosea::RelCmds::createMultiAssigner $rpath]
                    }
                }
                namespace ensemble create -command $rpath -map $ensemblemap
            }
            variable subrefsQuery
            set subrefs [eval $subrefsQuery]
            relvar eval {
                set sublinks [pipe {
                    relation project $subrefs Relationship ReferringClass |
                    relation rename ~ Relationship Name ReferringClass SrcClass
                }]
                set superlinks [pipe {
                    relation project $subrefs Relationship ReferencedClass |
                    relation rename % Relationship Name ReferencedClass SrcClass |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                
                relvar union ${domns}::__Arch_Link $sublinks $superlinks
                relvar union ${domns}::__Arch_AssociationLink [pipe {
                    relation project $subrefs Relationship ReferringClass ReferencedClass\
                            ForwAttrs |
                    relation rename ~ Relationship Name ReferringClass SrcClass\
                            ReferencedClass DstClass ForwAttrs Attrs |
                    relation extend ~ al PrevSrcClass string {{}}
                }]
                relvar union ${domns}::__Arch_PartitionLink $superlinks
                relvar union ${domns}::__Arch_PartitionDst [pipe {
                    relation project $subrefs Relationship ReferencedClass\
                            ReferringClass RevAttrs |
                    relation rename % Relationship Name ReferencedClass SrcClass\
                            ReferringClass DstClass RevAttrs Attrs |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                relvar union ${domns}::__Arch_SuperLink [pipe {
                    relation project $subrefs Relationship ReferencedClass |
                    relation rename ~ ReferencedClass SuperClass
                }]
                relvar union ${domns}::__Arch_SubLink [pipe {
                    relation project $subrefs Relationship ReferringClass ReferringAttrs |
                    relation rename ~ ReferringClass SubClass
                }]
            }
            set partrefs [pipe {
                relation project $subrefs Relationship ReferencedClass DstAttrs\
                        ReferringClass SrcAttrs |
                relation extend ~ prs SubAttrMap list {[list\
                        ${domns}::[tuple extract $prs ReferringClass]\
                        [tuple extract $prs SrcAttrs]]} |
                relation eliminate ~ ReferringClass SrcAttrs |
                relation group ~ SubClassRefs SubAttrMap |
                relation extend ~ spt SubParts list {
                        [concat {*}[relation list [tuple extract $spt SubClassRefs]]]} |
                relation eliminate ~ SubClassRefs
            }]
            
            relation foreach partref $partrefs {
                relation assign $partref\
                    {Relationship relationship}\
                    {ReferencedClass superclass}\
                    {DstAttrs superattrs}\
                    {SubParts subparts}
            
                relvar partition ${domns}::$relationship ${domns}::$superclass\
                        $superattrs {*}$subparts
                namespace ensemble create\
                    -command ${domns}::$relationship\
                    -map [dict create migrate [list ::rosea::RelCmds::migrate\
                            $relationship]]
            }
            set assigners [relation semijoin $domain $AssignerStateModel\
                    -using {Name Domain}]
            relation foreach assigner $assigners {
                set asgnns\
                    ${domns}::[relation extract $assigner Relationship]::__Activity
                namespace eval $asgnns {
                    namespace import\
                        ::ral::relation\
                        ::ral::tuple\
                        ::ral::relformat\
                        ::ralutil::pipe
                }
                namespace eval $asgnns [list\
                    namespace path [list\
                        ::rosea::InstCmds\
                        $domns\
                    ]\
                ]
                set states [pipe {
                    relation semijoin $assigner $State\
                        -using {Domain Domain Relationship Model} |
                    relation project ~ Name Parameters Action
                }]
                relation foreach state $states {
                    relation assign $state\
                        {Name stateName}\
                        {Parameters params}\
                        {Action stateAction}
                    set params [linsert $params 0 self]
                    proc ${asgnns}::$stateName $params $stateAction
                }
            }
            relation foreach sassigner\
                    [relation semijoin $domain $SingleAssigner\
                    -using {Name Domain}] {
                relation assign $sassigner {Relationship relationship}
                relvar create ${domns}::${relationship}__STATEINST {
                    Id      int
                    __State string
                } Id
                CreateInInitialState $domns $relationship {Id 0} ; # <1>
            }
            relation foreach massigner\
                    [relation semijoin $domain $MultipleAssigner\
                    -using {Name Domain}] {
                relation assign $massigner {Relationship relationship}
                set assignvar ${domns}::${relationship}__STATEINST
            
                set idattrs [pipe {
                    relation semijoin $massigner $Identifier\
                        $IdentifyingAttribute\
                        $Attribute -using {Domain Domain Class Class\
                            Attribute Name} |
                    relation dict ~ Name Type
                }]
                relvar create $assignvar\
                    [concat $idattrs [list __State string]]\
                    [dict keys $idattrs]
            }
        }
    }
    proc populate {script} {
        namespace upvar Config errcount errcount configlineno configlineno
        set errcount 0
        set configlineno 1
    
        ConfigEvaluate ::rosea::Populate $script ; # <1>
    
        if {$errcount > 0} {
            tailcall DeclError CONFIG_ERRORS $errcount
        }
        return $errcount
    }
    proc populateFromChan {chan} {
        tailcall populate [::chan read -nonewline $chan]
    }
    proc populateFromFile {filename} {
        set f [::open $filename r]
        try {
            populateFromChan $f
        } finally {
            ::chan close $f
        }
    }
    proc save {args} {
        set savecmd ::ral::serializeToFile
        set asynccmd {}
    
        set options $args
        while {1} {
            if {[string index [lindex $options 0] 0] eq "-"} {
                set options [lassign $options option]
                switch -exact -- $option {
                    -sqlite {
                        set savecmd ::ral::storeToSQLite
                    }
                    -tclral {
                        set savecmd ::ral::serializeToFile
                    }
                    -async {
                        set options [lassign $options asynccmd]
                    }
                    default {
                        tailcall DeclError UNKNOWN_OPTION save $option
                    }
                }
            } else {
                break
            }
        }
    
        if {[llength $options] == 2} {
            lassign $options domain file
            if {[string range $domain 0 1] ne "::"} { # <1>
                set domrel [relvar restrictone ::rosea::Config::Domain Name $domain]
                if {[relation isempty $domrel]} {
                    tailcall DeclError UNKNOWN_DOMAIN $domain
                }
                set domain [string cat [relation extract $domrel Location]\
                        :: $domain]
            }
        } else {
            tailcall DeclError SAVE_ARG_ERROR $args
        }
    
        set script "try \{$savecmd $file ${domain}::\\\[A-Za-z0-9\\\]*\}" ; # <2>
        if {$asynccmd ne {}} {
            append script " finally \{$asynccmd $domain $file\}"
        }
    
        after idle [list ::apply [list {} $script]] ; # <3>
    }
    proc restore {args} {
        set restorecmd ::ral::mergeFromFile
    
        set options $args
        while {1} {
            if {[string index [lindex $options 0] 0] eq "-"} {
                set options [lassign $options option]
                switch -exact -- $option {
                    -sqlite {
                        set restorecmd ::ral::mergeFromSQLite
                    }
                    -tclral {
                        set restorecmd ::ral::mergeFromFile
                    }
                    default {
                        tailcall DeclError UNKNOWN_OPTION restore $option
                    }
                }
            } else {
                break
            }
        }
    
        if {[llength $options] == 2} {
            lassign $options domain file
            if {[string range $domain 0 1] ne "::"} {
                set domrel [relvar restrictone ::rosea::Config::Domain Name $domain]
                if {[relation isempty $domrel]} {
                    tailcall DeclError UNKNOWN_DOMAIN $domain
                }
                set domain [string cat [relation extract $domrel Location]\
                        :: $domain]
            }
        } else {
            tailcall DeclError RESTORE_ARG_ERROR $args
        }
    
        eval [list $restorecmd $file $domain]
    
        # Determine the values for the system supplied defaults.  We examine all
        # the classes that have such attributes and find the maximum value of the
        # attribute.  This can then be placed in the array that is used when new
        # default values are generated.
        set domainname [namespace tail $domain]
        set supplied [pipe {
            relvar set ::rosea::Config::SystemSuppliedValue |
            relation restrictwith ~ {$Domain eq $domainname}
        }]
    
        relation foreach sup $supplied {
            relation assign $sup
            set classtups [relvar set ${domain}::$Class]
            if {[relation isempty $classtups]} {
                set maxvalue $StartValue
            } else {
                set maxvalue [pipe {
                    relation summarizeby $classtups {} cv\
                        MaxValue int {rmax($cv, $Attribute)} |
                    relation extract ~ MaxValue
                }]
            }
            set ${domain}::__Arch_SuppliedDefault($Class,$Attribute)\
                [expr {$maxvalue + 1}]
        }
        return
    }
    proc info {args} {
        set args [lassign $args subcmd]
    
        switch -exact -- $subcmd {
            domain {
                Info::domain $args
            }
            class {
                Info::class $args
            }
            statemodel {
                Info::statemodel $args
            }
            default {
                tailcall DeclError UNKNOWN_INFO_CMD $subcmd
            }
        }
    }
    proc tunnel {instref op args} {
        relvar eval {
            set result [[lindex $instref 0]::Instance $instref $op {*}$args]
        }
        return $result
    }
    proc trace {subcmd args} {
        switch -exact -- $subcmd {
            control {
                tailcall traceControl {*}$args
            }
            decode {
                switch -exact -- [lindex $args 0] {
                    all {
                        tailcall Trace::DecodeAllTraces
                    }
                    class {
                        tailcall Trace::DecodeClassTraces {*}[lrange $args 1 end]
                    }
                    target {
                        tailcall Trace::DecodeTargetTraces {*}[lrange $args 1 end]
                    }
                    default {
                        tailcall DeclError UNKNOWN_TRACE_CMD [lindex $args 0]
                    }
                }
            }
            format {
                tailcall formatTraces {*}$args
            }
            diagram {
                switch -exact -- [lindex $args 0] {
                    all {
                        tailcall Trace::DiagAllTraces {*}[lrange $args 1 end]
                    }
                    class {
                        tailcall Trace::DiagClassTraces {*}[lrange $args 1 end]
                    }
                    target {
                        tailcall Trace::DiagTargetTraces {*}[lrange $args 1 end]
                    }
                    default {
                        tailcall DeclError UNKNOWN_TRACE_CMD [lindex $args 0]
                    }
                }
            }
            default {
                tailcall DeclError UNKNOWN_TRACE_CMD $subcmd
            }
        }
    }
    proc traceControl {op args} {
        switch -exact -- $op {
            on {
                namespace upvar Trace traceState traceState
                set traceState on
            }
            off {
                namespace upvar Trace traceState traceState
                set traceState off
            }
            status {
                namespace upvar Trace traceState traceState
                return $traceState
            }
            clear {
                relvar eval {
                    foreach rvar {Trace Creation Polymorphic Transition} {
                        relvar set Trace::$rvar\
                                [relation emptyof [relvar set Trace::$rvar]]
                    }
                }
                namespace upvar Trace traceNumber traceNumber
                set traceNumber 0
            }
            logon {
                namespace upvar Trace traceLogState traceLogState
                set traceLogState on
            }
            logoff {
                namespace upvar Trace traceLogState traceLogState
                set traceLogState off
            }
            loglevel {
                namespace upvar Trace traceLogLevel traceLogLevel
                if {[llength $args] != 0} {
                    set traceLogLevel [lindex $args 0]
                }
                return $traceLogLevel
            }
            save {
                if {[llength $args] == 0} {
                    DeclError NO_SAVEFILE
                }
                ral storeToSQLite [lindex $args 0] ::rosea::Trace::*
            }
            default {
                DeclError BAD_TRACEOP $op
            }
        }
    }
    proc formatTraces {tracerecs} {
        if {[llength $tracerecs] == 0} {
            return {}
        }
        set prevtime [dict get [lindex $tracerecs 0] time]
        foreach rec $tracerecs {
            dict with rec {
                append result "[Trace::FormatTimestamp $time]: "
                append result "[Trace::FormatTimeAsSec\
                        [expr {$time - $prevtime}]]: "
                set prevtime $time
                append result [Trace::FormatTraceRec $rec] \n
            }
        }
        return [string trimright $result]
    }
    namespace eval Helpers {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        variable errFormats
        set errFormats [dict create {*}{
            SAME_CLASS   {operation is only allowed for references to the same class,\
                            got "%s" and "%s"}
            UNKNOWN_STATE   {unknown state, "%s", for class, "%s"}
            UNKNOWN_EVENT   {unknown event, "%s", for class, "%s"}
            NO_CREATION_EVENTS   {class, "%s", has no defined creation events}
            NO_CROSS_DOMAIN         {cannot link instances across domains,\
                                        got "%s" and "%s"}
            UNKNOWN_RELATIONSHIP    {unknown relationship, "%s"}
            NON_PARTICIPANTS        {"%s" and "%s" don't participate in %s,\
                                        expected "%s" and "%s"}
            MUST_BE_SINGULAR    {number of referred to instances for "%s" must be one,\
                                    got %d}
            NOT_IN_ASSOCIATION         {"%s" $relvar1 not a participant in "%s"}
            DIRECTION_REQUIRED  {direction argument is required: got "%s"}
            AMBIGUOUS_UNLINK         {"%s" is reflexive and linking via "%s" is ambiguous}
            NO_SUBCLASS         {relationship "%s" does not have a "%s"}
            NO_ASSIGNER         {relationship, "%s", does not have an assigner}
            NO_IDENTIFIER       {bad identifying attributes, expected "%s", got "%s"}
            UNKNOWN_ASSIGNER    {unknown assigner instance, "%s", for relationship, "%s"}
            UNKNOWN_LINKAGE {unknown relationship, "%s", for class, "%s"}
            PATH_ERROR      {relationship, "%s", from "%s" to "%s", does not end at "%s"}
            GEN_PATH_ERROR  {navigating from superclass, "%s", along generalization "%s",\
                            does not have "%s" as a subclass}
            ARG_ERROR           {attribute updates must be name / value pairs, got "%s"}
            ID_UPDATE           {cannot update identifying attributes, "%s"}
            UNKNOWN_ATTRIBUTE   {unknown attribute, "%s"}
            WITH_ATTR_USAGE {wrong arguments, should be,\
                    "withAttribute attrvarpair1 ?attrvarpair2 ...? body"}
            ATTR_VAR_SPEC   {attribute / variable argument must be a one or two element\
                    list, got "%s"}
            INVALID_TIME    {invalid time value, "%s"}
            SINGLE_OR_EMPTY_REF_REQUIRED {single valued or nil reference required, %d found}
            SINGLE_REF_REQUIRED     {single valued reference required, %d found}
            ASYNC_CREATION_FAILED     {asynchronous creation of an instance of class, "%s",\
                with attributes, "%s", failed: %s}
            EVENT_IN_FLIGHT     {event, "%s", sent to "%s", which does not exist}
            CANT_HAPPEN_EVENT   {can't happen transition, %s - %s -> %s ==> %s -> CH}
            CONFIG_ERRORS     {encountered %d configuration script errors}
            EMPTY_NAME      {the empty string is not a valid name for a %s}
            BAD_CLASS_NAME      {class names must be begin with an alphanumeric\
                                character, got: "%s"}
            DUP_ELEMENT_NAME    {a class, relationship or domain operation named, "%s",\
                                already exists}
            RESERVED_NAME {names beginning with two underscore characters are reserved,\
                    "%s" cannot be used as a name in this context}
            INT_TYPE_REQUIRED   {attribute must be of "int" type, got "%s"}
            INT_VALUE_REQUIRED  {an integer value is required, got "%s"}
            ARG_FORMAT      {options and values must come in pairs, got "%s"}
            UNKNOWN_OPTION  {unknown %s command option, "%s"}
            DUP_OP_NAME     {operation call, "%s", already exists}
            NS_QUALIFIERS   {name, "%s", contains namespace qualifiers}
            TILDE_NAME {names beginning with the tilde character are not allowed\
                in this context, "%s"}
                
            BAD_RELATIONSHIP_SPEC  {bad relationship specifier, "%s"}
            NEED_ASSOCIATOR {relationship of type, "%s", requires associative class}
            NEED_REFLEXIVE_PATH {traversal path must be specified for reflexive\
                    association, %s, %s %s %s}
            REFLEXIVE_NOT_ALLOWED   {associations of type, "%s", cannot be reflexive}
            TOO_FEW_SUBCLASSES  {at least 2 subclasses must be specified, got %d}
            BAD_CREATION_TARGET {the target of a creation event must be a state,\
                    got "%s"}
            PSEUDO_STATE    {the transition action, "%s", is not valid as %s}
            EXPECTED_PSEUDO_STATE    {expected CH or IG, got "%s"}
            RELVAR_TRACE_OP     {unexpected relvar trace operation, "%s"}
            ATTR_CHECK_FAILED   {check for attribute, "%s", failed:\
                                instance value was, "%s": "%s" evaluated to "%s"}
            UNKNOWN_DOMAIN  {unknown domain, "%s"}
            ARG_MISMATCH      {number of population values must be a multiple of %d, got %d}
            SAVE_ARG_ERROR  {wrong number of arguments: expected:\
                    "save ?-sqlite | -tclral? ?-async <cmdprefix>?\
                    <domain> <filename>", got: "%s"}
            RESTORE_ARG_ERROR  {wrong number of arguments: expected:\
                    "restore ?-sqlite | -tclral?  <domain> <filename>", got: "%s"}
            UNKNOWN_INFO_CMD  {unknown info request, "%s"}
            UNKNOWN_CLASS  {unknown class, "%s", in domain, "%s"}
            UNKNOWN_TRACE_CMD   {unknown trace subcomand, "%s"}
            BAD_TRACEOP     {unknown trace operation, "%s"}
            NO_SAVEFILE     {no save file name provided}
            BAD_TRACETYPE   {unknown trace type, "%s"}
        }]
        proc ToRef {relvar relvalue} {
            tailcall list $relvar [relation project $relvalue\
                {*}[lindex [relvar identifiers $relvar] 0]] ; # <1>
        }
        proc nilInstRef {} {
            return {{} {{} {}}}
        }
        proc CreateStateInstance {domns class state idattrs} {
            tailcall relvar insert ${domns}::${class}__STATEINST\
                    [concat $idattrs [list __State $state]]
        }
        proc CreateInInitialState {domns class idattrs} {
            set initstate [relvar restrictone ${domns}::__Arch_InitialState\
                Class $class]
            if {[relation isnotempty $initstate]} {
                CreateStateInstance $domns $class [relation extract $initstate State]\
                    $idattrs
            }
            return
        }
        proc CreateStateInstanceFromRef {domns class state ref} {
            relation foreach inst [lindex $ref 1] { # <1>
                CreateStateInstance $domns $class $state\
                    [tuple get [relation tuple $inst]]
            }
            return
        }
        proc CreateInInitialStateFromRef {domns class ref} {
            set initstate [relvar restrictone ${domns}::__Arch_InitialState\
                Class $class]
            if {[relation isnotempty $initstate]} {
                CreateStateInstanceFromRef $domns $class\
                    [relation extract $initstate State] $ref
            }
            return
        }
        proc SelfInstRef {{level 2}} {
            set foundRef false
            set ref [nilInstRef]
        
            for {set ns [uplevel $level namespace current]} {$ns ne "::"}\
                    {set ns [uplevel [incr level] namespace current]} {
                if {!$foundRef} {
                    upvar $level self srcself
                    if {[info exists srcself]} {
                        set ref $srcself
                        set foundRef true
                    }
                }
                if {[string match {*__Activity*} $ns]} {
                    return $ref ; # <1>
                }
            }
            return [nilInstRef]
        }
        namespace export DeclError
        
        proc DeclError {errcode args} {
            variable errFormats
            set errmsg [format [dict get $errFormats $errcode] {*}$args]
            tailcall throw [list ROSEA $errcode {*}$args $errmsg] $errmsg
        }
        proc SplitRelvarName {relvar {dvarname domain} {cvarname class}} {
            upvar 1 $dvarname domain $cvarname class
            set domain [namespace qualifiers $relvar]
            set class [namespace tail $relvar]
        }
        proc PropagatePolyEvents {super} {
            namespace upvar ::rosea::Config\
                DeferredEvent DeferredEvent\
                LocalEvent LocalEvent\
                Superclass Superclass\
                Subclass Subclass\
                DeferralPath DeferralPath\
                Generalization Generalization ; # <1>
        
            set supername [relation extract $super Class]
        
            set subs [pipe {
                relation semijoin $super\
                    $Generalization -using {Domain Domain Relationship Name}\
                    $Subclass -using {Domain Domain Name Relationship}
            }]
        
            relation foreach sub $subs {
                set defrdevents [pipe {
                    relation semijoin $super $DeferralPath\
                        -using {Domain Domain Class Model Relationship Relationship}\
                        $DeferredEvent |
                    relation update ~ deftup {1} {
                        tuple update $deftup Model [relation extract $sub Class]
                    }
                }]
                set multigens [relation semijoin $sub $Superclass\
                    -using {Domain Domain Class Class}]
        
                if {[relation isempty $multigens]} {
                    relvar minus ::rosea::Config::LocalEvent $defrdevents
                    relvar union ::rosea::Config::Event $defrdevents
                    relvar union ::rosea::Config::EffectiveEvent $defrdevents
                    relvar union ::rosea::Config::MappedEvent [relation extend\
                        $defrdevents metuple ParentModel string {$supername}]
                } else {
                    set consumed [relation semijoin $defrdevents $LocalEvent]
                    if {[relation isnotempty $consumed]} {
                        relvar minus ::rosea::Config::LocalEvent $consumed ; # <1>
                        relvar union ::rosea::Config::MappedEvent [relation extend\
                            $consumed ctup ParentModel string {$supername}]
                        relvar union ::rosea::Config::NonLocalEvent [relation extend\
                            $consumed nletuple\
                            Relationship string {[relation extract $sub Relationship]}\
                            Role string {[relation extract $sub Role]}]
                        set defrdevents [relation minus $defrdevents $consumed] ; # <2>
                    
                        set usedinsubs [pipe {
                            FindSubclassesOf $multigens|
                            relation tclose ~ |
                            relation semijoin $consumed ~ -using {Model Super} |
                            relation semijoin ~ $LocalEvent -using {Sub Model} |
                            relation semijoin $consumed ~ -using {Domain Domain Event Event}
                        }]
                        relvar minus ::rosea::Config::LocalEvent $usedinsubs ; # <3>
                        relvar minus ::rosea::Config::EffectiveEvent $usedinsubs
                        relvar minus ::rosea::Config::Event $usedinsubs
                    }
                    relvar union ::rosea::Config::Event $defrdevents
                    relvar union ::rosea::Config::DeferredEvent $defrdevents
                    relvar union ::rosea::Config::InheritedEvent $defrdevents
                    relvar union ::rosea::Config::DeferralPath [relation join\
                        $defrdevents $Superclass -using {Domain Domain Model Class}]
                }
        
                relvar union ::rosea::Config::NonLocalEvent [relation extend\
                    $defrdevents nletuple\
                    Relationship string {[relation extract $sub Relationship]}\
                    Role string {[relation extract $sub Role]}]
                relation foreach multigen $multigens {
                    PropagatePolyEvents $multigen
                }
            }
        }
        proc FindSubclassesOf {supers} {
            namespace upvar ::rosea::Config\
                Generalization Generalization\
                Superclass Superclass\
                Subclass Subclass
        
            if {[relation isempty $supers]} {# <1>
                return [relation create {Super string Sub string}]
            }
            set supnames [pipe {
                relation project $supers Class |
                relation rename ~ Class Super
            }] ; # <2>
            set subclasses [relation semijoin $supers\
                    $Generalization -using {Domain Domain Relationship Name}\
                    $Subclass -using {Domain Domain Name Relationship}]
            set subnames [pipe {
                relation project $subclasses Class |
                relation rename ~ Class Sub
            }] ; # <3>
            
            set uses [relation times $supnames $subnames] ; # <4>
        
            set nextsupers [relation semijoin $subclasses $Superclass\
                    -using {Domain Domain Class Class}] ; # <5>
        
            return [relation union $uses [FindSubclassesOf $nextsupers]] ; # <6>
        }
        proc UserDefaultTrace {defheading defvalues op relvar tuple} {
            tuple create\
                [dict merge $defheading [tuple heading $tuple]]\
                [dict merge $defvalues [tuple get $tuple]]
        }
        proc SupplyDefaultTrace {defheading op relvar tuple} {
            set attrs [tuple attributes $tuple] ; # <1>
            SplitRelvarName $relvar domain class ; # <2>
            foreach {attrname attrtype} $defheading {
                if {$attrname ni $attrs} {
                    set value [set ${domain}::__Arch_SuppliedDefault($class,$attrname)] ; # <3>
                    incr ${domain}::__Arch_SuppliedDefault($class,$attrname)
                    set tuple [tuple extend $tuple $attrname $attrtype $value] ; # <4>
                }
            }
            return $tuple
        }
        proc GenerateDefaultTrace {defheading defcmds op relvar tuple} {
            set attrs [tuple attributes $tuple]
            foreach {attrname attrtype} $defheading {
                if {$attrname ni $attrs} {
                    set value [eval [dict get $defcmds $attrname]]
                    set tuple [tuple extend $tuple $attrname $attrtype $value]
                }
            }
            return $tuple
        }
        proc CheckValueTrace {attrchecks op relvar args} {
            if {$op eq "insert"} {
                set tuple [lindex $args 0]
                EvalAttrCheck $attrchecks $tuple
                return $tuple
            } elseif {$op eq "update"} {
                set tuple [lindex $args 1]
                EvalAttrCheck $attrchecks $tuple
                return $tuple
            } elseif {$op eq "set"} {
                set relvalue [lindex $args 0]
                relation foreach inst $relvalue {
                    set tuple [relation tuple $inst]
                    EvalAttrCheck $attrchecks $tuple
                }
                return $relvalue
            } else {
                tailcall DeclError RELVAR_TRACE_OP $op
            }
        }
        proc EvalAttrCheck {attrchecks tuple} {
            dict for {attrname checkexpr} $attrchecks {
                tuple assign $tuple
                set result [expr $checkexpr]
                if {!$result} {
                    tailcall DeclError ATTR_CHECK_FAILED $attrname [tuple get $tuple]\
                        $checkexpr $result
                }
            }
        }
        proc QuerySystemOperations {which requiresSM} {
            return [pipe {
                relvar set ::rosea::Config::SuppliedOperation |
                relation restrictwith ~ {$RequiresStateModel == $requiresSM} |
                relation join [relvar set ::rosea::Config::$which] ~
            }]
        }
        proc QuerySystemClassOperations {className requiresSM} {
            return [pipe {
                QuerySystemOperations SystemClassOperation $requiresSM |
                relation update ~ sco 1 {
                    tuple update $sco Command\
                        [concat [tuple extract $sco Command]\
                        [list $className]]
                } |
                relation dict ~ Name Command
            }]
        }
        proc QuerySystemInstanceOperations {requiresSM} {
            return [pipe {
                QuerySystemOperations SystemInstanceOperation $requiresSM |
                relation dict ~ Name Command
            }]
        }
        proc Interleave {l1 l2} {
            set result [list]
            foreach a $l1 b $l2 {
                lappend result $a $b
            }
            return $result
        }
        proc MapCondMultToConstraint {cond mult} {
            if {$cond} {
                return [expr {$mult ? "*" : "?"}]
            } else {
                return [expr {$mult ? "+" : "1"}]
            }
        }
    }
    namespace eval ClassCmds {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [namespace parent]::Helpers ; # <1>
        proc findAll {relvar} {
            tailcall ToRef $relvar [relvar set $relvar]
        }
        proc findById {relvar args} {
            tailcall ToRef $relvar [relvar restrictone $relvar {*}$args]
        }
        proc findWhere {relvar expr} {
            tailcall ToRef $relvar [uplevel 1 [list ::ral relation restrictwith\
                [relvar set $relvar] $expr]]
        }
        proc create {relvar args} {
            if {[llength $args] % 2 != 0} {
                tailcall DeclError ARG_FORMAT $args
            }
            set ref [ToRef $relvar [relvar insert $relvar $args]] ; # <1>
            SplitRelvarName $relvar domain class
            CreateInInitialStateFromRef $domain $class $ref
            return $ref
        }
        proc createin {relvar state args} {
            if {[llength $args] % 2 != 0} {
                tailcall DeclError ARG_FORMAT $args
            }
            SplitRelvarName $relvar domain class
            set initstate [relvar restrictone ${domain}::__Arch_State\
                Class $class State $state]
            if {[relation isempty $initstate]} { # <1>
                tailcall DeclError UNKNOWN_STATE $state $relvar
            }
            set ref [ToRef $relvar [relvar insert $relvar $args]]
            CreateStateInstanceFromRef $domain $class $state $ref
            return $ref
        }
        proc createasync {relvar event eventparams args} {
            SplitRelvarName $relvar domain class
        
            if {[relation isempty [relvar restrictone ${domain}::__Arch_Event\
                    Class $class Event $event]]} {
                tailcall DeclError UNKNOWN_EVENT $event $class
            }
            if {[relation isempty [relvar restrictone ${domain}::__Arch_State\
                    Class $class State @]]} {
                tailcall DeclError NO_CREATION_EVENTS $class
            }
            set srcref [SelfInstRef]
            set eventInfo [dict create\
                type creation\
                src $srcref\
                dstClass $relvar\
                dstAttrs $args\
                event $event\
                params $eventparams\
            ]
            if {[::rosea::InstCmds::isRefEqual $srcref [nilInstRef]]} {
                lappend ::rosea::Dispatch::toc_queue $eventInfo
            } else {
                lappend ::rosea::Dispatch::event_queue $eventInfo
            }
            ::after 0 ::rosea::Dispatch::DispatchEvent
            return
        }
        proc update {relvar relvalue} {
            tailcall ToRef $relvar [relvar updateper $relvar $relvalue]
        }
    }
    namespace eval InstCmds {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace path [namespace parent]::Helpers
        pipe {
            relvar set ${domain}::$DstClass |
            relation $op $related ~ -using $Attrs
        } relatedQuery
        proc deRef {instref args} {
            lassign $instref relvar ref
            set inst [relation semijoin $ref [relvar set $relvar]] ; # <1>
            if {[llength $args] != 0} {
                set inst [relation project $inst\
                    {*}[relation attributes $ref] {*}$args] ; # <2>
            }
            return $inst
        }
        proc isEmptyRef {instref} {
            tailcall relation isempty [lindex $instref 1]
        }
        proc isNotEmptyRef {instref} {
            tailcall relation isnotempty [lindex $instref 1]
        }
        proc refMultiplicity {instref} {
            tailcall relation cardinality [lindex $instref 1]
        }
        proc isRefSingular {instref} {
            expr {[refMultiplicity $instref] == 1}
        }
        proc limitRef {instref {count 1}} {
            lassign $instref relvar insts
            return [pipe {
                relation tag $insts __Tag |
                relation restrictwith ~ {$__Tag >= 0 && $__Tag < $count} |
                ToRef $relvar ~
            }]
        }
        proc isRefEqual {instref1 instref2} {
            lassign $instref1 relvar1 inst1
            lassign $instref2 relvar2 inst2
            return [expr {$relvar1 eq $relvar2 && [relation is $inst1 equal $inst2]}]
        }
        proc RefSetCommand {op instref1 instref2} {
            lassign $instref1 relvar1 inst1
            lassign $instref2 relvar2 inst2
            if {$relvar1 ne $relvar2} {
                tailcall DeclError SAME_CLASS $relvar1 $relvar2
            }
            return [list $relvar1 [relation $op $inst1 $inst2]]
        }
        proc refUnion {instref1 instref2} {
            tailcall RefSetCommand union $instref1 $instref2
        }
        proc refIntersect {instref1 instref2} {
            tailcall RefSetCommand intersect $instref1 $instref2
        }
        proc refMinus {instref1 instref2} {
            tailcall RefSetCommand minus $instref1 $instref2
        }
        proc forAllRefs {varname instref body} {
            lassign $instref relvar refs
            upvar 1 $varname inst
            relation foreach ref $refs {
                set inst [list $relvar $ref]
                uplevel 1 $body
            } ; # <1>
            return
        }
        proc FindRelatedInsts {instref op args} {
            set srcrelvar [lindex $instref 0]
            SplitRelvarName $srcrelvar domain class
            
            # This procedure queries the architectural data about relationship linkage,
            # so we bring the relvar variables into scope.
            namespace upvar ${domain}\
                    __Arch_Link Link\
                    __Arch_AssociationLink AssociationLink\
                    __Arch_PartitionLink PartitionLink\
                    __Arch_PartitionDst PartitionDst
            variable relatedQuery ; # <1>
            # We start by dereferencing the instance reference.
            set related [deRef $instref]
            foreach linkage $args {
                lassign $linkage lname dst ; # split out the linkage spec
                
                set link [relvar restrictone ${domain}::__Arch_Link\
                        Name $lname SrcClass $class]
                if {[ral relation isempty $link]} {
                    tailcall DeclError UNKNOWN_LINKAGE $lname $class
                }
                # First we determine if we are dealing with an associative link or a
                # partition link.
                set assoc [relation join $link $AssociationLink]
                if {[relation isnotempty $assoc]} {
                    relation assign $assoc DstClass Attrs
                    # Check if additional path information was provided.
                    if {$dst eq {}} {
                        # Find the set of instances related to the current set.
                        set related [eval $relatedQuery]
                        # We must see if this is a class-based association.  If so, then the first
                        # traversal was to the associator and we must traverse again to the other
                        # class.
                        set assoc [relation semijoin $assoc $AssociationLink\
                            -using {Name Name SrcClass PrevSrcClass}]
                        if {[relation isnotempty $assoc]} {
                            relation assign $assoc DstClass Attrs
                            set related [pipe {# <1>
                                relvar set ${domain}::$DstClass |
                                relation semijoin $related ~ -using $Attrs
                            }]
                        }
                    } else {
                        # If a destination was specified in the linkage, then we need to verify
                        # that it is actually part of the relationship.
                        if {$dst ne $DstClass} {
                            tailcall DeclError PATH_ERROR $lname $class $DstClass\
                                $dst
                        }
                        set related [eval $relatedQuery]
                    }
                } else {
                    set partdst [relvar restrictone ${domain}::__Arch_PartitionDst\
                        Name $lname SrcClass $class DstClass $dst]
                    if {[relation isempty $partdst]} {
                        tailcall DeclError GEN_PATH_ERROR $class $lname $dst
                    }
                    relation assign $partdst DstClass Attrs
                    set related [eval $relatedQuery]
                }
                # Continue the iteration by setting the next source to the current
                # destination class.
                set class $DstClass
                set srcrelvar ${domain}::$class
            }
            # N.B. that we are not returning an instance reference but rather the
            # complete relation value of the related instances. This allows us
            # to further filter the result in the "findRelatedWhere" command.
            return [list $srcrelvar $related]
        }
        proc findRelated {instref args} {
            tailcall ToRef {*}[FindRelatedInsts $instref semijoin {*}$args] ; # <1>
        }
        proc findUnrelated {instref args} {
            tailcall ToRef {*}[FindRelatedInsts $instref semiminus {*}$args] ; # <1>
        }
        proc findRelatedWhere {instref rchain expr} {
            lassign [FindRelatedInsts $instref semijoin {*}$rchain] relvar insts
            tailcall ToRef $relvar [uplevel 1\
                [list ::ral relation restrictwith $insts $expr]] ; # <1>
        }
        proc findUnrelatedWhere {instref rchain expr} {
            lassign [FindRelatedInsts $instref semiminus {*}$rchain] relvar insts
            tailcall ToRef $relvar [uplevel 1\
                [list ::ral relation restrictwith $insts $expr]]
        }
        proc idInstance {instref} {
            lassign $instref relvar insts
            SplitRelvarName $relvar domain relationship
            set assignrelvar ${domain}::${relationship}__STATEINST
            if {![relvar exists $assignrelvar]} {
                tailcall DeclError NO_ASSIGNER $rname
            }
        
            set idclass [pipe {
                relvar restrictone [namespace parent]::Config::MultipleAssigner\
                        Domain [string trim $domain :] Relationship $relationship |
                relation extract ~ Class
            }]
        
            return [pipe {
                relvar set ${domain}::$idclass |
                relation semijoin $insts ~ |
                ToRef ${domain}::$idclass ~
            }]
        }
        proc updateAttribute {instref args} {
            if {[llength $args] % 2 != 0} {
                tailcall DeclError ARG_ERROR $args
            }
            
            lassign $instref relvar insts
            if {[relation cardinality $insts] != 1} {
                tailcall MUST_BE_SINGULAR $relvar [relation cardinality $insts]
            }
            set idattrs [list]
            foreach identifier [relvar identifiers $relvar] {
                ::struct::set add idattrs $identifier
            }
            set idupdates [::struct::set intersect $idattrs $args]
            if {![::struct::set empty $idupdates]} {
                tailcall DeclError ID_UPDATE [join $idupdates {, }]
            }
            set extcmd [list relation extend $insts exttuple]
            set heading [relation heading [relvar set $relvar]]
            foreach {attr value} $args {
                if {![dict exists $heading $attr]} {
                    tailcall DeclError UNKNOWN_ATTRIBUTE $attr
                }
                lappend extcmd $attr [dict get $heading $attr] \{$value\}
            }
            relvar updateper $relvar [eval $extcmd]
            return
        }
        proc withAttribute {instref args} {
            if {[llength $args] < 2} {
                tailcall DeclError WITH_ATTR_USAGE
            }
            
            lassign $instref relvar insts
            if {[relation cardinality $insts] != 1} {
                tailcall MUST_BE_SINGULAR $relvar [relation cardinality $insts]
            }
            
            set body [lindex $args end]
            set attrspecs [lrange $args 0 end-1]
            set attrnames [list]
            set varnames [list]
            foreach attrspec $attrspecs {
                set speclen [llength $attrspec]
                if {$speclen == 1} {
                    lappend attrnames [lindex $attrspec 0]
                    lappend varnames [lindex $attrspec 0]
                } elseif {$speclen == 2} {
                    lappend attrnames [lindex $attrspec 0]
                    lappend varnames [lindex $attrspec 1]
                } else {
                    tailcall DeclError ATTR_VAR_SPEC $attrspec
                }
            }
            set idattrs [list]
            foreach identifier [relvar identifiers $relvar] {
                ::struct::set add idattrs $identifier
            }
            set idupdates [::struct::set intersect $idattrs $attrnames]
            if {![::struct::set empty $idupdates]} {
                tailcall DeclError ID_UPDATE [join $idupdates {, }]
            }
            uplevel 1 [list ral relation assign [deRef $instref] {*}$attrspecs]
            uplevel 1 $body
            set extcmd [list relation extend $insts exttuple]
            set heading [relation heading [relvar set $relvar]]
            foreach attr $attrnames var $varnames {
                if {[uplevel 1 [list info exists $var]]} {
                    upvar 1 $var varvalue
                    lappend extcmd $attr [dict get $heading $attr] \{$varvalue\}
                }
            }
            relvar updateper $relvar [eval $extcmd]
        
            return
        }
        proc readAttribute {ref args} {
            # We insist upon a singular reference for reading attributes.  Multiple
            # references can be handled by dereferences and using TclRAL "relation"
            # commands.
            if {![isRefSingular $ref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $ref]
            }
        
            return [expr {[llength $args] == 0 ? {} :\
                [relation extract [deRef $ref {*}$args] {*}$args]}] ; # <1>
        }
        proc assignAttribute {ref args} {
            # We must insist upon a singular references, since assigning to scalar
            # variables from a relation value doesn't make a lot of sense.
            if {![isRefSingular $ref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $ref]
            }
        
            uplevel 1 [list ral relation assign [deRef $ref] {*}$args] ; # <1>
            return
        }
        proc delete {args} {
            foreach instref $args {
                lassign $instref relvar insts
                relvar minus $relvar [deRef $instref]
        
                SplitRelvarName $relvar domain class
                set instrelvar ${domain}::${class}__STATEINST
                if {[relvar exists $instrelvar]} {
                    relvar minus $instrelvar [relation semijoin $insts\
                        [relvar set $instrelvar]]
                }
            }
        
            return
        }
        proc signal {dstset event args} {
            set srcref [SelfInstRef]
            if {![::rosea::Dispatch::MapPolymorphicEvent ::rosea::Dispatch::SignalEvent\
                    $srcref $dstset $event $args]} {
                ::rosea::Dispatch::SignalEvent $srcref $dstset $event $args
            }
            return
        }
        proc delaysignal {time dstset event args} {
            if {!([string is integer -strict $time] && $time >= 0)} {
                tailcall DeclError INVALID_TIME $time
            }
            set srcref [SelfInstRef]
            if {![::rosea::Dispatch::MapPolymorphicEvent\
                    [list ::rosea::Dispatch::SignalDelayedEvent $time]\
                    $srcref $dstset $event $args]} {
                ::rosea::Dispatch::SignalDelayedEvent $time $srcref $dstset $event $args
            }
            return
        }
        proc canceldelayed {srcref dstset event} {
            set srcmult [refMultiplicity $srcref]
            if {$srcmult > 1} {
                tailcall DeclError SINGLE_OR_EMPTY_REF_REQUIRED $srcmult
            }
            forAllRefs dstref $dstset {
                ::rosea::Dispatch::CancelDelayedSignal $srcref $event $dstref
            }
            return
        }
        proc delayremaining {srcref dstref event} {
            set srcmult [refMultiplicity $srcref]
            if {$srcmult > 1} {
                tailcall DeclError SINGLE_OR_EMPTY_REF_REQUIRED $srcmult
            }
            if {![isRefSingular $dstref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $dstref]
            }
            tailcall ::rosea::Dispatch::SignalTimeRemaining $srcref $event $dstref
        }
        proc instop {instref op args} {
            tailcall [lindex $instref 0]::Instance $instref $op {*}$args
        }
    }
    namespace eval RelCmds {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [list\
            [namespace parent]::Helpers\
            [namespace parent]::InstCmds\
        ]
        proc linkSimple {rname instref1 instref2} {
            lassign $instref1 relvar1 inst1
            SplitRelvarName $relvar1 domain1 class1
            
            lassign $instref2 relvar2 inst2
            SplitRelvarName $relvar2 domain2 class2
            
            if {$domain1 ne $domain2} {
                tailcall DeclError NO_CROSS_DOMAIN $domain1 $domain2
            }
            set reflink [relvar restrictone ${domain1}::__Arch_RefLink Relationship $rname]
            if {[relation isempty $reflink]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            relation assign $reflink\
                {ReferringClass referringClass}\
                {ReferencedClass referencedClass}\
                {ReferringAttrs referringAttrs} ; # <1>
            if {$class1 eq $referringClass && $class2 eq $referencedClass} {
                set fromrelvar $relvar1
                set frominsts $inst1
                set torelvar $relvar2
                set toinst $inst2
            } elseif {$class2 eq $referringClass && $class1 eq $referencedClass} {
                set fromrelvar $relvar2
                set frominsts $inst2
                set torelvar $relvar1
                set toinst $inst1
            } else {
                tailcall DeclError NON_PARTICIPANTS $relvar1 $relvar2 $rname\
                    $referringClass $referencedClass
            }
            if {[relation cardinality $toinst] != 1} {
                tailcall MUST_BE_SINGULAR $torelvar [relation cardinality $toinst]
            }
            set refedvalue [relation semijoin $toinst [relvar set $torelvar]]
            set tovalues [pipe {
                relation extend $referringAttrs rfa RefValue string {
                    [relation extract $refedvalue\
                        [tuple extract $rfa ReferencedAttribute]]} |
                relation dict ~ ReferringAttribute RefValue
            }]
            relation foreach frominst $frominsts {
                relvar updateone $fromrelvar fromtup\
                        [tuple get [relation tuple $frominst]] { # <1>
                    tuple update $fromtup {*}$tovalues ; # <2>
                }
            }
        
            return
        }
        proc linkAssoc {rname instref1 instref2 args} {
            lassign $instref1 relvar1 inst1
            SplitRelvarName $relvar1 domain1 class1
            
            lassign $instref2 relvar2 inst2
            SplitRelvarName $relvar2 domain2 class2
            
            if {$domain1 ne $domain2} {
                tailcall DeclError NO_CROSS_DOMAIN $domain1 $domain2
            }
            set assocref [relvar restrictone ${domain1}::__Arch_AssocRef\
                    Relationship $rname]
            if {[relation isempty $assocref]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            
            relation assign $assocref\
                {AssocClass assocClass}\
                {References references}
            set ref1 [relation restrictwith $references {$Participant eq $class1}]
            if {[relation isempty $ref1]} {
                tailcall DeclError NOT_IN_ASSOCIATION $class1 $rname
            }
            if {[relation cardinality $ref1] > 1} {
                set ref2 [relation restrictwith $ref1 {$Role eq "target"}]
                set ref1 [relation minus $ref1 $ref2] ; # <1>
            } else {
                set ref2 [relation restrictwith $references {$Participant eq $class2}]
                if {[relation isempty $ref2]} {
                    tailcall DeclError NOT_IN_ASSOCIATION $class2 $rname
                }
            }
            
            set rattr1 [relation extract $ref1 ReferringAttrs]
            set rattr2 [relation extract $ref2 ReferringAttrs]
            set values1 [relation semijoin $inst1 [relvar set $relvar1]]
            set values2 [relation semijoin $inst2 [relvar set $relvar2]]
            set assoctuples [list]
            relation foreach v1 $values1 { # <1>
                set refto1 [pipe {
                    relation extend $rattr1 rfa RefValue string {
                        [relation extract $v1 [tuple extract $rfa ReferencedAttribute]]
                    } |
                    relation dict ~ ReferringAttribute RefValue
                }]
                relation foreach v2 $values2 {
                    set refto2 [pipe {
                        relation extend $rattr2 rfa RefValue string {
                            [relation extract $v2\
                                [tuple extract $rfa ReferencedAttribute]]
                        } |
                        relation dict ~ ReferringAttribute RefValue
                    }]
            
                    lappend assoctuples [dict merge $args $refto1 $refto2] ; # <2>
                }
            }
            set ref [ToRef ${domain1}::$assocClass\
                    [relvar insert ${domain1}::$assocClass {*}$assoctuples]]
                CreateInInitialStateFromRef $domain1 $assocClass $ref ; # <1>
            return $ref
        }
        proc referenceAssoc {rname assocref instref {dir {}}} {
            if {![isRefSingular $assocref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $assocref]
            }
            lassign $assocref assocrelvar associnst
            SplitRelvarName $assocrelvar assocdomain assocclass
            
            if {![isRefSingular $instref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $instref]
            }
            lassign $instref instrelvar inst
            SplitRelvarName $instrelvar instdomain instclass
            
            if {$assocdomain ne $instdomain} {
                tailcall DeclError NO_CROSS_DOMAIN $domain1 $domain2
            }
            set assocref [relvar restrictone ${instdomain}::__Arch_AssocRef\
                    Relationship $rname]
            if {[relation isempty $assocref]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            
            relation assign $assocref\
                {AssocClass assocClass}\
                {References references}
            
            if {$assocClass ne $assocclass} {
                tailcall DeclError NOT_IN_ASSOCIATION $assocclass $rname
            }
            set ref [relation restrictwith $references {$Participant eq $instclass}]
            set refcard [relation cardinality $ref]
            if {$refcard == 2} {
                switch -exact -- $dir {
                    forward {
                        set role target
                    }
                    backward {
                        set role source
                    }
                    default {
                        tailcall DeclError DIRECTION_REQUIRED $dir
                    }
                }
                set ref [relation restrictwith $ref {$Role eq $role}]
            } elseif {$refcard == 0} {
                tailcall DeclError NOT_IN_ASSOCIATION $instclass $rname
            }
            set referringAttrs [relation extract $ref ReferringAttrs]
            
            set refedvalue [relation semijoin $inst [relvar set $instrelvar]]
            
            set tovalues [pipe {
                relation extend $referringAttrs rfa RefValue string {
                    [relation extract $refedvalue\
                        [tuple extract $rfa ReferencedAttribute]]} |
                relation dict ~ ReferringAttribute RefValue
            }]
            relvar updateone $assocrelvar assoctup [tuple get [relation tuple $associnst]] {
                tuple update $assoctup {*}$tovalues
            }
        }
        proc unlinkSimple {rname instref} {
            lassign $instref relvar inst
            SplitRelvarName $relvar domain class
        
            set reflink [relvar restrictone ${domain}::__Arch_RefLink\
                    Relationship $rname]
            if {[relation isempty $reflink]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            relation assign $reflink\
                {ReferringClass referringClass}\
                {ReferencedClass referencedClass}\
                {ReferringAttrs referringAttrs}
        
            if {$class eq $referringClass} {
                set fromrelvar $relvar
                set frominsts $inst
            } elseif {$class eq $referencedClass} {
                lassign [::rosea::InstCmds::findRelated $instref ~$rname]\
                    fromrelvar frominsts
            } else {
                tailcall DeclError NOT_IN_ASSOCIATION $relvar $rname
            }
        
            set tovalues [pipe {
                relation extend $referringAttrs rfa RefValue string {{}} |
                relation dict ~ ReferringAttribute RefValue
            }]
        
            relation foreach frominst $frominsts {
                relvar updateone $fromrelvar fromtup\
                        [tuple get [relation tuple $frominst]] {
                    tuple update $fromtup {*}$tovalues
                }
            }
        
            return
        }
        proc unlinkAssoc {rname instref} {
            lassign $instref relvar insts
            SplitRelvarName $relvar domain class
        
            set assocref [relvar restrictone ${domain}::__Arch_AssocRef\
                    Relationship $rname]
            if {[relation isempty $assocref]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            relation assign $assocref\
                {Relationship relationship}\
                {AssocClass associator}\
                {References references}
        
            # If we are given instances to the associator class, then there is no
            # more work to do.
            if {$class ne $associator} {
                # Otherwise, we have to find the associator class instances ourselves.
                set part [relation restrictwith $references {$Participant eq $class}]
                set partcard [relation cardinality $part]
                if {$partcard == 0} {
                    tailcall DeclError NOT_IN_ASSOCIATION $class $rname
                } elseif {$partcard > 1} {
                    tailcall DeclError AMBIGUOUS_UNLINK $rname $relvar ; # <1>
                } else {
                    # Find associative class instances.  We have to determine the
                    # direction of the relationship traversal.
                    set navdir [expr {[relation extract $part Role] eq "source" ?\
                        "$relationship" : "~$relationship"}]
                    set instref [::rosea::InstCmds::findRelated $instref\
                        [list $navdir [namespace tail $associator]]]
                    lassign $instref relvar insts
                    SplitRelvarName $relvar domain class
                }
            }
        
            # We are going to delete tuples from the relvar that holds the class
            # instances.
            set delrelvars [list ${domain}::$class]
            # If the associative class also has a state model, then we need to also
            # delete the state instance tuples.
            if {[relvar exists ${domain}::${class}__STATEINST]} {
                lappend delrelvars ${domain}::${class}__STATEINST
            }
        
            # Now, we iterate across the associative class instances and delete all the
            # tuples in class relvar and, if necessary, the state instances.
            relation foreach inst $insts {
                set idattrs [tuple get [relation tuple $inst]]
                foreach rv $delrelvars {
                    relvar deleteone $rv {*}$idattrs
                }
            }
            return $instref
        }
        proc migrate {rname instref subclass args} {
            if {![isRefSingular $instref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $instref]
            }
            lassign $instref relvar inst
            SplitRelvarName $relvar domns class
        
            set link [relvar restrictone ${domns}::__Arch_AssociationLink Name $rname\
                    SrcClass $class]
            if {[relation isempty $link]} {
                tailcall DeclError NO_SUBCLASS $rname $relvar
            }
        
            # Traverse the relationship to the superclass. We need to get the values of
            # the referenced attributes to use in creating the new subclass instance.
            set superinst [pipe {
                relvar set ${domns}::[relation extract $link DstClass] |
                relation semijoin $inst ~ -using [relation extract $link Attrs]
            }]
        
            set sublink [relvar restrictone ${domns}::__Arch_SubLink\
                    Relationship $rname SubClass $subclass]
            if {[relation isempty $sublink]} {
                tailcall DeclError NO_SUBCLASS $rname $subclass
            }
        
            # Using the same relation extend strategy, we compute a dictionary of the
            # attribute names / values as they must appear in the subclass we are about
            # to create.
            set refedvalues [pipe {
                relation extract $sublink ReferringAttrs |
                relation extend ~ rval Value string {
                    [relation extract $superinst\
                        [tuple extract $rval ReferencedAttribute]]
                } |
                relation dict ~ ReferringAttribute Value
            }]
        
            # We use the class commands to delete the old subclass instance and create
            # the new one. This will make sure that if the subclass has a state model
            # that the initial state is set correctly.
            # N.B. this is _not_ done in a relvar transaction. The transaction
            # boundaries should be set by the current thread of control or domain
            # operation.
            ::rosea::InstCmds::delete $instref
            return [::rosea::ClassCmds::create ${domns}::$subclass\
                    {*}[dict merge $args $refedvalues]]
        }
        proc signalAssigner {rname event args} {
            SplitRelvarName $rname domain relationship
            set assignrelvar ${domain}::${relationship}__STATEINST
            if {![relvar exists $assignrelvar]} {
                tailcall DeclError NO_ASSIGNER $rname
            }
        
            set dstref [pipe {
                relvar set $assignrelvar |
                relation project ~ {*}[lindex [relvar identifiers $assignrelvar] 0] |
                list $rname ~
            }]
            ::rosea::Dispatch::SignalEvent [SelfInstRef] $dstref $event $args
        
            return
        }
        proc signalMultiAssigner {rname idvalues event args} {
            SplitRelvarName $rname domain relationship
            set assignrelvar ${domain}::${relationship}__STATEINST
            if {![relvar exists $assignrelvar]} {
                tailcall DeclError NO_ASSIGNER $rname
            }
            set idattrs [lindex [relvar identifiers $assignrelvar] 0]
            # We will insist that the idvalues contain the necessary identifying
            # attributes.
            if {![struct::set equal [dict keys $idvalues] $idattrs]} {
                tailcall DeclError NO_IDENTIFIER [dict keys $idvalues] $idattrs
            }
            set assigninsts [relvar set $assignrelvar]
            set assignrefs [relation project $assigninsts {*}$idattrs]
        
            # We need to find the tuple in "assignrefs" that matches the attributes and
            # values in "idvalues". We will do this by creating a relation value from
            # the idvalues list and semijoining that to "assignrefs". If we come up
            # non-empty, then we have found our multi-assigner instance.
            set heading [relation heading $assignrefs]
            set dstinst [pipe {
                tuple create $heading $idvalues |
                tuple relation ~ |
                relation semijoin ~ $assignrefs
            }]
            if {[relation isempty $dstinst]} {
                tailcall DeclError UNKNOWN_ASSIGNER $idvalues $rname
            }
        
            set dstref [list $rname $dstinst]
            ::rosea::Dispatch::SignalEvent [SelfInstRef] $dstref $event $args ; # <1>
        
            return
        }
        proc createMultiAssigner {rname args} {
            if {[llength $args] % 2 != 0} {
                tailcall DeclError ARG_FORMAT $args
            }
            SplitRelvarName $rname domain relationship
            set assignrelvar ${domain}::${relationship}__STATEINST
            if {![relvar exists $assignrelvar]} {
                tailcall DeclError NO_ASSIGNER $rname
            }
            set idattrs [lindex [relvar identifiers $assignrelvar] 0]
            if {![struct::set equal [dict keys $args] $idattrs]} {
                tailcall DeclError NO_IDENTIFIER [dict keys $args] $idattrs
            }
            CreateInInitialState $domain $relationship $args
        }
    }
    namespace eval Dispatch {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [list\
            [namespace parent]::Helpers\
            [namespace parent]::InstCmds\
        ]
        variable toc_queue [list]
        variable event_queue [list]
        pipe {
            relvar restrictone ${domain}::__Arch_Transition\
                Class $class State $currstate Event $event |
            relation extract ~ NewState
        } transitionQuery
        relvar create DelayedSignal {
            RefId           int
            SrcInstRef      list
            Event           string
            DstInstRef      list
            TimerId         string
            Expire          bignum
        } RefId {SrcInstRef Event DstInstRef} TimerId
        variable DelayedSignalId 0
        pipe {
            relvar set ${domain}::__Arch_PartitionDst |
            relation restrictwith ~ {$SrcClass eq $dstclass} |
            relation group ~ DstLinks DstClass Attrs
        } polymapQuery
        proc SignalEvent {srcref dstset event arglist} {
            lassign $dstset relvar insts
            SplitRelvarName $relvar domain class
            if {[relation isempty [relvar restrictone ${domain}::__Arch_Event\
                    Class $class Event $event]]} {
                tailcall DeclError UNKNOWN_EVENT $event $class
            }
        
            set callback [namespace code DispatchEvent]
            set eventInfo [dict create\
                type ordinary\
                src $srcref\
                event $event\
                params $arglist\
            ]
            if {[isRefEqual $srcref [nilInstRef]]} {
                variable toc_queue
                forAllRefs dstref $dstset {
                    # Queue the thread of control events.
                    dict set eventInfo dst $dstref
                    lappend toc_queue $eventInfo
                    ::after 0 $callback
                }
            } else {
                variable event_queue
                forAllRefs dstref $dstset {
                    dict set eventInfo dst $dstref
                    if {[isRefEqual $srcref $dstref]} { # <1>
                        for {set eqindex 0} {$eqindex < [llength $event_queue]} {incr eqindex} {
                            set cmpevent [lindex $event_queue $eqindex]
                            if {![isRefEqual [dict get $cmpevent src] [dict get $cmpevent dst]]} {
                                break
                            }
                        }
                        set event_queue [linsert [K $event_queue [set event_queue {}]]\
                                $eqindex $eventInfo] ; # <1>
                    } else {
                        # Non-self directed events are always simply appended to the
                        # event queue.
                        lappend event_queue $eventInfo
                    }
                    ::after 0 $callback
                }
            }
        }
        proc DispatchEvent {} {
            variable event_queue
            variable toc_queue
            
            if {[llength $event_queue] != 0} {
                set eventInfo [lindex $event_queue 0]
                set event_queue [lrange [K $event_queue [set event_queue {}]] 1 end] ; # <1>
            } elseif {[llength $toc_queue] != 0} {
                set eventInfo [lindex $toc_queue 0]
                set toc_queue [lrange [K $toc_queue [set toc_queue {}]] 1 end]
                relvar transaction begin ; # <2>
            } else {
                return
            }
            if {[dict get $eventInfo type] eq "creation"} {
                try {
                    set dstref [::rosea::ClassCmds::createin\
                            [dict get $eventInfo dstClass] @\
                            {*}[dict get $eventInfo dstAttrs]] ; # <1>
                } on error {result} {
                    catch {
                        if {[llength $event_queue] == 0} {
                            relvar transaction end
                        }
                    }
                    tailcall DeclError ASYNC_CREATION_FAILED [dict get $eventInfo dstClass]\
                        [dict get $eventInfo dstAttrs] $result
                }
                dict set eventInfo dst $dstref ; # <2>
                ::rosea::Trace::TraceCreation [dict get $eventInfo src]\
                    [dict get $eventInfo event] $dstref [dict get $eventInfo params]
            }
            set dstref [dict get $eventInfo dst]
            lassign $dstref relvar ref
            SplitRelvarName $relvar domain class
            
            set instrelvar ${domain}::${class}__STATEINST
            set state [relation semijoin $ref [relvar set $instrelvar]]
            if {[relation isempty $state]} {
                tailcall DeclError EVENT_IN_FLIGHT [dict get $eventInfo event] $ref
            }
            set currstate [relation extract $state __State]
            set event [dict get $eventInfo event]
            variable transitionQuery
            set newState [eval $transitionQuery]
            
            ::rosea::Trace::TraceTransition [dict get $eventInfo src]\
                $event $dstref $currstate $newState [dict get $eventInfo params] ; # <1>
            try {
                if {$newState eq "CH"} {
                    TransitionError [dict get $eventInfo src] $event $dstref $currstate
                } elseif {$newState ne "IG"} {
                    set idattrs [tuple get [relation tuple $ref]]
                    relvar updateone $instrelvar is $idattrs {
                        tuple update $is __State $newState
                    }
                    try {
                        ${relvar}::__Activity::$newState $dstref\
                                {*}[dict get $eventInfo params] ; # <1>
                    } on error {result opts} {
                        return -options $opts $result
                    } finally {
                        set term [relvar restrictone ${domain}::__Arch_TerminalState\
                                Class $class State $newState]
                        if {[relation isnotempty $term]} {
                            relvar deleteone $relvar {*}$idattrs
                            relvar deleteone $instrelvar {*}$idattrs
                        }
                    }
                }
            } on error {result opts} {
                catch {
                    if {[llength $event_queue] == 0} {
                        relvar transaction end
                    }
                } ; # <1>
                return -options $opts $result
            }
            
            if {[llength $event_queue] == 0} {
                relvar transaction end
            }
            return
        }
        proc TransitionError {src event dst currstate} {
            tailcall DeclError CANT_HAPPEN_EVENT $src $event $dst $currstate
        }
        proc FindDelayedSignal {srcref event dstref} {
            variable DelayedSignal
            return [relation restrictwith $DelayedSignal {
                    [isRefEqual $SrcInstRef $srcref] && $Event eq $event &&\
                    [isRefEqual $DstInstRef $dstref]}]
        }
        proc DeleteDelayedSignal {srcref event dstref} {
            relvar delete DelayedSignal dsig {
                [isRefEqual [tuple extract $dsig SrcInstRef] $srcref] &&\
                [tuple extract $dsig Event] eq $event &&\
                [isRefEqual [tuple extract $dsig DstInstRef] $dstref]
            }
        }
        proc SignalDelayedEvent {time srcref dstset event arglist} {
            lassign $dstset relvar insts
            SplitRelvarName $relvar domain class
            if {[relation isempty [relvar restrictone ${domain}::__Arch_Event\
                    Class $class Event $event]]} {
                tailcall DeclError UNKNOWN_EVENT $event $class
            }
        
            variable DelayedSignalId
            set eventInfo [dict create\
                id [incr DelayedSignalId]\
                type ordinary\
                src $srcref\
                event $event\
                params $arglist\
            ]
            forAllRefs dstref $dstset {
                dict set eventInfo dst $dstref
                DeleteDelayedSignal $srcref $event $dstref ; # <1>
                relvar insert DelayedSignal [list\
                    RefId       $DelayedSignalId\
                    SrcInstRef  $srcref\
                    Event       $event\
                    DstInstRef  $dstref\
                    TimerId     [::after $time [list\
                                ::rosea::Dispatch::DispatchDelayedEvent $eventInfo]]\
                    Expire      [expr {entier([clock milliseconds]) + entier($time)}]\
                ]
            }
            return
        }
        proc DispatchDelayedEvent {eventInfo} {
            relvar deleteone DelayedSignal RefId [dict get $eventInfo id]
            variable toc_queue
            lappend toc_queue $eventInfo
            tailcall DispatchEvent
        }
        proc CancelDelayedSignal {srcref event dstref} {
            variable DelayedSignal
            set sig [FindDelayedSignal $srcref $event $dstref]
            if {[relation isnotempty $sig]} {
                ::after cancel [relation extract $sig TimerId]
                DeleteDelayedSignal $srcref $event $dstref
            } else {
                # Search the toc_queue to see if the signal delay has already expired
                # and the event is awaiting dispatch.
                variable toc_queue
                for {set i 0} {$i < [llength $toc_queue]} {incr i} {
                    set eventInfo [lindex $toc_queue $i]
                    dict update eventInfo src evtsrc dst evtdst event evtevent {
                        if {[isRefEqual $evtsrc $srcref] &&\
                                [isRefEqual $evtdst $dstref] &&\
                                $evtevent eq $event} {
                            set toc_queue [lreplace\
                                    [K $toc_queue [set toc_queue {}]] $i $i]
                            break
                        }
                    }
                }
            }
        }
        proc SignalTimeRemaining {srcref event dstref} {
            set sig [FindDelayedSignal $srcref $event $dstref]
            return [expr {[relation isempty $sig] ? 0 :\
                max([relation extract $sig Expire] - [clock milliseconds], 0)}] ; # <1>
        }
        proc MapPolymorphicEvent {frwdcmd srcref dstrefs event arglist} {
            lassign $dstrefs dstrelvar dstinsts
            SplitRelvarName $dstrelvar domain dstclass
            set polyevent [relvar restrictone ${domain}::__Arch_PolymorphicEvent\
                Class $dstclass Event $event]
            if {[relation isempty $polyevent]} {
                return false
            }
            variable polymapQuery
            set partitions [eval $polymapQuery]
            relation foreach inst $dstinsts {
                relation foreach partition $partitions {
                    relation assign $partition
                    relation foreach dstlink $DstLinks {
                        relation assign $dstlink
                        set related [relation semijoin $inst\
                            [relvar set ${domain}::$DstClass] -using $Attrs]
                        if {[relation isnotempty $related]} {
                            set dstreference [ToRef ${domain}::${DstClass} $related]
                            set target [ToRef $dstrelvar $inst]
                            ::rosea::Trace::TracePolymorphic $srcref $event $target $dstreference $Name\
                                    $arglist
                            if {![MapPolymorphicEvent $frwdcmd $target $dstreference $event $arglist]} {
                                {*}$frwdcmd $target $dstreference $event $arglist ; # <1>
                            }
                            break
                        }
                    }
                }
            }
        
            return true
        }
    }
    namespace eval Config {
        logger::initNamespace [namespace current]
    
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [namespace parent]::Helpers
        variable evalLambda {{body} {
            upvar #0 ::rosea::Config::errcount errcount ; # <1>
            upvar #0 ::rosea::Config::configlineno configlineno
            set lineno $configlineno
            set command {}
            foreach line [split $body \n] { # <2>
                append command $line \n
                incr lineno ; # <3>
                if {[info complete $command]} {
                    try {
                        eval $command
                    } on error {result} {
                        log::error "line $configlineno: \"$result\""
                        incr errcount
                    }
                    set command {} ; # <4>
                    set configlineno $lineno
                }
            }
            return $errcount
        }}
        relvar create Domain {
            Name        string
            Location    string
        } Name
        relvar create DomainElement {
            Domain  string
            Element string
        } {Domain Element}
        relvar association R1\
            DomainElement Domain *\
            Domain Name 1
        relvar create Class {
            Domain  string
            Name    string
        } {Domain Name}
        relvar create Relationship {
            Domain  string
            Name    string
        } {Domain Name}
        relvar create DomainOperation {
            Domain      string
            Name        string
            Parameters  list
            Body        string
        } {Domain Name}
        relvar partition R2 DomainElement {Domain Element}\
            Class {Domain Name}\
            Relationship {Domain Name}\
            DomainOperation {Domain Name}
        relvar create Attribute {
            Domain  string
            Class   string
            Name    string
            Type    string
        } {Domain Class Name}
        relvar association R3\
            Attribute {Domain Class} +\
            Class {Domain Name} 1
        relvar create Identifier {
            Domain  string
            Class   string
            Number  int
        } {Domain Class Number}
        relvar association R4\
            Identifier {Domain Class} +\
            Class {Domain Name} 1
        relvar create IdentifyingAttribute {
            Domain      string
            Class       string
            Attribute   string
            Number      int
        } {Domain Class Attribute Number}
        relvar correlation R5 IdentifyingAttribute\
            {Domain Class Number} + Identifier {Domain Class Number}\
            {Domain Class Attribute} * Attribute {Domain Class Name}
        relvar create DefaultValue {
            Domain      string
            Class       string
            Attribute   string
        } {Domain Class Attribute}
        relvar association R6\
            DefaultValue {Domain Class Attribute} ?\
            Attribute {Domain Class Name} 1
        relvar create UserSuppliedValue {
            Domain      string
            Class       string
            Attribute   string
            Value       string
        } {Domain Class Attribute}
        relvar create SystemSuppliedValue {
            Domain      string
            Class       string
            Attribute   string
            StartValue  int
        } {Domain Class Attribute}
        relvar create GeneratedValue {
            Domain      string
            Class       string
            Attribute   string
            Cmd         string
        } {Domain Class Attribute}
        relvar partition R18 DefaultValue {Domain Class Attribute}\
            UserSuppliedValue {Domain Class Attribute}\
            SystemSuppliedValue {Domain Class Attribute}\
            GeneratedValue {Domain Class Attribute}
        relvar create ValueCheck {
            Domain      string
            Class       string
            Attribute   string
            Expression  string
        } {Domain Class Attribute}
        relvar association R17\
            ValueCheck {Domain Class Attribute} ?\
            Attribute {Domain Class Name} 1
        relvar create AttributeReference {
            Domain              string
            ReferringClass      string
            ReferringAttribute  string
            ReferringRole       string
            ReferencedClass     string
            ReferencedAttribute string
            ReferencedRole      string
            ReferencedIdNumber  int
            Relationship        string
        } {Domain ReferringClass ReferringAttribute ReferringRole\
            ReferencedClass ReferencedAttribute ReferencedRole ReferencedIdNumber\
            Relationship}
        relvar association R13\
            AttributeReference {Domain ReferringClass ReferringAttribute} *\
            Attribute {Domain Class Name} 1
        relvar create ReferencedIdAttribute {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Attribute       string
            Number          int
        } {Domain Class Relationship Role Attribute Number}
        relvar create Operation {
            Domain  string
            Class   string
            Name    string
        } {Domain Class Name}
        
        relvar association R8\
            Operation {Domain Class} * Class {Domain Name} 1
        
        relvar create InstanceOperation {
            Domain  string
            Class   string
            Name    string
        } {Domain Class Name}
        
        relvar create ClassOperation {
            Domain  string
            Class   string
            Name    string
        } {Domain Class Name}
        
        relvar partition R7 Operation {Domain Class Name}\
            InstanceOperation {Domain Class Name}\
            ClassOperation {Domain Class Name}
        
        relvar create UserInstanceOperation {
            Domain      string
            Class       string
            Name        string
            Parameters  string
            Body        string
        } {Domain Class Name}
        
        relvar create SystemInstanceOperation {
            Domain      string
            Class       string
            Name        string
        } {Domain Class Name}
        
        relvar partition R9 InstanceOperation {Domain Class Name}\
            UserInstanceOperation {Domain Class Name}\
            SystemInstanceOperation {Domain Class Name}
        
        relvar create UserClassOperation {
            Domain  string
            Class   string
            Name    string
            Parameters  string
            Body        string
        } {Domain Class Name}
        
        relvar create SystemClassOperation {
            Domain  string
            Class   string
            Name    string
        } {Domain Class Name}
        
        relvar partition R10 ClassOperation {Domain Class Name}\
            UserClassOperation {Domain Class Name}\
            SystemClassOperation {Domain Class Name}
        
        relvar create SuppliedOperation {
            Name                string
            Command             string
            RequiresStateModel  boolean
        } Name
        
        relvar create SuppliedClassOperation {
            Name    string
        } Name
        
        relvar create SuppliedInstanceOperation {
            Name    string
        } Name
        
        relvar partition R14 SuppliedOperation Name\
            SuppliedClassOperation Name\
            SuppliedInstanceOperation Name
        
        relvar association R15\
            SystemClassOperation Name *\
            SuppliedClassOperation Name 1
        
        relvar association R16\
            SystemInstanceOperation Name *\
            SuppliedInstanceOperation Name 1
        relvar eval {
            relvar insert SuppliedOperation {
                Name                findAll
                Command             ::rosea::ClassCmds::findAll
                RequiresStateModel  false
            } {
                Name                findById
                Command             ::rosea::ClassCmds::findById
                RequiresStateModel  false
            } {
                Name                findWhere
                Command             ::rosea::ClassCmds::findWhere
                RequiresStateModel  false
            } {
                Name                create
                Command             ::rosea::ClassCmds::create
                RequiresStateModel  false
            } {
                Name                createin
                Command             ::rosea::ClassCmds::createin
                RequiresStateModel  true
            } {
                Name                createasync
                Command             ::rosea::ClassCmds::createasync
                RequiresStateModel  true
            } {
                Name                update
                Command             ::rosea::ClassCmds::update
                RequiresStateModel  false
            }
        
            relvar insert SuppliedClassOperation {
                Name    findAll
            } {
                Name    findById
            } {
                Name    findWhere
            } {
                Name    create
            } {
                Name    createin
            } {
                Name    createasync
            } {
                Name    update
            }
        }
        relvar eval {
            relvar insert SuppliedOperation {
                Name                findRelated
                Command             ::rosea::InstCmds::findRelated
                RequiresStateModel  false
            } {
                Name                findUnrelated
                Command             ::rosea::InstCmds::findById
                RequiresStateModel  false
            } {
                Name                findRelatedWhere
                Command             ::rosea::InstCmds::findRelatedWhere
                RequiresStateModel  false
            } {
                Name                findUnrelatedWhere
                Command             ::rosea::InstCmds::findUnrelatedWhere
                RequiresStateModel  false
            } {
                Name                updateAttribute
                Command             ::rosea::InstCmds::updateAttribute
                RequiresStateModel  false
            } {
                Name                withAttribute
                Command             ::rosea::InstCmds::withAttribute
                RequiresStateModel  false
            } {
                Name                readAttribute
                Command             ::rosea::InstCmds::readAttribute
                RequiresStateModel  false
            } {
                Name                assignAttribute
                Command             ::rosea::InstCmds::assignAttribute
                RequiresStateModel  false
            } {
                Name                delete
                Command             ::rosea::InstCmds::delete
                RequiresStateModel  false
            } {
                Name                signal
                Command             ::rosea::InstCmds::signal
                RequiresStateModel  true
            } {
                Name                delaysignal
                Command             ::rosea::InstCmds::delaysignal
                RequiresStateModel  true
            } {
                Name                canceldelayed
                Command             ::rosea::InstCmds::canceldelayed
                RequiresStateModel  true
            } {
                Name                delayremaining
                Command             ::rosea::InstCmds::delayremaining
                RequiresStateModel  true
            } {
                Name                instop
                Command             ::rosea::InstCmds::instop
                RequiresStateModel  false
            } {
                Name                deRef
                Command             ::rosea::InstCmds::deRef
                RequiresStateModel  false
            } {
                Name                isEmptyRef
                Command             ::rosea::InstCmds::isEmptyRef
                RequiresStateModel  false
            } {
                Name                isNotEmptyRef
                Command             ::rosea::InstCmds::isNotEmptyRef
                RequiresStateModel  false
            } {
                Name                refMultiplicity
                Command             ::rosea::InstCmds::refMultiplicity
                RequiresStateModel  false
            } {
                Name                isRefSingular
                Command             ::rosea::InstCmds::isRefSingular
                RequiresStateModel  false
            } {
                Name                limitRef
                Command             ::rosea::InstCmds::limitRef
                RequiresStateModel  false
            } {
                Name                isRefEqual
                Command             ::rosea::InstCmds::isRefEqual
                RequiresStateModel  false
            } {
                Name                forAllRefs
                Command             ::rosea::InstCmds::forAllRefs
                RequiresStateModel  false
            }
        
            relvar insert SuppliedInstanceOperation {
                Name    findRelated
            } {
                Name    findUnrelated
            } {
                Name    findRelatedWhere
            } {
                Name    findUnrelatedWhere
            } {
                Name    updateAttribute
            } {
                Name    withAttribute
            } {
                Name    readAttribute
            } {
                Name    assignAttribute
            } {
                Name    delete
            } {
                Name    signal
            } {
                Name    delaysignal
            } {
                Name    canceldelayed
            } {
                Name    delayremaining
            } {
                Name    instop
            } {
                Name    deRef
            } {
                Name    isEmptyRef
            } {
                Name    isNotEmptyRef
            } {
                Name    refMultiplicity
            } {
                Name    isRefSingular
            } {
                Name    limitRef
            } {
                Name    isRefEqual
            } {
                Name    forAllRefs
            }
        }
        relvar create Association {
            Domain      string
            Name        string
        } {Domain Name}
        relvar create Generalization {
            Domain      string
            Name        string
        } {Domain Name}
        relvar partition R30 Relationship {Domain Name}\
            Association {Domain Name}\
            Generalization {Domain Name}
        relvar create SimpleAssociation {
            Domain      string
            Name        string
        } {Domain Name}
        relvar create ClassBasedAssociation {
            Domain      string
            Name        string
        } {Domain Name}
        relvar partition R31 Association {Domain Name}\
            SimpleAssociation {Domain Name}\
            ClassBasedAssociation {Domain Name}
        relvar create SimpleReferringClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Conditionality  boolean
            Multiplicity    boolean
        } {Domain Class Relationship Role}
        relvar association R32\
            SimpleReferringClass {Domain Relationship} 1\
            SimpleAssociation {Domain Name} 1
        relvar create SimpleReferencedClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Conditionality  boolean
        } {Domain Class Relationship Role}
        relvar association R33\
            SimpleReferencedClass {Domain Relationship} 1\
            SimpleAssociation {Domain Name} 1
        relvar create SourceClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Conditionality  boolean
            Multiplicity    boolean
        } {Domain Class Relationship Role}
        relvar association R34\
            SourceClass {Domain Relationship} 1\
            ClassBasedAssociation {Domain Name} 1
        relvar create TargetClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Conditionality  boolean
            Multiplicity    boolean
        } {Domain Class Relationship Role}
        relvar association R35\
            TargetClass {Domain Relationship} 1\
            ClassBasedAssociation {Domain Name} 1
        relvar create AssociatorClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar association R42\
            AssociatorClass {Domain Relationship} 1\
            ClassBasedAssociation {Domain Name} 1
        relvar create Superclass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar association R36\
            Superclass {Domain Relationship} 1\
            Generalization {Domain Name} 1
        relvar create Subclass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar association R37\
            Subclass {Domain Relationship} +\
            Generalization {Domain Name} 1
        relvar create ReferringClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar partition R38 ReferringClass {Domain Class Relationship Role}\
            SimpleReferringClass {Domain Class Relationship Role}\
            AssociatorClass {Domain Class Relationship Role}\
            Subclass {Domain Class Relationship Role}
        relvar create ReferencedClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar partition R39 ReferencedClass {Domain Class Relationship Role}\
            SimpleReferencedClass {Domain Class Relationship Role}\
            SourceClass {Domain Class Relationship Role}\
            TargetClass {Domain Class Relationship Role}\
            Superclass {Domain Class Relationship Role}
        relvar create ClassRole {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar partition R40 ClassRole {Domain Class Relationship Role}\
            ReferringClass {Domain Class Relationship Role}\
            ReferencedClass {Domain Class Relationship Role}
        relvar correlation R41 ClassRole\
            {Domain Relationship} + Relationship {Domain Name}\
            {Domain Class} * Class {Domain Name}
        relvar correlation R11 ReferencedIdAttribute\
            {Domain Class Relationship Role} +\
                ReferencedClass {Domain Class Relationship Role}\
            {Domain Class Attribute Number} *\
                IdentifyingAttribute {Domain Class Attribute Number}
        relvar correlation R12 AttributeReference\
            {Domain ReferringClass Relationship ReferringRole} +\
                ReferringClass {Domain Class Relationship Role}\
            {Domain ReferencedClass Relationship ReferencedRole ReferencedAttribute\
                    ReferencedIdNumber} +\
                ReferencedIdAttribute {Domain Class Relationship Role Attribute Number}
        relvar create Config_AssocSpec {
            Spec                string
            NeedsAssociator     boolean
            ReflexiveAllowed    boolean
            ReferringCond       boolean
            ReferringMult       boolean
            ReferencedCond      boolean
            ReferencedMult      boolean
        } Spec
        
        relvar insert Config_AssocSpec {
            Spec 1--1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond false ReferringMult false
                ReferencedCond false ReferencedMult false
        } {
            Spec 0..1--1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond true ReferringMult false
                ReferencedCond false ReferencedMult false
        } {
            Spec 0..1--0..1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond true ReferringMult false
                ReferencedCond true ReferencedMult false
        } {
            Spec 1..*--1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond false ReferringMult true
                ReferencedCond false ReferencedMult false
        } {
            Spec 0..*--1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond true ReferringMult true
                ReferencedCond false ReferencedMult false
        } {
            Spec 1..*--0..1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond false ReferringMult true
                ReferencedCond true ReferencedMult false
        } {
            Spec 0..*--0..1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond true ReferringMult true
                ReferencedCond true ReferencedMult false
        } {
            Spec 1..*--1..* NeedsAssociator true ReflexiveAllowed true
                ReferringCond false ReferringMult true
                ReferencedCond false ReferencedMult true
        } {
            Spec 0..*--1..* NeedsAssociator true ReflexiveAllowed false
                ReferringCond true ReferringMult true
                ReferencedCond false ReferencedMult true
        } {
            Spec 1..*--0..* NeedsAssociator true ReflexiveAllowed false
                ReferringCond false ReferringMult true
                ReferencedCond true ReferencedMult true
        } {
            Spec 0..*--0..* NeedsAssociator true ReflexiveAllowed true
                ReferringCond true ReferringMult true
                ReferencedCond true ReferencedMult true
        } {
            Spec ?--1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond true ReferringMult false
                ReferencedCond false ReferencedMult false
        } {
            Spec ?--? NeedsAssociator false ReflexiveAllowed true
                ReferringCond true ReferringMult false
                ReferencedCond true ReferencedMult false
        } {
            Spec +--1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond false ReferringMult true
                ReferencedCond false ReferencedMult false
        } {
            Spec *--1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond true ReferringMult true
                ReferencedCond false ReferencedMult false
        } {
            Spec +--? NeedsAssociator false ReflexiveAllowed false
                ReferringCond false ReferringMult true
                ReferencedCond true ReferencedMult false
        } {
            Spec *--? NeedsAssociator false ReflexiveAllowed true
                ReferringCond true ReferringMult true
                ReferencedCond true ReferencedMult false
        } {
            Spec +--+ NeedsAssociator true ReflexiveAllowed true
                ReferringCond false ReferringMult true
                ReferencedCond false ReferencedMult true
        } {
            Spec *--+ NeedsAssociator true ReflexiveAllowed false
                ReferringCond true ReferringMult true
                ReferencedCond false ReferencedMult true
        } {
            Spec +--* NeedsAssociator true ReflexiveAllowed false
                ReferringCond false ReferringMult true
                ReferencedCond true ReferencedMult true
        } {
            Spec *--* NeedsAssociator true ReflexiveAllowed true
                ReferringCond true ReferringMult true
                ReferencedCond true ReferencedMult true
        }
        relvar create Config_ClassAssoc {
            Domain              string
            Relationship        string
            AssocClass          string
            SourceClass         string
        } {Domain Relationship AssocClass SourceClass}
        relvar create Config_NonReflexiveAssoc {
            Domain              string
            Relationship        string
            AssocClass          string
            SourceClass         string
            TargetClass         string
        } {Domain Relationship AssocClass SourceClass}
        relvar create Config_ReflexiveAssoc {
            Domain              string
            Relationship        string
            AssocClass          string
            SourceClass         string
        } {Domain Relationship AssocClass SourceClass}
        relvar create Config_ReflexivePath {
            Domain              string
            Relationship        string
            AssocClass          string
            SourceClass         string
            SourceAttr          string
            TargetAttr          string
        } {Domain Relationship AssocClass SourceClass SourceAttr}
        relvar partition Config1\
            Config_ClassAssoc\
                {Domain Relationship AssocClass SourceClass}\
            Config_NonReflexiveAssoc\
                {Domain Relationship AssocClass SourceClass}\
            Config_ReflexiveAssoc\
                {Domain Relationship AssocClass SourceClass}
        relvar association Config2\
            Config_ReflexivePath {Domain Relationship AssocClass SourceClass} +\
            Config_ReflexiveAssoc {Domain Relationship AssocClass SourceClass} 1
        pipe {
            relvar set ::rosea::Config::AttributeReference |
            relation project ~ Domain ReferencedClass Relationship ReferencedRole\
                    ReferencedAttribute ReferencedIdNumber |
            relation rename ~ ReferencedClass Class ReferencedRole Role\
                    ReferencedAttribute Attribute ReferencedIdNumber Number |
            relvar union ::rosea::Config::ReferencedIdAttribute
        } refIdQuery
        relvar create StateModel {
            Domain          string
            Model           string
            InitialState    string
            DefaultTrans    string
        } {Domain Model}
        
        relvar create InstanceStateModel {
            Domain          string
            Class           string
        } {Domain Class}
        
        relvar association R51\
            InstanceStateModel {Domain Class} ?\
            Class {Domain Name} 1
        
        relvar create AssignerStateModel {
            Domain          string
            Relationship    string
        } {Domain Relationship}
        
        relvar association R52\
            AssignerStateModel {Domain Relationship} ?\
            Association {Domain Name} 1
        
        relvar partition R50 StateModel {Domain Model}\
            InstanceStateModel {Domain Class}\
            AssignerStateModel {Domain Relationship}
        
        relvar create SingleAssigner {
            Domain          string
            Relationship    string
        } {Domain Relationship}
        
        relvar create MultipleAssigner {
            Domain          string
            Relationship    string
            Class           string
            Number          int
        } {Domain Relationship}
        
        relvar partition R53 AssignerStateModel {Domain Relationship}\
            SingleAssigner {Domain Relationship}\
            MultipleAssigner {Domain Relationship}
        
        relvar association R54\
            MultipleAssigner {Domain Class Number} ?\
            Identifier {Domain Class Number} 1
        
        relvar create State {
            Domain          string
            Model           string
            Name            string
            Parameters      string
            Action          string
            IsFinal         boolean
        } {Domain Model Name}
        
        relvar association R55\
            State {Domain Model} +\
            StateModel {Domain Model} 1
        
        relvar association R58\
            StateModel {Domain Model InitialState} ?\
            State {Domain Model Name} 1
        
        relvar create TransitionRule {
            Name    string
        } Name
        
        relvar insert TransitionRule {Name IG} {Name CH}
        
        relvar association R59\
            StateModel DefaultTrans *\
            TransitionRule Name 1
        
        relvar create CreationState {
            Domain          string
            Model           string
            Name            string
        } {Domain Model Name}
        
        relvar create StatePlace {
            Domain          string
            Model           string
            Name            string
        } {Domain Model Name}
        
        relvar partition R57 StatePlace {Domain Model Name}\
            State {Domain Model Name}\
            CreationState {Domain Model Name}
        relvar create Event {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar create DeferredEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar create EffectiveEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar partition R80 Event {Domain Model Event}\
            DeferredEvent {Domain Model Event}\
            EffectiveEvent {Domain Model Event}
        
        relvar create DeferralPath {
            Domain          string
            Model           string
            Event           string
            Relationship    string
            Role            string
        } {Domain Model Event Relationship Role}
        
        relvar correlation R86 DeferralPath\
            {Domain Model Event} + DeferredEvent {Domain Model Event}\
            {Domain Model Relationship Role} * Superclass\
                {Domain Class Relationship Role}
        
        relvar create PolymorphicEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar create InheritedEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar partition R81 DeferredEvent {Domain Model Event}\
            PolymorphicEvent {Domain Model Event}\
            InheritedEvent {Domain Model Event}
        
        relvar create MappedEvent {
            Domain      string
            Model       string
            Event       string
            ParentModel string
        } {Domain Model Event}
        
        relvar association R84\
            MappedEvent {Domain ParentModel Event} *\
            DeferredEvent {Domain Model Event} 1
        
        relvar create LocalEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar partition R82 EffectiveEvent {Domain Model Event}\
            MappedEvent {Domain Model Event}\
            LocalEvent {Domain Model Event}
        
        relvar create NonLocalEvent {
            Domain          string
            Model           string
            Event           string
            Relationship    string
            Role            string
        } {Domain Model Event}
        
        relvar partition R83 NonLocalEvent {Domain Model Event}\
            MappedEvent {Domain Model Event}\
            InheritedEvent {Domain Model Event}
        
        relvar association R85\
            NonLocalEvent {Domain Model Relationship Role} *\
            Subclass {Domain Class Relationship Role} 1
        
        relvar association R87\
            EffectiveEvent {Domain Model} +\
            StateModel {Domain Model} 1
        relvar create TransitionPlace {
            Domain  string
            Model   string
            State   string
            Event   string
        } {Domain Model State Event}
        
        relvar correlation R70 TransitionPlace\
            {Domain Model State} * StatePlace {Domain Model Name}\
            {Domain Model Event} * EffectiveEvent {Domain Model Event}
        
        relvar create StateTransition {
            Domain      string
            Model       string
            State       string
            Event       string
            NewState    string
        } {Domain Model State Event}
        
        relvar create NonStateTransition {
            Domain      string
            Model       string
            State       string
            Event       string
            TransRule   string
        } {Domain Model State Event}
        
        relvar partition R71 TransitionPlace {Domain Model State Event}\
            StateTransition {Domain Model State Event}\
            NonStateTransition {Domain Model State Event}
        
        relvar association R72\
            StateTransition {Domain Model NewState} *\
            State {Domain Model Name} 1
        
        relvar association R73\
            NonStateTransition TransRule *\
            TransitionRule Name 1
        relvar create Config_DataError {
            Relationship        string
            RefClass            string
            RefType             string
            Format              string
        } {Relationship RefClass RefType}
        relvar insert Config_DataError {
            Relationship        R3
            RefClass            Class
            RefType             notrefed
            Format              {in domain, \"$Domain\", class, \"$Name\",\
                                has no attributes}
        } {
            Relationship        R4
            RefClass            Class
            RefType             notrefed
            Format              {in domain, \"$Domain\", class, \"$Name\",\
                                has no identifiers}
        } {
            Relationship        R11
            RefClass            ReferencedClass
            RefType             notrefed
            Format              {in domain, \"$Domain\", for relationship,\
                                \"$Relationship\", no class has defined a reference\
                                to class, \"$Class\"}
        } {
            Relationship        R11
            RefClass            ReferencedIdAttribute
            RefType             refnone
            Format              {in domain, \"$Domain\", relationship,\
                                \"$Relationship\", references attribute,\
                                \"$Attribute\", in class, \"$Class\", which is\
                                not an identifying attribute, does not exist\
                                or \"$Relationship\" does not exist}
        } {
            Relationship        R12
            RefClass            AttributeReference
            RefType             refnone
            Format              {in domain, \"$Domain\", the attribute,\
                                \"$ReferringAttribute\", in class, \"$ReferringClass\",\
                                refers to, \"$ReferencedAttribute\", in class,\
                                \"$ReferencedClass\", but the class, attribute or\
                                relationship does not exist}
        } {
            Relationship        R12
            RefClass            ReferringClass
            RefType             notrefed
            Format              {in domain, \"$Domain\", in class, \"$Class\",\
                                makes a reference along relationship,\
                                \"$Relationship\", but $Class does not pariticipate\
                                in $Relationship}
        } {
            Relationship        R13
            RefClass            AttributeReference
            RefType             refnone
            Format              {in domain, \"$Domain\", the attribute,\
                                \"$ReferringAttribute\", in class, \"$ReferringClass\",\
                                does not exist, but is used as a referential attribute}
        } {
            Relationship        R41
            RefClass            ClassRole
            RefType             refnone
            Format              {in domain, \"$Domain\", relationship,\
                                \"$Relationship\", references class, \"$Class\",\
                                which does not exist}
        } {
            Relationship        R52
            RefClass            AssignerStateModel
            RefType             refnone
            Format              {in domain, \"$Domain\", an assigner state model is\
                                defined on relationship, \"$Relationship\", which is\
                                not an association type relationship}
        } {
            Relationship        R70
            RefClass            TransitionPlace
            RefType             refnone
            Format              {in domain, \"$Domain\", the state model for,\
                                \"$Model\", contains a transition for event,\
                                \"$Event\", but $Event was a polymorphic event\
                                consumed by a superclass of $Model}
        } {
            Relationship        R72
            RefClass            StateTransition
            RefType             refnone
            Format              {in domain, \"$Domain\", the state model for,\
                                \"$Model\", contains the transition,\
                                \"$State - $Event -> $NewState\",\
                                but state \"$NewState\" does not exist}
        } {
            Relationship        R81
            RefClass            DeferredEvent
            RefType             multrefed
            Format              {in domain, \"$Domain\", in the state model for,\
                                \"$Model\", event, \"$Event\", is both an inherited\
                                polymorphic event and a locally defined one}
        } {
            Relationship        R86
            RefClass            DeferredEvent
            RefType             notrefed
            Format              {in domain, \"$Domain\", in the state model for,\
                                \"$Model\", event, \"$Event\", is defined as\
                                polymorphic but \"$Model\" is not a superclass\
                                of a generalization}
        } {
            Relationship        R87
            RefClass            EffectiveEvent
            RefType             refnone
            Format              {in domain, \"$Domain\", event, \"$Event\" has been\
                                inherited, but no state model exists for, \"$Model\"}
        }
        namespace export ConfigEvaluate
        
        proc ConfigEvaluate {ns body} {
            variable evalLambda
            tailcall ::apply [concat $evalLambda [list $ns]] $body ; # <1>
        }
        proc domain {name body} {
            namespace upvar DomainDef DomainName DomainName ; # <1>
            set DomainName $name
        
            relvar insert ::rosea::Config::Domain [list Name $name Location {}]
            try {
                if {$name eq {}} {
                    tailcall DeclError EMPTY_NAME domain
                }
        
                relvar eval { # <2>
                    ConfigEvaluate [namespace current]::DomainDef $body
        
                    # At this point we have the definition of the domain and enough
                    # information to tie together the referential attributes and
                    # the association definitions.
                    variable Config_NonReflexiveAssoc
                    
                    relation foreach nra $Config_NonReflexiveAssoc {
                        relation assign $nra
                        relvar update ::rosea::Config::AttributeReference ar {
                            [tuple extract $ar Domain] eq $Domain &&
                            [tuple extract $ar Relationship] eq $Relationship &&
                            [tuple extract $ar ReferringClass] eq $AssocClass
                        } {tuple update $ar ReferringRole associator}
                    
                        relvar update ::rosea::Config::AttributeReference ar {
                            [tuple extract $ar Domain] eq $Domain &&
                            [tuple extract $ar Relationship] eq $Relationship &&
                            [tuple extract $ar ReferringClass] eq $AssocClass &&
                            [tuple extract $ar ReferencedClass] eq $SourceClass
                        } {tuple update $ar ReferencedRole source}
                    }
                    variable Config_ReflexivePath
                    
                    relation foreach rp $Config_ReflexivePath {
                        relation assign $rp
                        relvar update ::rosea::Config::AttributeReference ar {
                            [tuple extract $ar Domain] eq $Domain &&
                            [tuple extract $ar Relationship] eq $Relationship &&
                            [tuple extract $ar ReferringClass] eq $AssocClass
                        } {tuple update $ar ReferringRole associator}
                    
                        relvar update ::rosea::Config::AttributeReference ar {
                            [tuple extract $ar Domain] eq $Domain &&
                            [tuple extract $ar Relationship] eq $Relationship &&
                            [tuple extract $ar ReferringClass] eq $AssocClass &&
                            [tuple extract $ar ReferringAttribute] eq $SourceAttr
                        } {tuple update $ar ReferencedRole source}
                    }
                    variable refIdQuery
                    
                    eval $refIdQuery
        
                    # We must also compute how polymorphic events are inherited
                    # down generalization hierarchies.
                    # Create Deferral Path instances
                    
                    variable PolymorphicEvent
                    variable DeferredEvent
                    variable Superclass
                    variable Subclass
                    variable DeferralPath
                    
                    set dpaths [pipe {
                        relation restrictwith $PolymorphicEvent {$Domain eq $name} |
                        relation semijoin ~ $DeferredEvent |
                        relation join ~ $Superclass -using {Domain Domain Model Class}
                    }]
                    relvar insert ::rosea::Config::DeferralPath {*}[relation body $dpaths]
                    set supers [relation semiminus $Subclass $Superclass\
                        -using {Domain Domain Class Class}]
                    
                    relation foreach super $supers {
                        PropagatePolyEvents $super
                    }
                }
            } on error {result} {
                # puts $::errorInfo
                ::rosea::Config::HandleConfigError $result
            }
        }
        proc HandleConfigError {result} {
            set lines [split [string trimright $result] \n]
            set nlines [llength $lines]
            set lineno 0
            upvar #0 ::rosea::Config::errcount errcount
            while {$lineno < $nlines} {
                set line [lindex $lines $lineno]
                incr lineno
                if {[regexp {^for[^:]+([^(]+)\(.+\), in relvar (.+)$} $line\
                        match rnum refclass]} {
                    set rnum [namespace tail $rnum]
                    set refclass [namespace tail $refclass]
                
                    # Now iterate over the "tuple" lines that follow the constraint message.
                    while {$lineno < $nlines} {
                        set tupline [lindex $lines $lineno]
                        if {[regexp {^tuple {(.+)} (.+)$} $tupline match tuple phrase]} {
                            incr lineno
                            incr errcount
                            if {[string match {is not referenced*} $phrase]} {
                                set reftype notrefed
                            } elseif {[string match {references no*} $phrase]} {
                                set reftype refnone
                            } elseif {[string match {*to by multiple*} $phrase]} {
                                set reftype multrefed
                            } elseif {[string match {is not referred to*} $phrase]} {
                                set reftype notrefto
                            } else {
                                log::error "unknown constraint phrasing, \"$phrase\""
                                continue
                            }
                            set cde [relvar restrictone Config_DataError Relationship $rnum RefClass\
                                    $refclass RefType $reftype]
                            if {[relation isnotempty $cde]} {
                                dict with tuple {
                                    log::error [subst -nocommands [relation extract $cde Format]]
                                }
                            } else {
                                log::error "$line\n$tupline"
                            }
                        } else {
                            break
                        }
                    }
                } else {
                    log::error "unknown configuration error, \"$result\""
                }
            }
        
            return
        }
        namespace eval DomainDef {
            logger::initNamespace [namespace current]
        
            namespace import\
                ::ral::relation\
                ::ral::tuple\
                ::ral::relformat\
                ::ralutil::pipe
            namespace import ::ral::relvar
            namespace import ::rosea::Config::ConfigEvaluate
            namespace import ::rosea::Helpers::DeclError
            proc class {name body} {
                namespace upvar [namespace current] DomainName DomainName ; # <1>
                namespace upvar ClassDef ClassName ClassName
                set ClassName $name
            
                if {![regexp {\A[[:alnum:]].*} $name]} {
                    tailcall DeclError BAD_CLASS_NAME $name
                }
                try {
                    relvar insert ::rosea::Config::DomainElement [list\
                        Domain  $DomainName\
                        Element $name\
                    ]
                } trap {RAL relvar insert DUPLICATE_TUPLE} {} {
                    tailcall DeclError DUP_ELEMENT_NAME $name
                } ; # <2>
                relvar insert ::rosea::Config::Class [list\
                    Domain  $DomainName\
                    Name    $name\
                ]
                set instops [pipe {
                    relvar set ::rosea::Config::SuppliedInstanceOperation |
                    relation extend ~ ioptuple\
                        Domain string {[set DomainName]}\
                        Class string {[set ClassName]}
                }]
                relvar union ::rosea::Config::SystemInstanceOperation $instops
                relvar union ::rosea::Config::InstanceOperation $instops
                relvar union ::rosea::Config::Operation $instops
                set classops [pipe {
                    relvar set ::rosea::Config::SuppliedClassOperation |
                    relation extend ~ coptuple\
                        Domain string {[set DomainName]}\
                        Class string {[set ClassName]}
                }]
                relvar union ::rosea::Config::SystemClassOperation $classops
                relvar union ::rosea::Config::ClassOperation $classops
                relvar union ::rosea::Config::Operation $classops
            
                ConfigEvaluate [namespace current]::ClassDef $body
            }
            proc association {name source spec target args} {
                if {[llength $args] % 2 != 0} {
                    tailcall DeclError ARG_FORMAT $args
                }
                if {$name eq {}} {
                    tailcall DeclError EMPTY_NAME association
                }
                if {[string index $name 0] eq "~"} {
                    tailcall DeclError TILDE_NAME $name
                }
            
                # Obtain references to the domain and class context.
                namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
            
                set associator {}
                set path {}
                
                foreach {option value} $args {
                    switch -exact -- $option {
                        -associator {
                            set associator $value
                        }
                        -path {
                            set path $value
                            if {[llength $path] % 2 != 0} {
                                tailcall DeclError ARG_FORMAT $path
                            }
                        }
                        default {
                            tailcall DeclError UNKNOWN_OPTION association $option
                        }
                    }
                }
                set cas [relvar restrictone ::rosea::Config::Config_AssocSpec Spec $spec]
                if {[relation isempty $cas]} {
                    tailcall DeclError BAD_RELATIONSHIP_SPEC $spec
                }
                set needsassoc [relation extract $cas NeedsAssociator]
                if {$needsassoc && $associator eq {}} {
                    tailcall DeclError NEED_ASSOCIATOR $spec
                }
                if {$source eq $target} {
                    if {![relation extract $cas ReflexiveAllowed]} {
                        tailcall DeclError REFLEXIVE_NOT_ALLOWED $spec
                    }
                    if {$needsassoc && $path eq {}} {
                        tailcall DeclError NEED_REFLEXIVE_PATH $name $source $spec $target
                    }
                }
            
                try {
                    relvar insert ::rosea::Config::DomainElement [list\
                        Domain  $DomainName\
                        Element $name\
                    ]
                } trap {RAL relvar insert DUPLICATE_TUPLE} {result opts} {
                    tailcall DeclError DUP_ELEMENT_NAME $name
                }
            
                # Many relvars have tuples with the same heading, so we construct it
                # once here.
                set reltuple [list\
                    Domain  $DomainName\
                    Name $name\
                ]
            
                # Populate the data for a Relationship and Association since that
                # is what this command defines.
                relvar insert ::rosea::Config::Relationship $reltuple
                relvar insert ::rosea::Config::Association $reltuple
            
                # Populate the type of association we are dealing with.
                if {$associator eq {}} {
                    relvar insert ::rosea::Config::SimpleAssociation $reltuple
                    relvar insert ::rosea::Config::SimpleReferringClass [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                        Conditionality  [relation extract $cas ReferringCond]\
                        Multiplicity    [relation extract $cas ReferringMult]\
                    ]
                    relvar insert ::rosea::Config::ReferringClass [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                    ]
                    relvar insert ::rosea::Config::SimpleReferencedClass [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                        Conditionality  [relation extract $cas ReferencedCond]\
                    ]
                    relvar insert ::rosea::Config::ReferencedClass [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                    ]
                } else {
                    relvar insert ::rosea::Config::Config_ClassAssoc [list\
                        Domain              $DomainName\
                        Relationship        $name\
                        AssocClass          $associator\
                        SourceClass         $source\
                    ]
                    if {[llength $path] == 0} {
                        relvar insert ::rosea::Config::Config_NonReflexiveAssoc [list\
                            Domain              $DomainName\
                            Relationship        $name\
                            AssocClass          $associator\
                            SourceClass         $source\
                            TargetClass         $target\
                        ]
                    } else {
                        relvar insert ::rosea::Config::Config_ReflexiveAssoc [list\
                            Domain              $DomainName\
                            Relationship        $name\
                            AssocClass          $associator\
                            SourceClass         $source\
                        ]
                        foreach {sourceattr targetattr} $path {
                            relvar insert ::rosea::Config::Config_ReflexivePath [list\
                                Domain              $DomainName\
                                Relationship        $name\
                                AssocClass          $associator\
                                SourceClass         $source\
                                SourceAttr          $sourceattr\
                                TargetAttr          $targetattr\
                            ]
                        }
                    }
                    
                    relvar insert ::rosea::Config::ClassBasedAssociation $reltuple
                    relvar insert ::rosea::Config::SourceClass [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                        Conditionality  [relation extract $cas ReferringCond]\
                        Multiplicity    [relation extract $cas ReferringMult]\
                    ]
                    relvar insert ::rosea::Config::ReferencedClass [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                    ]
                    relvar insert ::rosea::Config::TargetClass [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                        Conditionality  [relation extract $cas ReferencedCond]\
                        Multiplicity    [relation extract $cas ReferencedMult]\
                    ]
                    relvar insert ::rosea::Config::ReferencedClass [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                    ]
                    relvar insert ::rosea::Config::AssociatorClass [list\
                        Domain          $DomainName\
                        Class           $associator\
                        Relationship    $name\
                        Role            associator\
                    ]
                    relvar insert ::rosea::Config::ReferringClass [list\
                        Domain          $DomainName\
                        Class           $associator\
                        Relationship    $name\
                        Role            associator\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $associator\
                        Relationship    $name\
                        Role            associator\
                    ]
                }
            }
            proc generalization {name super args} {
                if {[llength $args] < 2} {
                    tailcall DeclError TOO_FEW_SUBCLASSES [llength $args]
                }
                if {$name eq {}} {
                    tailcall DeclError EMPTY_NAME generalization
                }
                if {[string index $name 0] eq "~"} {
                    tailcall DeclError TILDE_NAME $name
                }
            
                namespace upvar ::rosea::Config::DomainDef DomainName DomainName
            
                try {
                    relvar insert ::rosea::Config::DomainElement [list\
                        Domain  $DomainName\
                        Element $name\
                    ]
                } trap {RAL relvar insert DUPLICATE_TUPLE} {result opts} {
                    tailcall DeclError DUP_ELEMENT_NAME $name
                }
            
                set reltuple [list\
                    Domain  $DomainName\
                    Name $name\
                ]
                relvar insert ::rosea::Config::Relationship $reltuple
                relvar insert ::rosea::Config::Generalization $reltuple
            
                set supertuple [list\
                    Domain          $DomainName\
                    Class           $super\
                    Relationship    $name\
                    Role            target\
                ]
                relvar insert ::rosea::Config::Superclass $supertuple
                relvar insert ::rosea::Config::ReferencedClass $supertuple
                relvar insert ::rosea::Config::ClassRole $supertuple
            
                set subtuple [dict create\
                    Domain          $DomainName\
                    Relationship    $name\
                    Role            source\
                ]
                foreach sub $args {
                    dict set subtuple Class $sub
                    relvar insert ::rosea::Config::Subclass $subtuple
                    relvar insert ::rosea::Config::ReferringClass $subtuple
                    relvar insert ::rosea::Config::ClassRole $subtuple
                }
            }
            proc assigner {rname body} {
                namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                namespace upvar AssignerDef\
                    RelationshipName RelationshipName\
                    multiClass multiClass\
                    multiIdNum multiIdNum\
                    InitialState InitialState\
                    DefaultTrans DefaultTrans
            
                set RelationshipName $rname
                set multiClass {}
                set multiIdNum 1
                set InitialState {}
                set DefaultTrans {}
            
                try {
                    ConfigEvaluate [namespace current]::AssignerDef $body
            
                    if {$DefaultTrans eq {}} {
                        set DefaultTrans CH
                    }
                    relvar insert ::rosea::Config::StateModel [list\
                        Domain          $DomainName\
                        Model           $rname\
                        InitialState    $InitialState\
                        DefaultTrans    $DefaultTrans\
                    ]
                    set assigntuple [list\
                        Domain          $DomainName\
                        Relationship    $rname\
                    ]
                    relvar insert ::rosea::Config::AssignerStateModel $assigntuple
                    if {$multiClass eq {}} {
                        relvar insert ::rosea::Config::SingleAssigner $assigntuple
                    } else {
                        lappend assigntuple Class $multiClass Number $multiIdNum
                        relvar insert ::rosea::Config::MultipleAssigner $assigntuple
                    }
                } on error {result opts} {
                    log::error $result
                    upvar #0 ::rosea::Config::errcount errcount
                    incr errcount
                }
            }
            proc operation {name params body} {
                if {$name eq {}} {
                    tailcall DeclError EMPTY_NAME operation
                }
                namespace upvar ::rosea::Config::DomainDef DomainName DomainName
            
                try {
                    relvar insert ::rosea::Config::DomainElement [list\
                        Domain      $DomainName\
                        Element     $name\
                    ]
                } trap {RAL relvar insert DUPLICATE_TUPLE} {result opts} {
                    tailcall DeclError DUP_ELEMENT_NAME $name
                }
                relvar insert ::rosea::Config::DomainOperation [list\
                    Domain      $DomainName\
                    Name        $name\
                    Parameters  $params\
                    Body        $body\
                ]
            }
        
            namespace eval ClassDef {
                logger::initNamespace [namespace current]
            
                namespace import\
                    ::ral::relation\
                    ::ral::tuple\
                    ::ral::relformat\
                    ::ralutil::pipe
                namespace import ::ral::relvar
                namespace import ::rosea::Config::ConfigEvaluate
                namespace import ::rosea::Helpers::DeclError
            
                proc attribute {name type args} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME attribute
                    }
                    if {[string range $name 0 1] eq "__"} {
                        tailcall DeclError RESERVED_NAME $name
                    }
                    if {[llength $args] % 2 != 0} {
                        tailcall DeclError ARG_FORMAT $args
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    relvar insert ::rosea::Config::Attribute [list\
                        Domain  $DomainName\
                        Class   $ClassName\
                        Name    $name\
                        Type    $type\
                    ]
                
                    foreach {option value} $args {
                        switch -exact -- $option {
                            -default {
                                relvar insert ::rosea::Config::DefaultValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                ]
                                relvar insert ::rosea::Config::UserSuppliedValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    Value       $value\
                                ]
                            }
                            -system {
                                if {$type ne "int"} {
                                    tailcall DeclError INT_TYPE_REQUIRED $type
                                }
                                if {![string is integer -strict $value]} {
                                    tailcall DeclError INT_VALUE_REQUIRED $value
                                }
                                relvar insert ::rosea::Config::DefaultValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                ]
                                relvar insert ::rosea::Config::SystemSuppliedValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    StartValue  $value\
                                ]
                            }
                            -generate {
                                relvar insert ::rosea::Config::DefaultValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                ]
                                relvar insert ::rosea::Config::GeneratedValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    Cmd         $value\
                                ]
                            }
                            -id {
                                relvar uinsert ::rosea::Config::Identifier [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Number      $value\
                                ] ; # <1>
                                relvar insert ::rosea::Config::IdentifyingAttribute [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    Number      $value\
                                ]
                            }
                            -check {
                                relvar insert ::rosea::Config::ValueCheck [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    Expression  $value\
                                ]
                            }
                            default {
                                tailcall DeclError UNKNOWN_OPTION attribute $option
                            }
                        }
                    }
                }
                proc reference {relname rclass args} {
                    if {[llength $args] % 2 != 0} {
                        tailcall DeclError ARG_FORMAT $args
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    set refnum 1
                    set linkopts [list]
                
                    foreach {option value} $args {
                        switch -exact -- $option {
                            -refid {
                                set refnum $value
                            }
                            -link {
                                if {[llength $value] < 1 || [llength $value] > 2} {
                                    tailcall DeclError ARG_FORMAT $value
                                }
                                lappend linkopts $value
                            }
                            default {
                                tailcall DeclError UNKNOWN_OPTION reference $option
                            }
                        }
                    }
                
                    # We defer processing the link options until the end so as not
                    # to impose an order on the -refid option.
                    foreach linkopt $linkopts {
                        lassign $linkopt referring referenced
                        if {$referenced eq {}} {
                            set referenced $referring
                        }
                        relvar insert ::rosea::Config::AttributeReference [list\
                            Domain              $DomainName\
                            ReferringClass      $ClassName\
                            ReferringAttribute  $referring\
                            ReferringRole       source\
                            ReferencedClass     $rclass\
                            ReferencedAttribute $referenced\
                            ReferencedRole      target\
                            ReferencedIdNumber  $refnum\
                            Relationship        $relname
                        ] ; # <1>
                    }
                }
                proc classop {name params body} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME "class operation"
                    } elseif {[string first :: $name] != -1} {
                        tailcall DeclError NS_QUALIFIERS $name
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    set sysop [relvar restrictone ::rosea::Config::Operation\
                        Domain $DomainName Class $ClassName Name $name]
                    if {[relation isnotempty $sysop]} {
                        tailcall DeclError DUP_OP_NAME $name
                    }
                
                    set optuple [list Domain $DomainName Class $ClassName Name $name]
                    relvar insert ::rosea::Config::Operation $optuple
                    relvar insert ::rosea::Config::ClassOperation $optuple
                
                    lappend optuple Parameters $params Body $body
                    relvar insert ::rosea::Config::UserClassOperation $optuple
                }
                proc instop {name params body} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME "instance operation"
                    } elseif {[string first :: $name] != -1} {
                        tailcall DeclError NS_QUALIFIERS $name
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    set sysop [relvar restrictone ::rosea::Config::Operation\
                        Domain $DomainName Class $ClassName Name $name]
                    if {[relation isnotempty $sysop]} {
                        tailcall DeclError DUP_OP_NAME $name
                    }
                
                    set optuple [list Domain $DomainName Class $ClassName Name $name]
                    relvar insert ::rosea::Config::Operation $optuple
                    relvar insert ::rosea::Config::InstanceOperation $optuple
                
                    lappend optuple Parameters $params Body $body
                    relvar insert ::rosea::Config::UserInstanceOperation $optuple
                }
                proc statemodel {body} {
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    variable ClassName
                
                    namespace upvar StateModelDef\
                        InitialState InitialState\
                        DefaultTrans DefaultTrans\
                        Terminals Terminals
                
                    set InitialState {}
                    set DefaultTrans {}
                    set Terminals [list]
                
                    try {
                        ConfigEvaluate [namespace current]::StateModelDef $body
                
                        if {$DefaultTrans eq {}} {
                            set DefaultTrans CH
                        }
                        relvar insert ::rosea::Config::StateModel [list\
                            Domain          $DomainName\
                            Model           $ClassName\
                            InitialState    $InitialState\
                            DefaultTrans    $DefaultTrans\
                        ]
                        relvar insert ::rosea::Config::InstanceStateModel [list\
                            Domain          $DomainName\
                            Class           $ClassName\
                        ]
                
                        foreach terminal $Terminals {
                            relvar updateone ::rosea::Config::State stup [list\
                                    Domain $DomainName Model $ClassName Name $terminal] {
                                tuple update $stup IsFinal true
                            }
                        }
                    } on error {result opts} {
                        log::error $result
                        upvar #0 ::rosea::Config::errcount errcount
                        incr errcount
                    }
                }
                proc polymorphic {args} {
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    foreach polyevent $args {
                        set eventtuple [list\
                            Domain $DomainName\
                            Model $ClassName\
                            Event $polyevent\
                        ]
                        relvar insert ::rosea::Config::PolymorphicEvent $eventtuple
                        relvar insert ::rosea::Config::DeferredEvent $eventtuple
                        relvar insert ::rosea::Config::Event $eventtuple
                    }
                    return
                }
            
                namespace eval StateModelDef {
                    logger::initNamespace [namespace current]
                
                    namespace import\
                        ::ral::relation\
                        ::ral::tuple\
                        ::ral::relformat\
                        ::ralutil::pipe
                    namespace import ::ral::relvar
                    namespace import ::rosea::Config::ConfigEvaluate
                    namespace import ::rosea::Helpers::DeclError
                
                    proc state {name params body} {
                        if {$name eq {}} {
                            tailcall DeclError EMPTY_NAME state
                        }
                        if {$name in {@ CH IG}} {
                            tailcall DeclError PSEUDO_STATE $name state
                        }
                    
                        namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                        namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                    
                        variable InitialState
                    
                        if {$InitialState eq {}} {
                            set InitialState $name
                        }
                    
                        relvar insert ::rosea::Config::State [list\
                            Domain          $DomainName\
                            Model           $ClassName\
                            Name            $name\
                            Parameters      $params\
                            Action          $body\
                            IsFinal         false\
                        ]
                        relvar insert ::rosea::Config::StatePlace [list\
                            Domain          $DomainName\
                            Model           $ClassName\
                            Name            $name\
                        ]
                        return
                    }
                    proc transition {source - event -> target} {
                        if {$event eq {}} {
                            tailcall DeclError EMPTY_NAME event
                        }
                        if {$source in {CH IG}} {
                            tailcall DeclError PSEUDO_STATE $source "transition source state"
                        }
                        namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                        namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                    
                        if {$source eq "@"} {
                            if {$target in {CH IG}} {
                                tailcall DeclError BAD_CREATION_TARGET $target
                            }
                            set cstuple [list\
                                Domain          $DomainName\
                                Model           $ClassName\
                                Name            @\
                            ]
                            relvar uinsert ::rosea::Config::CreationState $cstuple
                            relvar uinsert ::rosea::Config::StatePlace $cstuple
                        }
                    
                        set eventtuple [list\
                            Domain  $DomainName\
                            Model   $ClassName\
                            Event   $event\
                        ]
                        relvar uinsert ::rosea::Config::Event $eventtuple ; # <1>
                        relvar uinsert ::rosea::Config::EffectiveEvent $eventtuple
                        relvar uinsert ::rosea::Config::LocalEvent $eventtuple
                    
                        set tranrule [relvar restrictone ::rosea::Config::TransitionRule\
                            Name $target]
                        set transtuple [list\
                            Domain  $DomainName\
                            Model   $ClassName\
                            State   $source\
                            Event   $event\
                        ]
                        relvar insert ::rosea::Config::TransitionPlace $transtuple
                    
                        if {[relation isnotempty $tranrule]} {
                            lappend transtuple TransRule $target
                            set tpsubtype NonStateTransition
                        } else {
                            lappend transtuple NewState $target
                            set tpsubtype StateTransition
                        }
                        relvar insert ::rosea::Config::$tpsubtype $transtuple
                        return
                    }
                    proc initialstate {name} {
                        if {$name eq {}} {
                            tailcall DeclError EMPTY_NAME initialstate
                        }
                        if {$name in {@ CH IG}} {
                            tailcall DeclError PSEUDO_STATE $name initialstate
                        }
                        variable InitialState $name
                        return
                    }
                    proc defaulttrans {name} {
                        if {$name ni {CH IG}} {
                            tailcall DeclError EXPECTED_PSEUDO_STATE $name
                        }
                        variable DefaultTrans $name
                        return
                    }
                    proc terminal {args} {
                        variable Terminals
                        ::struct::set add Terminals $args
                        return
                    }
                }
            }
            namespace eval AssignerDef {
                logger::initNamespace [namespace current]
            
                namespace import\
                    ::ral::relation\
                    ::ral::tuple\
                    ::ral::relformat\
                    ::ralutil::pipe
                namespace import ::ral::relvar
                namespace import ::rosea::Config::ConfigEvaluate
                namespace import ::rosea::Helpers::DeclError
            
                proc state {name params body} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME state
                    }
                    if {$name in {CH IG}} {
                        tailcall DeclError PSEUDO_STATE $name state
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::AssignerDef\
                        RelationshipName RelationshipName
                
                    variable InitialState
                
                    if {$InitialState eq {}} {
                        set InitialState $name
                    }
                
                    relvar insert ::rosea::Config::State [list\
                        Domain          $DomainName\
                        Model           $RelationshipName\
                        Name            $name\
                        Parameters      $params\
                        Action          $body\
                        IsFinal         false\
                    ]
                    relvar insert ::rosea::Config::StatePlace [list\
                        Domain          $DomainName\
                        Model           $RelationshipName\
                        Name            $name\
                    ]
                    return
                }
                proc transition {source - event -> target} {
                    if {$event eq {}} {
                        tailcall DeclError EMPTY_NAME event
                    }
                    if {$source in {CH IG}} {
                        tailcall DeclError PSEUDO_STATE $name "transition source state"
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::AssignerDef\
                        RelationshipName RelationshipName
                
                    set eventtuple [list\
                        Domain  $DomainName\
                        Model   $RelationshipName\
                        Event   $event\
                    ]
                    relvar uinsert ::rosea::Config::Event $eventtuple
                    relvar uinsert ::rosea::Config::EffectiveEvent $eventtuple
                    relvar uinsert ::rosea::Config::LocalEvent $eventtuple
                
                    set tranrule [relvar restrictone ::rosea::Config::TransitionRule\
                        Name $target]
                    set transtuple [list\
                        Domain  $DomainName\
                        Model   $RelationshipName\
                        State   $source\
                        Event   $event\
                    ]
                    relvar insert ::rosea::Config::TransitionPlace $transtuple
                
                    if {[relation isnotempty $tranrule]} {
                        lappend transtuple TransRule $target
                        set tpsubtype NonStateTransition
                    } else {
                        lappend transtuple NewState $target
                        set tpsubtype StateTransition
                    }
                    relvar insert ::rosea::Config::$tpsubtype $transtuple
                    return
                }
                proc initialstate {name} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME initialstate
                    }
                    if {$name in {CH IG}} {
                        tailcall DeclError PSEUDO_STATE $name initialstate
                    }
                    variable InitialState $name
                    return
                }
                proc defaulttrans {name} {
                    if {$name ni {CH IG}} {
                        tailcall DeclError EXPECTED_PSEUDO_STATE $name
                    }
                    variable DefaultTrans $name
                    return
                }
                proc identifyby {name args} {
                    if {[llength $args] % 2 != 0} {
                        tailcall DeclError ARG_FORMAT $args
                    }
                
                    variable multiClass $name
                
                    foreach {option value} $args {
                        switch -exact -- $option {
                            -id {
                                variable multiIdNum $value
                            }
                            default {
                                tailcall DeclError UNKNOWN_OPTION identifyby $option
                            }
                        }
                    }
                
                    return
                }
            }
        }
    }
    namespace eval Populate {
        logger::initNamespace [namespace current]
    
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace import ::rosea::Config::ConfigEvaluate
        namespace import ::rosea::Helpers::DeclError
        proc domain {name body} {
            set domain [relvar restrictone ::rosea::Config::Domain Name $name]
            if {[relation isempty $domain]} {
                tailcall DeclError UNKNOWN_DOMAIN $domain
            }
        
            namespace upvar DomainPop DomainName DomainName DomainLoc DomainLoc
            relation assign $domain {Name DomainName} {Location DomainLoc}
        
            try {
                relvar eval {
                    ConfigEvaluate [namespace current]::DomainPop $body
                }
            } on error {result opts} {
                log::error $result
                upvar #0 ::rosea::Config::errcount errcount
                incr errcount
            }
        }
        namespace eval DomainPop {
            logger::initNamespace [namespace current]
        
            namespace import\
                ::ral::relation\
                ::ral::tuple\
                ::ral::relformat\
                ::ralutil::pipe
            namespace import ::ral::relvar
            namespace path ::rosea::Helpers
            proc class {class heading args} {
                # Determine if we have one big list or a bunch of values.
                set popvalues [expr {[llength $args] == 1 ? [lindex $args 0] : $args}]
                set headlen [llength $heading]
                if {[llength $popvalues] % $headlen != 0} {
                    tailcall DeclError ARG_MISMATCH $headlen [llength $popvalues]
                }
            
                # Iterate over the attribute values taking them in chunks that are the same
                # size as the heading.
                set body [list]
                for {set vindex 0} {$vindex < [llength $popvalues]} {incr vindex $headlen} {
                    set values [lrange $popvalues $vindex [expr {$vindex + $headlen - 1}]]
                    # Create a tuple as a list of attribute name / value pairs.
                    set tuple [list]
                    foreach attr $heading value $values {
                        # Check if we are skipping a value to use a default.  We must also
                        # allow some way to specify the value as "-".
                        if {$value eq "-"} {
                            continue
                        } elseif {$value eq "\\-"} {
                            set value -
                        }
                        lappend tuple $attr $value
                    }
                    # Accumulate the tuples as a list to form the body that will be
                    # inserted into the relvar.
                    lappend body $tuple
                }
            
                # Insert the body into the relvar.
                namespace upvar [namespace current]\
                    DomainName DomainName\
                    DomainLoc DomainLoc
                set domns ${DomainLoc}::${DomainName}
                set relvar ${domns}::$class
                set insts [relvar insert $relvar {*}$body]
            
                # Now we have to deal with any state model that might be present.  We have
                # to set up the initial state properly if such a thing exists for this
                # class.
                set idattrs [lindex [relvar identifiers $relvar] 0]
                relation foreach inst $insts {
                    CreateInInitialState $domns $class [pipe {
                        relation project $inst {*}$idattrs |
                        relation tuple ~ |
                        tuple get ~
                    }]
                }
            
                return [relation body $insts]
            }
            proc assigner {rname heading args} {
                # Determine if we have one big list or a bunch of values.
                set popvalues [expr {[llength $args] == 1 ? [lindex $args 0] : $args}]
                set headlen [llength $heading]
                if {[llength $popvalues] % $headlen != 0} {
                    tailcall DeclError ARG_MISMATCH $headlen [llength $popvalues]
                }
            
                namespace upvar [namespace current]\
                    DomainName DomainName\
                    DomainLoc DomainLoc
                set domns ${DomainLoc}::${DomainName}
                set relvar ${domns}::${rname}__STATEINST
                set idattrs [lindex [relvar identifiers $relvar] 0]
                if {![struct::set equal $heading $idattrs]} {
                    tailcall DeclError NO_IDENTIFIER $heading $idattrs
                }
            
                # Iterate over the attribute values taking them in chunks that are the same
                # size as the heading.
                for {set vindex 0} {$vindex < [llength $popvalues]} {incr vindex $headlen} {
                    set values [lrange $popvalues $vindex [expr {$vindex + $headlen - 1}]]
                    # Create a tuple as a list of attribute name / value pairs.  We assume
                    # the values are in the same order as the heading -- that is the point.
                    set tuple [list]
                    foreach attr $heading value $values {
                        lappend tuple $attr $value
                    }
                    CreateInInitialState $domns $rname $tuple
                }
            
                return
            }
        }
    }
    namespace eval Info {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace import ::rosea::Helpers::DeclError
        proc domain {arglist} {
            set arglist [lassign $arglist subcmd domainname]
            set dominst [relvar restrictone ::rosea::Config::Domain Name $domainname]
            if {[relation isempty $dominst]} {
                tailcall DeclError UNKNOWN_DOMAIN $domainname
            }
        
            switch -exact -- $subcmd {
                classes {
                    return [pipe {
                        relvar set ::rosea::Config::Class |
                        relation semijoin $dominst ~ -using {Name Domain} |
                        relation list ~ Name
                    }]
                }
                relationships {
                    return [pipe {
                        relvar set ::rosea::Config::Relationship |
                        relation semijoin $dominst ~ -using {Name Domain} |
                        relation list ~ Name
                    }]
                }
                operations {
                    return [FormatOpsInfo [pipe {
                        relvar set ::rosea::Config::DomainOperation |
                        relation semijoin $dominst ~ -using {Name Domain} |
                        relation project ~ Name Parameters Body
                    }]]
                }
                default {
                    tailcall DeclError UNKNOWN_INFO_CMD $subcmd
                }
            }
        }
        proc FormatOpsInfo {ops} {
            set result [list]
            relation foreach op $ops {
                relation assign $op
                lappend result $Name $Parameters $Body
            }
            return $result
        }
        proc class {arglist} {
            set arglist [lassign $arglist subcmd domainname classname]
            set dominst [relvar restrictone ::rosea::Config::Domain Name $domainname]
            if {[relation isempty $dominst]} {
                tailcall DeclError UNKNOWN_DOMAIN $domainname
            }
        
            set classinst [pipe {
                relvar set ::rosea::Config::Class |
                relation semijoin $dominst ~ -using {Name Domain} |
                relation restrictwith ~ {$Name eq $classname}
            }]
            if {[relation isempty $classinst]} {
                tailcall DeclError UNKNOWN_CLASS $classname $domainname
            }
        
            switch -exact -- $subcmd {
                attributes {
                    return [pipe {
                        relvar set ::rosea::Config::Attribute |
                        relation semijoin $classinst ~ -using {Domain Domain Name Class} |
                        relation dict ~ Name Type
                    }]
                }
                classops {
                    return [FormatOpsInfo [pipe {
                        relvar set ::rosea::Config::UserClassOperation |
                        relation semijoin $classinst ~ -using {Domain Domain Name Class} |
                        relation project ~ Name Parameters Body
                    }]]
                }
                instops {
                    return [FormatOpsInfo [pipe {
                        relvar set ::rosea::Config::UserInstanceOperation |
                        relation semijoin $classinst ~ -using {Domain Domain Name Class} |
                        relation project ~ Name Parameters Body
                    }]]
                }
                default {
                    tailcall DeclError UNKNOWN_INFO_CMD $subcmd
                }
            }
        }
        proc statemodel {arglist} {
            set arglist [lassign $arglist subcmd domainname classname statename]
            set dominst [relvar restrictone ::rosea::Config::Domain Name $domainname]
            if {[relation isempty $dominst]} {
                tailcall DeclError UNKNOWN_DOMAIN $domainname
            }
            set domns [string cat [relation extract $dominst Location] :: $domainname]
        
            set classinst [pipe {
                relvar set ::rosea::Config::Class |
                relation semijoin $dominst ~ -using {Name Domain} |
                relation restrictwith ~ {$Name eq $classname}
            }]
            if {[relation isempty $classinst]} {
                tailcall DeclError UNKNOWN_CLASS $classname $domainname
            }
        
            switch -exact -- $subcmd {
                states {
                    set states [pipe {
                        relvar set ::rosea::Config::State |
                        relation restrictwith ~\
                            {$Domain eq $domainname && $Model eq $classname} |
                        relation project ~ Name Parameters Action
                    }]
                    set result [list]
                    relation foreach state $states {
                        relation assign $state
                        lappend result $Name $Parameters $Action
                    }
                    return $result
                }
                events {
                    return [pipe {
                        relvar set ::rosea::Config::EffectiveEvent |
                        relation restrictwith ~\
                            {$Domain eq $domainname && $Model eq $classname} |
                        relation list ~ Event
                    }]
                }
                transitions {
                    return [pipe {
                        relvar set ${domns}::__Arch_Transition |
                        relation restrictwith ~ {$Class eq $classname} |
                        relation eliminate ~ Class |
                        relation group ~ Transition Event NewState |
                        relation extend ~ trtup TranCol dict {
                            [relation dict [tuple extract $trtup Transition] Event NewState]} |
                        relation dict ~ State TranCol
                    }] ; # <1>
                }
                activityproc {
                    return ${domns}::${classname}::__Activity::${statename}
                }
            }
        }
    }
    namespace eval Trace {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [list\
            [namespace parent]::Helpers\
            [namespace parent]::InstCmds\
        ]
        relvar create Trace {
            Trace_Id    int
            Timestamp   bignum
            Source      list
            Event       string
            Target      list
            Params      list
        } Trace_Id
        
        relvar create Creation {
            Trace_Id    int
        } Trace_Id
        
        relvar create Polymorphic {
            Trace_Id    int
            SubInst     string
            Linkage     string
        } Trace_Id
        
        relvar create Transition {
            Trace_Id    int
            CurrState   string
            NewState    string
        } Trace_Id
        
        relvar partition R1 Trace Trace_Id\
            Creation Trace_Id\
            Polymorphic Trace_Id\
            Transition Trace_Id
        variable targetCmpFunc [lambda {instrefs target} {
            lassign $target trelvar tinst
            foreach instref $instrefs {
                lassign $instref crelvar cinst
                if {$trelvar eq $crelvar && [ral relation is $tinst subsetof $cinst]} {
                    return true
                }
            }
            return false
        }]
        variable traceState off
        variable traceNumber 0
        variable traceLogState off
        variable traceLogLevel info
        variable traceLogCmd [::logger::init rosea]
        proc QueryClassTraces {classes} {
            variable Trace
            return [relation restrictwith $Trace {
                [lindex $Target 0] in $classes ||\
                    [namespace tail [lindex $Target 0]] in $classes
            }] ; # <1>
        }
        proc QueryTargetTraces {targets} {
            variable Trace
            variable targetCmpFunc
            return [relation restrictwith $Trace {[{*}$targetCmpFunc $targets $Target]}]
        }
        proc TraceCreation {source event target params} {
            variable traceState
            if {$traceState} {
                relvar eval {
                    set trace [NewTrace $source $event $target $params]
                    relvar insert Creation [list\
                        Trace_Id    [relation extract $trace Trace_Id]\
                    ]
                }
                LogTrace $trace
            }
        }
        proc TracePolymorphic {source event target sub link params} {
            variable traceState
            if {$traceState} {
                relvar eval {
                    set trace [NewTrace $source $event $target $params]
                    relvar insert Polymorphic [list\
                        Trace_Id    [relation extract $trace Trace_Id]\
                        SubInst     $sub\
                        Linkage     $link\
                    ]
                }
                LogTrace $trace
            }
        }
        proc TraceTransition {source event target curr new params} {
            variable traceState
            if {$traceState} {
                relvar eval {
                    set trace [NewTrace $source $event $target $params]
                    relvar insert Transition [list\
                        Trace_Id    [relation extract $trace Trace_Id]\
                        CurrState   $curr\
                        NewState    $new\
                    ]
                }
                LogTrace $trace
            }
        }
        proc NewTrace {src event target params} {
            variable traceNumber
            return [relvar insert Trace [list\
                Trace_Id    [incr traceNumber]\
                Timestamp   [clock microseconds]\
                Source      $src\
                Event       $event\
                Target      $target\
                Params      $params\
            ]]
        }
        proc LogTrace {trace} {
            variable traceLogState
            if {$traceLogState} {
                set rec [FormatTraceRec [lindex [TracesToRecords $trace] 0]] ; # <1>
        
                variable traceLogCmd
                variable traceLogLevel
                ${traceLogCmd}::${traceLogLevel} $rec
            }
        }
        proc TracesToRecords {traces} {
            foreach rvname {Creation Polymorphic Transition} { # <1>
                set traces [::ralutil::rvajoin $traces [relvar set $rvname] $rvname]
            }
        
            set result [list]
            relation foreach trace $traces -ascending Trace_Id { # <2>
                relation assign $trace
                set labeled [dict create\
                    id      $Trace_Id\
                    time    $Timestamp\
                    source  $Source\
                    event   $Event\
                    target  $Target\
                    params  $Params\
                    class   [lindex $Target 0]\
                ] ; # <3>
                if {[relation isnotempty $Transition]} { # <4>
                    relation assign $Transition
                    dict set labeled type transition
                    dict set labeled current $CurrState
                    dict set labeled new $NewState
                } elseif {[relation isnotempty $Polymorphic]} {
                    relation assign $Polymorphic
                    dict set labeled type polymorphic
                    dict set labeled sub $SubInst
                    dict set labeled link $Linkage
                } elseif {[relation isnotempty $Creation]} {
                    dict set labeled type creation
                }
        
                lappend result $labeled
            }
            return $result
        }
        proc DecodeAllTraces {} {
            variable Trace
            tailcall TracesToRecords $Trace
        }
        proc DecodeClassTraces {args} {
            return [TracesToRecords [QueryClassTraces $args]]
        }
        proc DecodeTargetTraces {args} {
            tailcall TracesToRecords [QueryTargetTraces $args]
        }
        proc FormatTraceRec {rec} {
            dict with rec {
                switch -exact -- $type {
                    transition {
                        append result\
                            "Transition: "\
                            [FormatTransition $source $event $params $target]\
                            " ==> $current -> $new"
                    }
                    polymorphic {
                        append result\
                            "Polymorphic : "\
                            [FormatTransition $source $event $params $target]\
                            " ==> $link -> [FormatInstRef $sub]"
                    }
                    creation {
                        append result\
                            "Creation: "\
                            "[FormatInstRef $source] - "\
                            "[FormatEvent $event $params] -> $class\
                            " ==> [FormatInstRef $target]"
                    }
                    default {
                        DeclError BAD_TRACETYPE $type
                    }
                }
            }
            return $result
        }
        proc FormatTransition {source event params target} {
            return "[FormatInstRef $source] - [FormatEvent $event $params] ->\
                [FormatInstRef $target]"
        }
        proc FormatEvent {event params} {
            return [string cat\
                "$event"\
                [expr {[llength $params] != 0 ? " \([join $params {, }]\)" : {}}]\
            ]
        }
        proc FormatInstRef {instref} {
            lassign $instref relvar inst
            if {$relvar eq {}} {
                return {()}
            } else {
                return "$relvar \([tuple get [relation tuple $inst]]\)"
            }
        }
        proc FormatTimestamp {time} {
            set sec [clock format [expr {$time / 1000000}] -format %T] ; # <1>
            set time [expr {$time % 1000000}]
            set msec [expr {$time / 1000}]
            set usec [expr {$time % 1000}]
        
            return [format %s.%03ld.%03ld $sec $msec $usec]
        }
        proc FormatTimeAsSec {time} {
            set sec [expr {$time / 1000000}]
            set time [expr {$time % 1000000}]
            set msec [expr {$time / 1000}]
            set usec [expr {$time % 1000}]
        
            return [format %3ld.%03ld.%03ld $sec $msec $usec]
        }
        proc DiagTraces {traces args} {
            set result {}
            append result "seqdiag \{\n"
            append result "    activation = none;\n"
            foreach {option value} $args {
                append result "    $option = $value;\n"
            }
        
            foreach rvname {Creation Polymorphic Transition} {
                set traces [::ralutil::rvajoin $traces [relvar set $rvname] $rvname]
            }
        
            relation foreach trace $traces -ascending Trace_Id {
                relation assign $trace
                if {[isEmptyRef $Source]} {
                    set Source EXTERNAL
                } else {
                    set Source [namespace tail [lindex $Source 0]]
                }
                set Target [namespace tail [lindex $Target 0]]
                set evtlabel [FormatEvent $Event $Params]
                if {[relation isnotempty $Polymorphic]} {
                    relation assign $Polymorphic Linkage
                    append evtlabel " <<Polymorphic $Linkage>>"
                } elseif {[relation isnotempty $Creation]} {
                    append evtlabel " <<Creation>>"
                }
                append result "    $Source ->> $Target \[label=\"$evtlabel\"\];\n"
            }
        
            append result "\}\n"
        
            return $result
        }
        proc DiagAllTraces {filename args} {
            set chan [open $filename w]
            variable Trace
            try {
                chan puts $chan [DiagTraces $Trace {*}$args]
            } finally {
                chan close $chan
            }
            return
        }
        proc DiagClassTraces {filename classes args} {
            set chan [open $filename w]
            try {
                chan puts $chan [DiagTraces [QueryClassTraces $classes] {*}$args]
            } finally {
                chan close $chan
            }
            return
        }
        proc DiagTargetTraces {filename targets args} {
            set chan [open $filename w]
            try {
                chan puts $chan [DiagTraces [QueryTargetTraces $targets] {*}$args]
            } finally {
                chan close $chan
            }
            return
        }
    }

    namespace path ::rosea::Helpers
    namespace import ::rosea::Config::ConfigEvaluate
}

package provide rosea $::rosea::version



# DO NOT EDIT THIS FILE!
# THIS FILE IS AUTOMATICALLY GENERATED FROM A LITERATE PROGRAM SOURCE FILE.
#
# This software is copyrighted 2014-2015 by G. Andrew Mangogna.
# The following terms apply to all files associated with the software unless
# explicitly disclaimed in individual files.
# 
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors and
# need not follow the licensing terms described here, provided that the
# new terms are clearly indicated on the first page of each file where
# they apply.
# 
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES
# THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
# 
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS,
# OR MODIFICATIONS.
# 
# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
# are acquiring the software on behalf of the Department of Defense,
# the software shall be classified as "Commercial Computer Software"
# and the Government shall have only "Restricted Rights" as defined in
# Clause 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing,
# the authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license.

package require Tcl 8.6

package require logger
package require ral
package require ralutil
package require struct::set
package require lambda

proc ::K {x y} {set x}

namespace eval ::rosea {
    namespace export configure
    
    namespace export configureFromChan
    
    namespace export configureFromFile
    
    namespace export generate
    
    namespace export populate
    
    namespace export populateFromChan
    
    namespace export populateFromFile
    
    namespace export save
    
    namespace export restore
    
    namespace export info
    
    namespace export tunnel
    
    namespace export trace
    
    namespace ensemble create

    variable version 1.9

    logger::initNamespace [namespace current]

    namespace import\
        ::ral::relation\
        ::ral::tuple\
        ::ral::relformat\
        ::ralutil::pipe
    namespace import ::ral::relvar
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation project ~ Name Type |
        relation dict ~ Name Type
    } headingQuery
    
    pipe {
        relation semijoin $class $Identifier -using {Domain Domain Name Class}\
                $IdentifyingAttribute |
        relation group ~ Attributes Attribute
    } idQuery
    
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation join ~ $UserSuppliedValue -using {Domain Domain Class Class Name Attribute}
    } defaultValuesQuery
    
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation join ~ $SystemSuppliedValue -using {Domain Domain Class Class Name Attribute}
    } suppliedValuesQuery
    
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation join ~ $GeneratedValue -using {Domain Domain Class Class Name Attribute}
    } generatedValuesQuery
    
    pipe {
        relation semijoin $class $Attribute -using {Domain Domain Name Class} |
        relation join ~ $ValueCheck -using {Domain Domain Class Class Name Attribute}
    } checkValuesQuery
    
    pipe {
        relation semijoin $class $StateModel -using {Domain Domain Name Model} |
        relation isnotempty
    } hasSMQuery
    
    pipe {
        relation semijoin $class $State -using {Domain Domain Name Model} |
        relation project ~ Name Parameters Action
    } statesQuery
    
    pipe {
        relation join $AttributeReference $refing\
            -using {Domain Domain ReferringClass Class\
            Relationship Relationship ReferringRole Role} |
        relation rename ~ Conditionality ReferringCond\
                Multiplicity ReferringMult |
        relation join ~ $refed -using {Domain Domain\
            ReferencedClass Class Relationship\
            Relationship ReferencedRole Role} |
        relation project ~ Domain Relationship\
            ReferringClass ReferringAttribute\
            ReferencedClass ReferencedAttribute\
            ReferringCond ReferringMult Conditionality |
        relation group ~ ReferringAttrs\
                ReferringAttribute ReferencedAttribute |
        relation extend ~ rfa\
            TagReferringAttrs {Relation {RefOrder int ReferringAttribute string\
                ReferencedAttribute string}} {
                    [relation tag [tuple extract $rfa ReferringAttrs] RefOrder]
                } |
        relation extend ~ wfa\
            SrcAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferringAttribute -ascending RefOrder]
            }\
            DstAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferencedAttribute -ascending RefOrder]
            } |
        relation extend ~ ram\
            ForwAttrs list {
                [Interleave [tuple extract $ram SrcAttrs]\
                    [tuple extract $ram DstAttrs]]
            }\
            RevAttrs list {
                [Interleave [tuple extract $ram DstAttrs]\
                    [tuple extract $ram SrcAttrs]]
            } |
        relation eliminate ~ TagReferringAttrs
    } referencesQuery
    
    pipe {
        relation semijoin $cassocs $AssociatorClass\
                -using {Domain Domain Name Relationship}\
            $ReferringClass $AttributeReference\
                -using {Domain Domain Class ReferringClass\
                Relationship Relationship Role ReferringRole} |
        relation project ~ Domain Relationship ReferringClass ReferringAttribute\
                ReferencedClass ReferencedAttribute ReferencedRole |
        relation join ~ $bothclass -using {Domain Domain Relationship Relationship\
                ReferencedClass Class ReferencedRole Role} |
        relation group ~ ReferringAttrs ReferringAttribute ReferencedAttribute |
        relation extend ~ rfa\
            TagReferringAttrs {Relation {RefOrder int ReferringAttribute string\
                ReferencedAttribute string}} {
                    [relation tag [tuple extract $rfa ReferringAttrs] RefOrder]
                } |
        relation extend ~ wfa\
            SrcAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferringAttribute -ascending RefOrder]
            }\
            DstAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferencedAttribute -ascending RefOrder]
            } |
        relation extend ~ ram\
            ForwAttrs list {
                [Interleave [tuple extract $ram SrcAttrs]\
                    [tuple extract $ram DstAttrs]]
            }\
            RevAttrs list {
                [Interleave [tuple extract $ram DstAttrs]\
                    [tuple extract $ram SrcAttrs]]
            } |
        relation eliminate ~ TagReferringAttrs
    } assocrefsQuery
    
    pipe {
        relation semijoin $rships $Generalization\
                $Subclass -using {Domain Domain Name Relationship}\
                $ReferringClass $AttributeReference\
                    -using {Domain Domain Class ReferringClass\
                    Relationship Relationship Role ReferringRole} |
        relation project ~ Domain Relationship ReferringClass ReferringAttribute\
                ReferencedClass ReferencedAttribute |
        relation group ~ ReferringAttrs\
                ReferringAttribute ReferencedAttribute |
        relation extend ~ rfa\
            TagReferringAttrs {Relation {RefOrder int ReferringAttribute string\
                ReferencedAttribute string}} {
                    [relation tag [tuple extract $rfa ReferringAttrs] RefOrder]
                } |
        relation extend ~ wfa\
            SrcAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferringAttribute -ascending RefOrder]
            }\
            DstAttrs list {
                [relation list [tuple extract $wfa TagReferringAttrs]\
                    ReferencedAttribute -ascending RefOrder]
            } |
        relation extend ~ ram\
            ForwAttrs list {
                [Interleave [tuple extract $ram SrcAttrs]\
                    [tuple extract $ram DstAttrs]]
            }\
            RevAttrs list {
                [Interleave [tuple extract $ram DstAttrs]\
                    [tuple extract $ram SrcAttrs]]
            } |
        relation eliminate ~ TagReferringAttrs
    } subrefsQuery
    
    proc configure {script} {
        namespace upvar Config errcount errcount configlineno configlineno
        set errcount 0
        set configlineno 1
    
        ConfigEvaluate ::rosea::Config $script
    
        if {$errcount > 0} {
            tailcall DeclError CONFIG_ERRORS $errcount
        }
        return $errcount
    }
    proc configureFromChan {chan} {
        tailcall configure [::chan read -nonewline $chan]
    }
    proc configureFromFile {filename} {
        set f [::open $filename r]
        try {
            configureFromChan $f
        } finally {
            ::chan close $f
        }
    }
    proc generate {{pattern *} {prefix {}}} {
        if {$prefix ne {}} {
            if {[string range $prefix 0 1] ne "::"} {
                set prefix [uplevel 1 {namespace current}]::$prefix
            }
            set prefix [string trimright $prefix :]
        } elseif {$prefix eq "::"} {
            set prefix {} ; # <1>
        }
        namespace upvar Config\
            Domain Domain\
            DomainElement DomainElement\
            Class Class\
            Attribute Attribute\
            DefaultValue DefaultValue\
            UserSuppliedValue UserSuppliedValue\
            SystemSuppliedValue SystemSuppliedValue\
            GeneratedValue GeneratedValue\
            ValueCheck ValueCheck\
            Identifier Identifier\
            IdentifyingAttribute IdentifyingAttribute\
            Relationship Relationship\
            Association Association\
            SimpleAssociation SimpleAssociation\
            SimpleReferringClass SimpleReferringClass\
            SimpleReferencedClass SimpleReferencedClass\
            ClassBasedAssociation ClassBasedAssociation\
            AssociatorClass AssociatorClass\
            SourceClass SourceClass\
            TargetClass TargetClass\
            Generalization Generalization\
            Superclass Superclass\
            Subclass Subclass\
            AttributeReference AttributeReference\
            ReferencedIdAttribute ReferencedIdAttribute\
            ReferringClass ReferringClass\
            ReferencedClass ReferencedClass\
            DomainOperation DomainOperation\
            SuppliedOperation SuppliedOperation\
            UserClassOperation UserClassOperation\
            SystemClassOperation SystemClassOperation\
            UserInstanceOperation UserInstanceOperation\
            SystemInstanceOperation SystemInstanceOperation\
            InstanceStateModel InstanceStateModel\
            StateModel StateModel\
            StatePlace StatePlace\
            State State\
            EffectiveEvent EffectiveEvent\
            DeferredEvent DeferredEvent\
            TransitionPlace TransitionPlace\
            StateTransition StateTransition\
            NonStateTransition NonStateTransition\
            AssignerStateModel AssignerStateModel\
            SingleAssigner SingleAssigner\
            MultipleAssigner MultipleAssigner\
            PolymorphicEvent PolymorphicEvent
    
        set genDomain [relation restrict $Domain dom {
            [string match $pattern [tuple extract $dom Name]]
        }]
        relation foreach domain $genDomain {
            set domainName [relation extract $domain Name]
            relvar updateone Config::Domain dtup [list Name $domainName] {
                tuple update $dtup Location $prefix
            }
            
            set domns ${prefix}::$domainName
            namespace eval $domns {
                namespace import\
                    ::ral::relation\
                    ::ral::tuple\
                    ::ral::relformat\
                    ::ralutil::pipe
                ral relvar create __Arch_RefLink {
                    Relationship    string
                    ReferringClass  string
                    ReferencedClass string
                    ReferringAttrs  {Relation
                            {ReferringAttribute string ReferencedAttribute string}}
                } Relationship
                ral relvar create __Arch_AssocRef {
                    Relationship    string
                    AssocClass      string
                    References      {Relation\
                        {Participant string Role string ReferringAttrs {Relation\
                            {ReferringAttribute string ReferencedAttribute string}}}}
                } Relationship
                ral relvar create __Arch_SuperLink {
                    Relationship    string
                    SuperClass      string
                } Relationship
                
                ral relvar create __Arch_SubLink {
                    Relationship    string
                    SubClass        string
                    ReferringAttrs  {Relation\
                        {ReferringAttribute string ReferencedAttribute string}}
                } {Relationship SubClass}
                
                ral relvar association __Arch_R5\
                    __Arch_SubLink Relationship +\
                    __Arch_SuperLink Relationship 1
                ral relvar create __Arch_Link {
                    Name            string
                    SrcClass        string
                } {Name SrcClass}
                ral relvar create __Arch_AssociationLink {
                    Name            string
                    SrcClass        string
                    DstClass        string
                    Attrs           list
                    PrevSrcClass    string
                } {Name SrcClass}
                ral relvar association __Arch_R4\
                    __Arch_AssociationLink {Name PrevSrcClass} ?\
                    __Arch_AssociationLink {Name SrcClass} ?
                ral relvar create __Arch_PartitionLink {
                    Name            string
                    SrcClass        string
                } {Name SrcClass}
                ral relvar partition __Arch_R3 __Arch_Link {Name SrcClass}\
                    __Arch_AssociationLink {Name SrcClass}\
                    __Arch_PartitionLink {Name SrcClass}
                ral relvar create __Arch_PartitionDst {
                    Name            string
                    SrcClass        string
                    DstClass        string
                    Attrs           list
                } {Name SrcClass DstClass}
                ral relvar association __Arch_R2\
                    __Arch_PartitionDst {Name SrcClass} +\
                    __Arch_PartitionLink {Name SrcClass} 1
                ral relvar create __Arch_State {
                    Class string
                    State string
                } {Class State}
                ral relvar create __Arch_Event {
                    Class string
                    Event string
                } {Class Event}
                ral relvar create __Arch_Transition {
                    Class string
                    State string
                    Event string
                    NewState string
                } {Class State Event}
                ral relvar correlation __Arch_R1 __Arch_Transition\
                    {Class State} + __Arch_State {Class State}\
                    {Class Event} + __Arch_Event {Class Event}
                ral relvar create __Arch_InitialState {
                    Class string
                    State string
                } Class
                ral relvar association __Arch_R6\
                    __Arch_InitialState {Class State} ?\
                    __Arch_State {Class State} 1
                ral relvar create __Arch_TerminalState {
                    Class string
                    State string
                } {Class State}
                ral relvar association __Arch_R7\
                    __Arch_TerminalState {Class State} *\
                    __Arch_State {Class State} 1
                ral relvar create __Arch_PolymorphicEvent {
                    Class           string
                    Event           string
                } {Class Event}
            }
            namespace eval $domns namespace path ::rosea::InstCmds
            set domops [relation semijoin $domain $DomainOperation -using {Name Domain}]
            relation foreach domop $domops {
                relation assign $domop\
                    {Name name} {Parameters parameters} {Body body}
                proc ${domns}::$name $parameters [list ::ral relvar eval $body] ; # <1>
            }
            
            namespace eval $domns [list\
                namespace export {*}[relation list $domops Name]\
            ]
            namespace eval $domns namespace ensemble create
            set statemodels [relation semijoin $domain $StateModel\
                -using {Name Domain}]
            
            relvar eval {
                relvar set ${domns}::__Arch_InitialState [pipe {
                    relation project $statemodels Model InitialState |
                    relation rename ~ Model Class InitialState State
                }]
                set states [relation semijoin $domain $StatePlace -using {Name Domain}]
                relvar set ${domns}::__Arch_State [pipe {
                    relation project $states Model Name |
                    relation rename ~ Model Class Name State
                }]
                relvar set ${domns}::__Arch_TerminalState [pipe {
                    relation semijoin $domain $State -using {Name Domain} |
                    relation restrict ~ termtuple {[tuple extract $termtuple IsFinal]} |
                    relation project ~ Model Name |
                    relation rename ~ Model Class Name State
                }]
                set events [relation semijoin $domain $EffectiveEvent\
                    -using {Name Domain}]
                relvar set ${domns}::__Arch_Event [pipe {
                    relation project $events Model Event |
                    relation rename ~ Model Class
                }]
                set alltrans [pipe {
                    relation join $states $events |
                    relation rename ~ Name State
                }] ; # <1>
                set statetrans [relation semijoin $domain $StateTransition\
                    -using {Name Domain}]
                set nontrans [pipe {
                    relation semijoin $domain $NonStateTransition -using {Name Domain} |
                    relation rename ~ TransRule NewState
                }]
                set deftrans [pipe {
                    relation minus $alltrans $TransitionPlace |
                    relation join ~ $StateModel |
                    relation eliminate ~ InitialState |
                    relation rename ~ DefaultTrans NewState |
                    relation update ~ dttup {[tuple extract $dttup State] eq "@"} {
                        tuple update $dttup NewState CH}
                }]
                relvar set ${domns}::__Arch_Transition [pipe {
                    relation union $statetrans $nontrans $deftrans |
                    relation eliminate ~ Domain |
                    relation rename ~ Model Class
                }]
                relvar set ${domns}::__Arch_PolymorphicEvent [pipe {
                    relation semijoin $domain $DeferredEvent\
                        -using {Name Domain} |
                    relation project ~ Model Event |
                    relation rename ~ Model Class
                }]
            }
            variable headingQuery
            variable idQuery
            variable defaultValuesQuery
            variable suppliedValuesQuery
            variable generatedValuesQuery
            variable checkValuesQuery
            variable hasSMQuery
            variable statesQuery
            
            set classes [relation semijoin $domain $DomainElement -using {Name Domain}\
                    $Class -using {Domain Domain Element Name}]
            relation foreach class $classes {
                set className ${domns}::[relation extract $class Name]
                namespace eval $className {
                    namespace import\
                        ::ral::relation\
                        ::ral::tuple\
                        ::ral::relformat\
                        ::ralutil::pipe
                }
                namespace eval $className [list namespace path\
                        [list ::rosea::InstCmds $domns]]
                set heading [eval $headingQuery]
                set idset [list]
                relation foreach id [eval $idQuery] -ascending Number {
                    lappend idset [relation list\
                            [relation extract $id Attributes] Attribute]
                }
                
                relvar create $className $heading {*}$idset
                
                # <1>
                set checkvalues [eval $checkValuesQuery]
                
                if {[relation isnotempty $checkvalues]} {
                    relvar trace add variable $className {insert update set} [list\
                        ::rosea::Helpers::CheckValueTrace\
                        [relation dict $checkvalues Name Expression]\
                    ]
                }
                set defaultvalues [eval $defaultValuesQuery]
                
                if {[relation isnotempty $defaultvalues]} {
                    relvar trace add variable $className insert [list\
                        ::rosea::Helpers::UserDefaultTrace\
                        [relation dict $defaultvalues Name Type]\
                        [relation dict $defaultvalues Name Value]\
                    ]
                }
                set supplied [eval $suppliedValuesQuery]
                
                if {[relation isnotempty $supplied]} {
                    pipe {
                        relation extend $supplied stup ClassName string {
                            [string cat [tuple extract $stup Class] , [tuple extract $stup Name]]
                        } |
                        relation array ~ ${domns}::__Arch_SuppliedDefault ClassName StartValue 
                    } ; # <1>
                    relvar trace add variable $className insert [list\
                        ::rosea::Helpers::SupplyDefaultTrace\
                        [relation dict $supplied Name Type]\
                    ]
                }
                set generatecmds [eval $generatedValuesQuery]
                
                if {[relation isnotempty $generatecmds]} {
                    relvar trace add variable $className insert [list\
                        ::rosea::Helpers::GenerateDefaultTrace\
                        [relation dict $generatecmds Name Type]\
                        [relation dict $generatecmds Name Cmd]\
                    ]
                }
                set hasStateModel [eval $hasSMQuery]
                if {$hasStateModel} {
                    set instid [lindex $idset 0]
                    set instheading [list]
                    foreach attr $instid {
                        lappend instheading $attr [dict get $heading $attr] ; # <1>
                    }
                    lappend instheading __State string
                    relvar create ${domns}::[relation extract $class Name]__STATEINST\
                        $instheading $instid
                    set actns ${className}::__Activity
                    namespace eval $actns {
                        namespace import\
                            ::ral::relation\
                            ::ral::tuple\
                            ::ral::relformat\
                            ::ralutil::pipe
                    }
                    namespace eval $actns [list\
                        namespace path [list\
                            ::rosea::InstCmds\
                            $className\
                            $domns\
                        ]\
                    ]
                    relation foreach state [eval $statesQuery] {
                        relation assign $state\
                            {Name stateName}\
                            {Parameters params}\
                            {Action stateAction}
                        proc ${actns}::$stateName [linsert $params 0 self] $stateAction
                    }
                }
                set opmap [dict create]
                set classops [relation semijoin $class $UserClassOperation\
                    -using {Domain Domain Name Class}]
                relation foreach classop $classops {
                    relation assign $classop\
                        {Name opname}\
                        {Parameters params}\
                        {Body opbody}
                
                    proc ${className}::$opname $params $opbody
                    dict set opmap $opname ${className}::$opname
                }
                
                set sysmap [QuerySystemClassOperations $className false]
                if {$hasStateModel} {
                    set sysmap [dict merge $sysmap [QuerySystemClassOperations $className true]]
                }
                
                namespace ensemble create\
                    -command $className\
                    -map [dict merge $opmap $sysmap]
                set opmap [dict create]
                set instops [relation semijoin $class $UserInstanceOperation\
                    -using {Domain Domain Name Class}]
                relation foreach instop $instops {
                    relation assign $instop\
                        {Name opname}\
                        {Parameters params}\
                        {Body opbody}
                
                    proc ${className}::$opname [linsert $params 0 self] $opbody
                    dict set opmap $opname ${className}::$opname
                }
                set sysmap [QuerySystemInstanceOperations false]
                set hasPolyEvents [relation isnotempty\
                    [relation semijoin $class $PolymorphicEvent\
                        -using {Domain Domain Name Model}]\
                ]
                if {$hasStateModel || $hasPolyEvents} {
                    set sysmap [dict merge $sysmap [QuerySystemInstanceOperations true]]
                }
                
                namespace ensemble create\
                    -command ${className}::Instance\
                    -parameters instref\
                    -map [dict merge $opmap $sysmap]
            }
            set rships [relation semijoin $domain $DomainElement -using {Name Domain}\
                    $Relationship -using {Domain Domain Element Name}]
            
            set sassocs [relation semijoin $rships $Association\
                    $SimpleAssociation]
            set refing [relation semijoin $sassocs $SimpleReferringClass\
                    -using {Domain Domain Name Relationship}]
            set refed [relation semijoin $sassocs $SimpleReferencedClass\
                    -using {Domain Domain Name Relationship}]
            variable referencesQuery
            set references [eval $referencesQuery]
            relvar eval {
                set flink [pipe {
                    relation project $references Relationship ReferringClass |
                    relation rename ~ Relationship Name ReferringClass SrcClass
                }]
                set blink [pipe {
                    relation project $references Relationship ReferencedClass |
                    relation rename % Relationship Name ReferencedClass SrcClass |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%] ; # <1>
                
                relvar union ${domns}::__Arch_Link $flink $blink
                set flink [pipe {
                    relation project $references Relationship ReferringClass\
                            ReferencedClass ForwAttrs |
                    relation rename ~ Relationship Name ReferringClass SrcClass\
                            ReferencedClass DstClass ForwAttrs Attrs |
                    relation extend ~ al PrevSrcClass string {{}}
                }] ; # <1>
                set blink [pipe {
                    relation project $references Relationship ReferringClass\
                            ReferencedClass RevAttrs |
                    relation rename % Relationship Name ReferencedClass SrcClass\
                            ReferringClass DstClass RevAttrs Attrs |
                    relation extend % al PrevSrcClass string {{}} |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                
                relvar union ${domns}::__Arch_AssociationLink $flink $blink
                relvar union ${domns}::__Arch_RefLink [relation project $references\
                    Relationship ReferringClass ReferencedClass ReferringAttrs]
            }
            relation foreach reference $references {
                relation assign $reference\
                    {Relationship relationship}\
                    {ReferringClass referringClass}\
                    {ReferencedClass referencedClass}\
                    {ReferringCond referringCond}\
                    {ReferringMult referringMult}\
                    {Conditionality referencedCond}\
                    {SrcAttrs srcAttrs}\
                    {DstAttrs dstAttrs}
            
                # Create the relvar constraint.
                relvar association ${domns}::$relationship\
                     ${domns}::$referringClass $srcAttrs\
                    [MapCondMultToConstraint $referringCond $referringMult]\
                    ${domns}::$referencedClass $dstAttrs\
                    [MapCondMultToConstraint $referencedCond false]
            
                # All simple associations get a link and unlink command in their ensemble.
                set ensemblemap [dict create\
                    link [list ::rosea::RelCmds::linkSimple $relationship]\
                    unlink [list ::rosea::RelCmds::unlinkSimple $relationship]\
                ]
            
                # Determine if we have any assigners assocated  with the relationship.
                # Single assigners get different commands from multiple assigners.
                set rpath ${domns}::$relationship
                set assigner [relation semijoin $reference $SingleAssigner\
                    -using {Domain Domain Relationship Relationship}]
                if {[relation isnotempty $assigner]} {
                    dict set ensemblemap signal\
                        [list ::rosea::RelCmds::signalAssigner $rpath]
                } else {
                    set assigner [relation semijoin $reference $MultipleAssigner\
                        -using {Domain Domain Relationship Relationship}]
                    if {[relation isnotempty $assigner]} {
                        dict set ensemblemap signal [list\
                            ::rosea::RelCmds::signalMultiAssigner $rpath]
                        dict set ensemblemap create [list\
                            ::rosea::RelCmds::createMultiAssigner $rpath]
                    }
                }
                # Create the relationship ensemble command.
                namespace ensemble create -command $rpath -map $ensemblemap
            }
            set cassocs [relation semijoin $rships $Association\
                    $ClassBasedAssociation]
            set sourceclass [relation semijoin $cassocs $SourceClass\
                -using {Domain Domain Name Relationship}]
            set targetclass [relation semijoin $cassocs $TargetClass\
                -using {Domain Domain Name Relationship}]
            set bothclass [relation union $sourceclass $targetclass] ; # <1>
            variable assocrefsQuery
            set assocrefs [eval $assocrefsQuery]
            relvar eval {
                set aforw [pipe {
                    relation project $assocrefs Relationship ReferringClass |
                    relation rename ~ Relationship Name ReferringClass SrcClass
                }]
                set arev [relation update $aforw lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}]
                set sources [pipe {
                    relation restrict $assocrefs aref {
                        [tuple extract $aref ReferencedRole] eq "source"} |
                    relation eliminate ~ ReferencedRole
                }]
                set sforw [pipe {
                    relation project $sources Relationship ReferencedClass |
                    relation rename ~ Relationship Name ReferencedClass SrcClass
                }]
                set targets [pipe {
                    relation restrict $assocrefs aref {
                        [tuple extract $aref ReferencedRole] eq "target"} |
                    relation eliminate ~ ReferencedRole
                }]
                set trev [pipe {
                    relation project $targets Relationship ReferencedClass |
                    relation rename % Relationship Name ReferencedClass SrcClass |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                relvar union ${domns}::__Arch_Link $aforw $arev $sforw $trev
                set sforw [pipe {
                    relation project $sources Relationship ReferringClass ReferencedClass\
                        RevAttrs |
                    relation rename ~ Relationship Name ReferringClass DstClass\
                        ReferencedClass SrcClass RevAttrs Attrs |
                    relation extend ~ al PrevSrcClass string {{}}
                }]
                set trev [pipe {
                    relation project $targets Relationship ReferringClass ReferencedClass\
                        RevAttrs |
                    relation rename % Relationship Name ReferringClass DstClass\
                        ReferencedClass SrcClass RevAttrs Attrs |
                    relation extend % al PrevSrcClass string {{}} |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                set onerefs [relation rename $sources ReferencedClass OneClass\
                        Conditionality OneCond Multiplicity OneMult\
                        ReferringAttrs OneReferringAttrs SrcAttrs OneSrcAttrs\
                        DstAttrs OneDstAttrs ForwAttrs OneForwAttrs RevAttrs OneRevAttrs]
                set otherrefs [relation rename $targets ReferencedClass OtherClass\
                        Conditionality OtherCond Multiplicity OtherMult ReferringAttrs\
                        OtherReferringAttrs SrcAttrs OtherSrcAttrs DstAttrs OtherDstAttrs\
                        ForwAttrs OtherForwAttrs RevAttrs OtherRevAttrs]
                set bothrefs [relation join $onerefs $otherrefs\
                    -using {Domain Domain ReferringClass ReferringClass\
                        Relationship Relationship}]
                set aforw [pipe {
                    relation project $bothrefs Relationship ReferringClass OtherClass\
                        OtherForwAttrs OneClass |
                    relation rename ~ Relationship Name ReferringClass SrcClass\
                            OtherClass DstClass OtherForwAttrs Attrs OneClass PrevSrcClass
                }]
                set arev [pipe {
                    relation project $bothrefs Relationship ReferringClass OneClass\
                            OneForwAttrs OtherClass |
                    relation rename % Relationship Name ReferringClass SrcClass\
                            OneClass DstClass OneForwAttrs Attrs OtherClass PrevSrcClass |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                relvar union ${domns}::__Arch_AssociationLink $sforw $trev $aforw $arev
                relvar union ${domns}::__Arch_AssocRef [pipe {
                    relation project $assocrefs Relationship ReferringClass\
                        ReferencedClass ReferencedRole ReferringAttrs |
                    relation rename ~ ReferringClass AssocClass ReferencedClass Participant\
                        ReferencedRole Role |
                    relation group ~ References Participant Role ReferringAttrs
                }]
            }
            relation foreach bothref $bothrefs {
                relation assign $bothref\
                    {Relationship relationship}\
                    {ReferringClass associator}\
                    {OneClass sourceClass}\
                    {OneCond sourceCond}\
                    {OneMult sourceMult}\
                    {OneSrcAttrs sourceAssocAttrs}\
                    {OneDstAttrs sourceDstAttrs}\
                    {OtherClass targetClass}\
                    {OtherCond targetCond}\
                    {OtherMult targetMult}\
                    {OtherSrcAttrs targetAssocAttrs}\
                    {OtherDstAttrs targetDstAttrs}
            
                # Create the correlation constraint
                relvar correlation ${domns}::$relationship ${domns}::$associator\
                    $sourceAssocAttrs [MapCondMultToConstraint $targetCond $targetMult]\
                    ${domns}::$sourceClass $sourceDstAttrs\
                    $targetAssocAttrs [MapCondMultToConstraint $sourceCond $sourceMult]\
                    ${domns}::$targetClass $targetDstAttrs ; # <1>
            
                set ensemblemap [dict create\
                    link [list ::rosea::RelCmds::linkAssoc $relationship]\
                    reference [list ::rosea::RelCmds::referenceAssoc $relationship]\
                    unlink [list ::rosea::RelCmds::unlinkAssoc $relationship]\
                ]
                # Determine if we have any assigners
                set rpath ${domns}::$relationship
                set assigner [relation semijoin $bothref $SingleAssigner\
                    -using {Domain Domain Relationship Relationship}]
                if {[relation isnotempty $assigner]} {
                    dict set ensemblemap signal\
                        [list ::rosea::RelCmds::signalAssigner $rpath]
                } else {
                    set assigner [relation semijoin $bothref $MultipleAssigner\
                        -using {Domain Domain Relationship Relationship}]
                    if {[relation isnotempty $assigner]} {
                        dict set ensemblemap signal [list\
                            ::rosea::RelCmds::signalMultiAssigner $rpath]
                        dict set ensemblemap create [list\
                            ::rosea::RelCmds::createMultiAssigner $rpath]
                    }
                }
                namespace ensemble create -command $rpath -map $ensemblemap
            }
            variable subrefsQuery
            set subrefs [eval $subrefsQuery]
            relvar eval {
                set sublinks [pipe {
                    relation project $subrefs Relationship ReferringClass |
                    relation rename ~ Relationship Name ReferringClass SrcClass
                }]
                set superlinks [pipe {
                    relation project $subrefs Relationship ReferencedClass |
                    relation rename % Relationship Name ReferencedClass SrcClass |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                
                relvar union ${domns}::__Arch_Link $sublinks $superlinks
                relvar union ${domns}::__Arch_AssociationLink [pipe {
                    relation project $subrefs Relationship ReferringClass ReferencedClass\
                            ForwAttrs |
                    relation rename ~ Relationship Name ReferringClass SrcClass\
                            ReferencedClass DstClass ForwAttrs Attrs |
                    relation extend ~ al PrevSrcClass string {{}}
                }]
                relvar union ${domns}::__Arch_PartitionLink $superlinks
                relvar union ${domns}::__Arch_PartitionDst [pipe {
                    relation project $subrefs Relationship ReferencedClass\
                            ReferringClass RevAttrs |
                    relation rename % Relationship Name ReferencedClass SrcClass\
                            ReferringClass DstClass RevAttrs Attrs |
                    relation update % lnk {1} {
                        tuple update $lnk Name ~[tuple extract $lnk Name]}
                } {} |%]
                relvar union ${domns}::__Arch_SuperLink [pipe {
                    relation project $subrefs Relationship ReferencedClass |
                    relation rename ~ ReferencedClass SuperClass
                }]
                relvar union ${domns}::__Arch_SubLink [pipe {
                    relation project $subrefs Relationship ReferringClass ReferringAttrs |
                    relation rename ~ ReferringClass SubClass
                }]
            }
            set partrefs [pipe {
                relation project $subrefs Relationship ReferencedClass DstAttrs\
                        ReferringClass SrcAttrs |
                relation extend ~ prs SubAttrMap list {[list\
                        ${domns}::[tuple extract $prs ReferringClass]\
                        [tuple extract $prs SrcAttrs]]} |
                relation eliminate ~ ReferringClass SrcAttrs |
                relation group ~ SubClassRefs SubAttrMap |
                relation extend ~ spt SubParts list {
                        [concat {*}[relation list [tuple extract $spt SubClassRefs]]]} |
                relation eliminate ~ SubClassRefs
            }]
            
            relation foreach partref $partrefs {
                relation assign $partref\
                    {Relationship relationship}\
                    {ReferencedClass superclass}\
                    {DstAttrs superattrs}\
                    {SubParts subparts}
            
                relvar partition ${domns}::$relationship ${domns}::$superclass\
                        $superattrs {*}$subparts
                namespace ensemble create\
                    -command ${domns}::$relationship\
                    -map [dict create migrate [list ::rosea::RelCmds::migrate\
                            $relationship]]
            }
            set assigners [relation semijoin $domain $AssignerStateModel\
                    -using {Name Domain}]
            relation foreach assigner $assigners {
                set asgnns\
                    ${domns}::[relation extract $assigner Relationship]::__Activity
                namespace eval $asgnns {
                    namespace import\
                        ::ral::relation\
                        ::ral::tuple\
                        ::ral::relformat\
                        ::ralutil::pipe
                }
                namespace eval $asgnns [list\
                    namespace path [list\
                        ::rosea::InstCmds\
                        $domns\
                    ]\
                ]
                set states [pipe {
                    relation semijoin $assigner $State\
                        -using {Domain Domain Relationship Model} |
                    relation project ~ Name Parameters Action
                }]
                relation foreach state $states {
                    relation assign $state\
                        {Name stateName}\
                        {Parameters params}\
                        {Action stateAction}
                    set params [linsert $params 0 self]
                    proc ${asgnns}::$stateName $params $stateAction
                }
            }
            relation foreach sassigner\
                    [relation semijoin $domain $SingleAssigner\
                    -using {Name Domain}] {
                relation assign $sassigner {Relationship relationship}
                relvar create ${domns}::${relationship}__STATEINST {
                    Id      int
                    __State string
                } Id
                CreateInInitialState $domns $relationship {Id 0} ; # <1>
            }
            relation foreach massigner\
                    [relation semijoin $domain $MultipleAssigner\
                    -using {Name Domain}] {
                relation assign $massigner {Relationship relationship}
                set assignvar ${domns}::${relationship}__STATEINST
            
                set idattrs [pipe {
                    relation semijoin $massigner $Identifier\
                        $IdentifyingAttribute\
                        $Attribute -using {Domain Domain Class Class\
                            Attribute Name} |
                    relation dict ~ Name Type
                }]
                relvar create $assignvar\
                    [concat $idattrs [list __State string]]\
                    [dict keys $idattrs]
            }
        }
    }
    proc populate {script} {
        namespace upvar Config errcount errcount configlineno configlineno
        set errcount 0
        set configlineno 1
    
        ConfigEvaluate ::rosea::Populate $script ; # <1>
    
        if {$errcount > 0} {
            tailcall DeclError CONFIG_ERRORS $errcount
        }
        return $errcount
    }
    proc populateFromChan {chan} {
        tailcall populate [::chan read -nonewline $chan]
    }
    proc populateFromFile {filename} {
        set f [::open $filename r]
        try {
            populateFromChan $f
        } finally {
            ::chan close $f
        }
    }
    proc save {args} {
        set savecmd ::ral::serializeToFile
        set asynccmd {}
    
        set options $args
        while {1} {
            if {[string index [lindex $options 0] 0] eq "-"} {
                set options [lassign $options option]
                switch -exact -- $option {
                    -sqlite {
                        set savecmd ::ral::storeToSQLite
                    }
                    -tclral {
                        set savecmd ::ral::serializeToFile
                    }
                    -async {
                        set options [lassign $options asynccmd]
                    }
                    default {
                        tailcall DeclError UNKNOWN_OPTION save $option
                    }
                }
            } else {
                break
            }
        }
    
        if {[llength $options] == 2} {
            lassign $options domain file
            if {[string range $domain 0 1] ne "::"} { # <1>
                set domrel [relvar restrictone ::rosea::Config::Domain Name $domain]
                if {[relation isempty $domrel]} {
                    tailcall DeclError UNKNOWN_DOMAIN $domain
                }
                set domain [string cat [relation extract $domrel Location]\
                        :: $domain]
            }
        } else {
            tailcall DeclError SAVE_ARG_ERROR $args
        }
    
        set script "try \{$savecmd $file ${domain}::\\\[A-Za-z0-9\\\]*\}" ; # <2>
        if {$asynccmd ne {}} {
            append script " finally \{$asynccmd $domain $file\}"
        }
    
        after idle [list ::apply [list {} $script]] ; # <3>
    }
    proc restore {args} {
        set restorecmd ::ral::mergeFromFile
    
        set options $args
        while {1} {
            if {[string index [lindex $options 0] 0] eq "-"} {
                set options [lassign $options option]
                switch -exact -- $option {
                    -sqlite {
                        set restorecmd ::ral::mergeFromSQLite
                    }
                    -tclral {
                        set restorecmd ::ral::mergeFromFile
                    }
                    default {
                        tailcall DeclError UNKNOWN_OPTION restore $option
                    }
                }
            } else {
                break
            }
        }
    
        if {[llength $options] == 2} {
            lassign $options domain file
            if {[string range $domain 0 1] ne "::"} {
                set domrel [relvar restrictone ::rosea::Config::Domain Name $domain]
                if {[relation isempty $domrel]} {
                    tailcall DeclError UNKNOWN_DOMAIN $domain
                }
                set domain [string cat [relation extract $domrel Location]\
                        :: $domain]
            }
        } else {
            tailcall DeclError RESTORE_ARG_ERROR $args
        }
    
        eval [list $restorecmd $file $domain]
    
        # Determine the values for the system supplied defaults.  We examine all
        # the classes that have such attributes and find the maximum value of the
        # attribute.  This can then be placed in the array that is used when new
        # default values are generated.
        set domainname [namespace tail $domain]
        set supplied [pipe {
            relvar set ::rosea::Config::SystemSuppliedValue |
            relation restrictwith ~ {$Domain eq $domainname}
        }]
    
        relation foreach sup $supplied {
            relation assign $sup
            set classtups [relvar set ${domain}::$Class]
            if {[relation isempty $classtups]} {
                set maxvalue $StartValue
            } else {
                set maxvalue [pipe {
                    relation summarizeby $classtups {} cv\
                        MaxValue int {rmax($cv, $Attribute)} |
                    relation extract ~ MaxValue
                }]
            }
            set ${domain}::__Arch_SuppliedDefault($Class,$Attribute)\
                [expr {$maxvalue + 1}]
        }
        return
    }
    proc info {args} {
        set args [lassign $args subcmd]
    
        switch -exact -- $subcmd {
            domain {
                Info::domain $args
            }
            class {
                Info::class $args
            }
            statemodel {
                Info::statemodel $args
            }
            default {
                tailcall DeclError UNKNOWN_INFO_CMD $subcmd
            }
        }
    }
    proc tunnel {instref op args} {
        relvar eval {
            set result [[lindex $instref 0]::Instance $instref $op {*}$args]
        }
        return $result
    }
    proc trace {subcmd args} {
        switch -exact -- $subcmd {
            control {
                tailcall traceControl {*}$args
            }
            decode {
                switch -exact -- [lindex $args 0] {
                    all {
                        tailcall Trace::DecodeAllTraces
                    }
                    class {
                        tailcall Trace::DecodeClassTraces {*}[lrange $args 1 end]
                    }
                    target {
                        tailcall Trace::DecodeTargetTraces {*}[lrange $args 1 end]
                    }
                    default {
                        tailcall DeclError UNKNOWN_TRACE_CMD [lindex $args 0]
                    }
                }
            }
            format {
                tailcall formatTraces {*}$args
            }
            diagram {
                switch -exact -- [lindex $args 0] {
                    all {
                        tailcall Trace::DiagAllTraces {*}[lrange $args 1 end]
                    }
                    class {
                        tailcall Trace::DiagClassTraces {*}[lrange $args 1 end]
                    }
                    target {
                        tailcall Trace::DiagTargetTraces {*}[lrange $args 1 end]
                    }
                    default {
                        tailcall DeclError UNKNOWN_TRACE_CMD [lindex $args 0]
                    }
                }
            }
            default {
                tailcall DeclError UNKNOWN_TRACE_CMD $subcmd
            }
        }
    }
    proc traceControl {op args} {
        switch -exact -- $op {
            on {
                namespace upvar Trace traceState traceState
                set traceState on
            }
            off {
                namespace upvar Trace traceState traceState
                set traceState off
            }
            status {
                namespace upvar Trace traceState traceState
                return $traceState
            }
            clear {
                relvar eval {
                    foreach rvar {Trace Creation Polymorphic Transition} {
                        relvar set Trace::$rvar\
                                [relation emptyof [relvar set Trace::$rvar]]
                    }
                }
                namespace upvar Trace traceNumber traceNumber
                set traceNumber 0
            }
            logon {
                namespace upvar Trace traceLogState traceLogState
                set traceLogState on
            }
            logoff {
                namespace upvar Trace traceLogState traceLogState
                set traceLogState off
            }
            loglevel {
                namespace upvar Trace traceLogLevel traceLogLevel
                if {[llength $args] != 0} {
                    set traceLogLevel [lindex $args 0]
                }
                return $traceLogLevel
            }
            save {
                if {[llength $args] == 0} {
                    DeclError NO_SAVEFILE
                }
                ral storeToSQLite [lindex $args 0] ::rosea::Trace::*
            }
            default {
                DeclError BAD_TRACEOP $op
            }
        }
    }
    proc formatTraces {tracerecs} {
        if {[llength $tracerecs] == 0} {
            return {}
        }
        set prevtime [dict get [lindex $tracerecs 0] time]
        foreach rec $tracerecs {
            dict with rec {
                append result "[Trace::FormatTimestamp $time]: "
                append result "[Trace::FormatTimeAsSec\
                        [expr {$time - $prevtime}]]: "
                set prevtime $time
                append result [Trace::FormatTraceRec $rec] \n
            }
        }
        return [string trimright $result]
    }
    namespace eval Helpers {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        variable errFormats
        set errFormats [dict create {*}{
            SAME_CLASS   {operation is only allowed for references to the same class,\
                            got "%s" and "%s"}
            UNKNOWN_STATE   {unknown state, "%s", for class, "%s"}
            UNKNOWN_EVENT   {unknown event, "%s", for class, "%s"}
            NO_CREATION_EVENTS   {class, "%s", has no defined creation events}
            NO_CROSS_DOMAIN         {cannot link instances across domains,\
                                        got "%s" and "%s"}
            UNKNOWN_RELATIONSHIP    {unknown relationship, "%s"}
            NON_PARTICIPANTS        {"%s" and "%s" don't participate in %s,\
                                        expected "%s" and "%s"}
            MUST_BE_SINGULAR    {number of referred to instances for "%s" must be one,\
                                    got %d}
            NOT_IN_ASSOCIATION         {"%s" $relvar1 not a participant in "%s"}
            DIRECTION_REQUIRED  {direction argument is required: got "%s"}
            AMBIGUOUS_UNLINK         {"%s" is reflexive and linking via "%s" is ambiguous}
            NO_SUBCLASS         {relationship "%s" does not have a "%s"}
            NO_ASSIGNER         {relationship, "%s", does not have an assigner}
            NO_IDENTIFIER       {bad identifying attributes, expected "%s", got "%s"}
            UNKNOWN_ASSIGNER    {unknown assigner instance, "%s", for relationship, "%s"}
            UNKNOWN_LINKAGE {unknown relationship, "%s", for class, "%s"}
            PATH_ERROR      {relationship, "%s", from "%s" to "%s", does not end at "%s"}
            GEN_PATH_ERROR  {navigating from superclass, "%s", along generalization "%s",\
                            does not have "%s" as a subclass}
            ARG_ERROR           {attribute updates must be name / value pairs, got "%s"}
            ID_UPDATE           {cannot update identifying attributes, "%s"}
            UNKNOWN_ATTRIBUTE   {unknown attribute, "%s"}
            WITH_ATTR_USAGE {wrong arguments, should be,\
                    "withAttribute attrvarpair1 ?attrvarpair2 ...? body"}
            ATTR_VAR_SPEC   {attribute / variable argument must be a one or two element\
                    list, got "%s"}
            INVALID_TIME    {invalid time value, "%s"}
            SINGLE_OR_EMPTY_REF_REQUIRED {single valued or nil reference required, %d found}
            SINGLE_REF_REQUIRED     {single valued reference required, %d found}
            ASYNC_CREATION_FAILED     {asynchronous creation of an instance of class, "%s",\
                with attributes, "%s", failed: %s}
            EVENT_IN_FLIGHT     {event, "%s", sent to "%s", which does not exist}
            CANT_HAPPEN_EVENT   {can't happen transition, %s - %s -> %s ==> %s -> CH}
            CONFIG_ERRORS     {encountered %d configuration script errors}
            EMPTY_NAME      {the empty string is not a valid name for a %s}
            BAD_CLASS_NAME      {class names must be begin with an alphanumeric\
                                character, got: "%s"}
            DUP_ELEMENT_NAME    {a class, relationship or domain operation named, "%s",\
                                already exists}
            RESERVED_NAME {names beginning with two underscore characters are reserved,\
                    "%s" cannot be used as a name in this context}
            INT_TYPE_REQUIRED   {attribute must be of "int" type, got "%s"}
            INT_VALUE_REQUIRED  {an integer value is required, got "%s"}
            ARG_FORMAT      {options and values must come in pairs, got "%s"}
            UNKNOWN_OPTION  {unknown %s command option, "%s"}
            DUP_OP_NAME     {operation call, "%s", already exists}
            NS_QUALIFIERS   {name, "%s", contains namespace qualifiers}
            TILDE_NAME {names beginning with the tilde character are not allowed\
                in this context, "%s"}
                
            BAD_RELATIONSHIP_SPEC  {bad relationship specifier, "%s"}
            NEED_ASSOCIATOR {relationship of type, "%s", requires associative class}
            NEED_REFLEXIVE_PATH {traversal path must be specified for reflexive\
                    association, %s, %s %s %s}
            REFLEXIVE_NOT_ALLOWED   {associations of type, "%s", cannot be reflexive}
            TOO_FEW_SUBCLASSES  {at least 2 subclasses must be specified, got %d}
            BAD_CREATION_TARGET {the target of a creation event must be a state,\
                    got "%s"}
            PSEUDO_STATE    {the transition action, "%s", is not valid as %s}
            EXPECTED_PSEUDO_STATE    {expected CH or IG, got "%s"}
            RELVAR_TRACE_OP     {unexpected relvar trace operation, "%s"}
            ATTR_CHECK_FAILED   {check for attribute, "%s", failed:\
                                instance value was, "%s": "%s" evaluated to "%s"}
            UNKNOWN_DOMAIN  {unknown domain, "%s"}
            ARG_MISMATCH      {number of population values must be a multiple of %d, got %d}
            SAVE_ARG_ERROR  {wrong number of arguments: expected:\
                    "save ?-sqlite | -tclral? ?-async <cmdprefix>?\
                    <domain> <filename>", got: "%s"}
            RESTORE_ARG_ERROR  {wrong number of arguments: expected:\
                    "restore ?-sqlite | -tclral?  <domain> <filename>", got: "%s"}
            UNKNOWN_INFO_CMD  {unknown info request, "%s"}
            UNKNOWN_CLASS  {unknown class, "%s", in domain, "%s"}
            UNKNOWN_TRACE_CMD   {unknown trace subcomand, "%s"}
            BAD_TRACEOP     {unknown trace operation, "%s"}
            NO_SAVEFILE     {no save file name provided}
            BAD_TRACETYPE   {unknown trace type, "%s"}
        }]
        proc ToRef {relvar relvalue} {
            tailcall list $relvar [relation project $relvalue\
                {*}[lindex [relvar identifiers $relvar] 0]] ; # <1>
        }
        proc nilInstRef {} {
            return {{} {{} {}}}
        }
        proc CreateStateInstance {domns class state idattrs} {
            tailcall relvar insert ${domns}::${class}__STATEINST\
                    [concat $idattrs [list __State $state]]
        }
        proc CreateInInitialState {domns class idattrs} {
            set initstate [relvar restrictone ${domns}::__Arch_InitialState\
                Class $class]
            if {[relation isnotempty $initstate]} {
                CreateStateInstance $domns $class [relation extract $initstate State]\
                    $idattrs
            }
            return
        }
        proc CreateStateInstanceFromRef {domns class state ref} {
            relation foreach inst [lindex $ref 1] { # <1>
                CreateStateInstance $domns $class $state\
                    [tuple get [relation tuple $inst]]
            }
            return
        }
        proc CreateInInitialStateFromRef {domns class ref} {
            set initstate [relvar restrictone ${domns}::__Arch_InitialState\
                Class $class]
            if {[relation isnotempty $initstate]} {
                CreateStateInstanceFromRef $domns $class\
                    [relation extract $initstate State] $ref
            }
            return
        }
        proc SelfInstRef {{level 2}} {
            set foundRef false
            set ref [nilInstRef]
        
            for {set ns [uplevel $level namespace current]} {$ns ne "::"}\
                    {set ns [uplevel [incr level] namespace current]} {
                if {!$foundRef} {
                    upvar $level self srcself
                    if {[info exists srcself]} {
                        set ref $srcself
                        set foundRef true
                    }
                }
                if {[string match {*__Activity*} $ns]} {
                    return $ref ; # <1>
                }
            }
            return [nilInstRef]
        }
        namespace export DeclError
        
        proc DeclError {errcode args} {
            variable errFormats
            set errmsg [format [dict get $errFormats $errcode] {*}$args]
            tailcall throw [list ROSEA $errcode {*}$args $errmsg] $errmsg
        }
        proc SplitRelvarName {relvar {dvarname domain} {cvarname class}} {
            upvar 1 $dvarname domain $cvarname class
            set domain [namespace qualifiers $relvar]
            set class [namespace tail $relvar]
        }
        proc PropagatePolyEvents {super} {
            namespace upvar ::rosea::Config\
                DeferredEvent DeferredEvent\
                LocalEvent LocalEvent\
                Superclass Superclass\
                Subclass Subclass\
                DeferralPath DeferralPath\
                Generalization Generalization ; # <1>
        
            set supername [relation extract $super Class]
        
            set subs [pipe {
                relation semijoin $super\
                    $Generalization -using {Domain Domain Relationship Name}\
                    $Subclass -using {Domain Domain Name Relationship}
            }]
        
            relation foreach sub $subs {
                set defrdevents [pipe {
                    relation semijoin $super $DeferralPath\
                        -using {Domain Domain Class Model Relationship Relationship}\
                        $DeferredEvent |
                    relation update ~ deftup {1} {
                        tuple update $deftup Model [relation extract $sub Class]
                    }
                }]
                set multigens [relation semijoin $sub $Superclass\
                    -using {Domain Domain Class Class}]
        
                if {[relation isempty $multigens]} {
                    relvar minus ::rosea::Config::LocalEvent $defrdevents
                    relvar union ::rosea::Config::Event $defrdevents
                    relvar union ::rosea::Config::EffectiveEvent $defrdevents
                    relvar union ::rosea::Config::MappedEvent [relation extend\
                        $defrdevents metuple ParentModel string {$supername}]
                } else {
                    set consumed [relation semijoin $defrdevents $LocalEvent]
                    if {[relation isnotempty $consumed]} {
                        relvar minus ::rosea::Config::LocalEvent $consumed ; # <1>
                        relvar union ::rosea::Config::MappedEvent [relation extend\
                            $consumed ctup ParentModel string {$supername}]
                        relvar union ::rosea::Config::NonLocalEvent [relation extend\
                            $consumed nletuple\
                            Relationship string {[relation extract $sub Relationship]}\
                            Role string {[relation extract $sub Role]}]
                        set defrdevents [relation minus $defrdevents $consumed] ; # <2>
                    
                        set usedinsubs [pipe {
                            FindSubclassesOf $multigens|
                            relation tclose ~ |
                            relation semijoin $consumed ~ -using {Model Super} |
                            relation semijoin ~ $LocalEvent -using {Sub Model} |
                            relation semijoin $consumed ~ -using {Domain Domain Event Event}
                        }]
                        relvar minus ::rosea::Config::LocalEvent $usedinsubs ; # <3>
                        relvar minus ::rosea::Config::EffectiveEvent $usedinsubs
                        relvar minus ::rosea::Config::Event $usedinsubs
                    }
                    relvar union ::rosea::Config::Event $defrdevents
                    relvar union ::rosea::Config::DeferredEvent $defrdevents
                    relvar union ::rosea::Config::InheritedEvent $defrdevents
                    relvar union ::rosea::Config::DeferralPath [relation join\
                        $defrdevents $Superclass -using {Domain Domain Model Class}]
                }
        
                relvar union ::rosea::Config::NonLocalEvent [relation extend\
                    $defrdevents nletuple\
                    Relationship string {[relation extract $sub Relationship]}\
                    Role string {[relation extract $sub Role]}]
                relation foreach multigen $multigens {
                    PropagatePolyEvents $multigen
                }
            }
        }
        proc FindSubclassesOf {supers} {
            namespace upvar ::rosea::Config\
                Generalization Generalization\
                Superclass Superclass\
                Subclass Subclass
        
            if {[relation isempty $supers]} {# <1>
                return [relation create {Super string Sub string}]
            }
            set supnames [pipe {
                relation project $supers Class |
                relation rename ~ Class Super
            }] ; # <2>
            set subclasses [relation semijoin $supers\
                    $Generalization -using {Domain Domain Relationship Name}\
                    $Subclass -using {Domain Domain Name Relationship}]
            set subnames [pipe {
                relation project $subclasses Class |
                relation rename ~ Class Sub
            }] ; # <3>
            
            set uses [relation times $supnames $subnames] ; # <4>
        
            set nextsupers [relation semijoin $subclasses $Superclass\
                    -using {Domain Domain Class Class}] ; # <5>
        
            return [relation union $uses [FindSubclassesOf $nextsupers]] ; # <6>
        }
        proc UserDefaultTrace {defheading defvalues op relvar tuple} {
            tuple create\
                [dict merge $defheading [tuple heading $tuple]]\
                [dict merge $defvalues [tuple get $tuple]]
        }
        proc SupplyDefaultTrace {defheading op relvar tuple} {
            set attrs [tuple attributes $tuple] ; # <1>
            SplitRelvarName $relvar domain class ; # <2>
            foreach {attrname attrtype} $defheading {
                if {$attrname ni $attrs} {
                    set value [set ${domain}::__Arch_SuppliedDefault($class,$attrname)] ; # <3>
                    incr ${domain}::__Arch_SuppliedDefault($class,$attrname)
                    set tuple [tuple extend $tuple $attrname $attrtype $value] ; # <4>
                }
            }
            return $tuple
        }
        proc GenerateDefaultTrace {defheading defcmds op relvar tuple} {
            set attrs [tuple attributes $tuple]
            foreach {attrname attrtype} $defheading {
                if {$attrname ni $attrs} {
                    set value [eval [dict get $defcmds $attrname]]
                    set tuple [tuple extend $tuple $attrname $attrtype $value]
                }
            }
            return $tuple
        }
        proc CheckValueTrace {attrchecks op relvar args} {
            if {$op eq "insert"} {
                set tuple [lindex $args 0]
                EvalAttrCheck $attrchecks $tuple
                return $tuple
            } elseif {$op eq "update"} {
                set tuple [lindex $args 1]
                EvalAttrCheck $attrchecks $tuple
                return $tuple
            } elseif {$op eq "set"} {
                set relvalue [lindex $args 0]
                relation foreach inst $relvalue {
                    set tuple [relation tuple $inst]
                    EvalAttrCheck $attrchecks $tuple
                }
                return $relvalue
            } else {
                tailcall DeclError RELVAR_TRACE_OP $op
            }
        }
        proc EvalAttrCheck {attrchecks tuple} {
            dict for {attrname checkexpr} $attrchecks {
                tuple assign $tuple
                set result [expr $checkexpr]
                if {!$result} {
                    tailcall DeclError ATTR_CHECK_FAILED $attrname [tuple get $tuple]\
                        $checkexpr $result
                }
            }
        }
        proc QuerySystemOperations {which requiresSM} {
            return [pipe {
                relvar set ::rosea::Config::SuppliedOperation |
                relation restrictwith ~ {$RequiresStateModel == $requiresSM} |
                relation join [relvar set ::rosea::Config::$which] ~
            }]
        }
        proc QuerySystemClassOperations {className requiresSM} {
            return [pipe {
                QuerySystemOperations SystemClassOperation $requiresSM |
                relation update ~ sco 1 {
                    tuple update $sco Command\
                        [concat [tuple extract $sco Command]\
                        [list $className]]
                } |
                relation dict ~ Name Command
            }]
        }
        proc QuerySystemInstanceOperations {requiresSM} {
            return [pipe {
                QuerySystemOperations SystemInstanceOperation $requiresSM |
                relation dict ~ Name Command
            }]
        }
        proc Interleave {l1 l2} {
            set result [list]
            foreach a $l1 b $l2 {
                lappend result $a $b
            }
            return $result
        }
        proc MapCondMultToConstraint {cond mult} {
            if {$cond} {
                return [expr {$mult ? "*" : "?"}]
            } else {
                return [expr {$mult ? "+" : "1"}]
            }
        }
    }
    namespace eval ClassCmds {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [namespace parent]::Helpers ; # <1>
        proc findAll {relvar} {
            tailcall ToRef $relvar [relvar set $relvar]
        }
        proc findById {relvar args} {
            tailcall ToRef $relvar [relvar restrictone $relvar {*}$args]
        }
        proc findWhere {relvar expr} {
            tailcall ToRef $relvar [uplevel 1 [list ::ral relation restrictwith\
                [relvar set $relvar] $expr]]
        }
        proc create {relvar args} {
            if {[llength $args] % 2 != 0} {
                tailcall DeclError ARG_FORMAT $args
            }
            set ref [ToRef $relvar [relvar insert $relvar $args]] ; # <1>
            SplitRelvarName $relvar domain class
            CreateInInitialStateFromRef $domain $class $ref
            return $ref
        }
        proc createin {relvar state args} {
            if {[llength $args] % 2 != 0} {
                tailcall DeclError ARG_FORMAT $args
            }
            SplitRelvarName $relvar domain class
            set initstate [relvar restrictone ${domain}::__Arch_State\
                Class $class State $state]
            if {[relation isempty $initstate]} { # <1>
                tailcall DeclError UNKNOWN_STATE $state $relvar
            }
            set ref [ToRef $relvar [relvar insert $relvar $args]]
            CreateStateInstanceFromRef $domain $class $state $ref
            return $ref
        }
        proc createasync {relvar event eventparams args} {
            SplitRelvarName $relvar domain class
        
            if {[relation isempty [relvar restrictone ${domain}::__Arch_Event\
                    Class $class Event $event]]} {
                tailcall DeclError UNKNOWN_EVENT $event $class
            }
            if {[relation isempty [relvar restrictone ${domain}::__Arch_State\
                    Class $class State @]]} {
                tailcall DeclError NO_CREATION_EVENTS $class
            }
            set srcref [SelfInstRef]
            set eventInfo [dict create\
                type creation\
                src $srcref\
                dstClass $relvar\
                dstAttrs $args\
                event $event\
                params $eventparams\
            ]
            if {[::rosea::InstCmds::isRefEqual $srcref [nilInstRef]]} {
                lappend ::rosea::Dispatch::toc_queue $eventInfo
            } else {
                lappend ::rosea::Dispatch::event_queue $eventInfo
            }
            ::after 0 ::rosea::Dispatch::DispatchEvent
            return
        }
        proc update {relvar relvalue} {
            tailcall ToRef $relvar [relvar updateper $relvar $relvalue]
        }
    }
    namespace eval InstCmds {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace path [namespace parent]::Helpers
        pipe {
            relvar set ${domain}::$DstClass |
            relation $op $related ~ -using $Attrs
        } relatedQuery
        proc deRef {instref args} {
            lassign $instref relvar ref
            set inst [relation semijoin $ref [relvar set $relvar]] ; # <1>
            if {[llength $args] != 0} {
                set inst [relation project $inst\
                    {*}[relation attributes $ref] {*}$args] ; # <2>
            }
            return $inst
        }
        proc isEmptyRef {instref} {
            tailcall relation isempty [lindex $instref 1]
        }
        proc isNotEmptyRef {instref} {
            tailcall relation isnotempty [lindex $instref 1]
        }
        proc refMultiplicity {instref} {
            tailcall relation cardinality [lindex $instref 1]
        }
        proc isRefSingular {instref} {
            expr {[refMultiplicity $instref] == 1}
        }
        proc limitRef {instref {count 1}} {
            lassign $instref relvar insts
            return [pipe {
                relation tag $insts __Tag |
                relation restrictwith ~ {$__Tag >= 0 && $__Tag < $count} |
                ToRef $relvar ~
            }]
        }
        proc isRefEqual {instref1 instref2} {
            lassign $instref1 relvar1 inst1
            lassign $instref2 relvar2 inst2
            return [expr {$relvar1 eq $relvar2 && [relation is $inst1 equal $inst2]}]
        }
        proc RefSetCommand {op instref1 instref2} {
            lassign $instref1 relvar1 inst1
            lassign $instref2 relvar2 inst2
            if {$relvar1 ne $relvar2} {
                tailcall DeclError SAME_CLASS $relvar1 $relvar2
            }
            return [list $relvar1 [relation $op $inst1 $inst2]]
        }
        proc refUnion {instref1 instref2} {
            tailcall RefSetCommand union $instref1 $instref2
        }
        proc refIntersect {instref1 instref2} {
            tailcall RefSetCommand intersect $instref1 $instref2
        }
        proc refMinus {instref1 instref2} {
            tailcall RefSetCommand minus $instref1 $instref2
        }
        proc forAllRefs {varname instref body} {
            lassign $instref relvar refs
            upvar 1 $varname inst
            relation foreach ref $refs {
                set inst [list $relvar $ref]
                uplevel 1 $body
            } ; # <1>
            return
        }
        proc FindRelatedInsts {instref op args} {
            set srcrelvar [lindex $instref 0]
            SplitRelvarName $srcrelvar domain class
            
            # This procedure queries the architectural data about relationship linkage,
            # so we bring the relvar variables into scope.
            namespace upvar ${domain}\
                    __Arch_Link Link\
                    __Arch_AssociationLink AssociationLink\
                    __Arch_PartitionLink PartitionLink\
                    __Arch_PartitionDst PartitionDst
            variable relatedQuery ; # <1>
            # We start by dereferencing the instance reference.
            set related [deRef $instref]
            foreach linkage $args {
                lassign $linkage lname dst ; # split out the linkage spec
                
                set link [relvar restrictone ${domain}::__Arch_Link\
                        Name $lname SrcClass $class]
                if {[ral relation isempty $link]} {
                    tailcall DeclError UNKNOWN_LINKAGE $lname $class
                }
                # First we determine if we are dealing with an associative link or a
                # partition link.
                set assoc [relation join $link $AssociationLink]
                if {[relation isnotempty $assoc]} {
                    relation assign $assoc DstClass Attrs
                    # Check if additional path information was provided.
                    if {$dst eq {}} {
                        # Find the set of instances related to the current set.
                        set related [eval $relatedQuery]
                        # We must see if this is a class-based association.  If so, then the first
                        # traversal was to the associator and we must traverse again to the other
                        # class.
                        set assoc [relation semijoin $assoc $AssociationLink\
                            -using {Name Name SrcClass PrevSrcClass}]
                        if {[relation isnotempty $assoc]} {
                            relation assign $assoc DstClass Attrs
                            set related [pipe {# <1>
                                relvar set ${domain}::$DstClass |
                                relation semijoin $related ~ -using $Attrs
                            }]
                        }
                    } else {
                        # If a destination was specified in the linkage, then we need to verify
                        # that it is actually part of the relationship.
                        if {$dst ne $DstClass} {
                            tailcall DeclError PATH_ERROR $lname $class $DstClass\
                                $dst
                        }
                        set related [eval $relatedQuery]
                    }
                } else {
                    set partdst [relvar restrictone ${domain}::__Arch_PartitionDst\
                        Name $lname SrcClass $class DstClass $dst]
                    if {[relation isempty $partdst]} {
                        tailcall DeclError GEN_PATH_ERROR $class $lname $dst
                    }
                    relation assign $partdst DstClass Attrs
                    set related [eval $relatedQuery]
                }
                # Continue the iteration by setting the next source to the current
                # destination class.
                set class $DstClass
                set srcrelvar ${domain}::$class
            }
            # N.B. that we are not returning an instance reference but rather the
            # complete relation value of the related instances. This allows us
            # to further filter the result in the "findRelatedWhere" command.
            return [list $srcrelvar $related]
        }
        proc findRelated {instref args} {
            tailcall ToRef {*}[FindRelatedInsts $instref semijoin {*}$args] ; # <1>
        }
        proc findUnrelated {instref args} {
            tailcall ToRef {*}[FindRelatedInsts $instref semiminus {*}$args] ; # <1>
        }
        proc findRelatedWhere {instref rchain expr} {
            lassign [FindRelatedInsts $instref semijoin {*}$rchain] relvar insts
            tailcall ToRef $relvar [uplevel 1\
                [list ::ral relation restrictwith $insts $expr]] ; # <1>
        }
        proc findUnrelatedWhere {instref rchain expr} {
            lassign [FindRelatedInsts $instref semiminus {*}$rchain] relvar insts
            tailcall ToRef $relvar [uplevel 1\
                [list ::ral relation restrictwith $insts $expr]]
        }
        proc idInstance {instref} {
            lassign $instref relvar insts
            SplitRelvarName $relvar domain relationship
            set assignrelvar ${domain}::${relationship}__STATEINST
            if {![relvar exists $assignrelvar]} {
                tailcall DeclError NO_ASSIGNER $rname
            }
        
            set idclass [pipe {
                relvar restrictone [namespace parent]::Config::MultipleAssigner\
                        Domain [string trim $domain :] Relationship $relationship |
                relation extract ~ Class
            }]
        
            return [pipe {
                relvar set ${domain}::$idclass |
                relation semijoin $insts ~ |
                ToRef ${domain}::$idclass ~
            }]
        }
        proc updateAttribute {instref args} {
            if {[llength $args] % 2 != 0} {
                tailcall DeclError ARG_ERROR $args
            }
            
            lassign $instref relvar insts
            if {[relation cardinality $insts] != 1} {
                tailcall MUST_BE_SINGULAR $relvar [relation cardinality $insts]
            }
            set idattrs [list]
            foreach identifier [relvar identifiers $relvar] {
                ::struct::set add idattrs $identifier
            }
            set idupdates [::struct::set intersect $idattrs $args]
            if {![::struct::set empty $idupdates]} {
                tailcall DeclError ID_UPDATE [join $idupdates {, }]
            }
            set extcmd [list relation extend $insts exttuple]
            set heading [relation heading [relvar set $relvar]]
            foreach {attr value} $args {
                if {![dict exists $heading $attr]} {
                    tailcall DeclError UNKNOWN_ATTRIBUTE $attr
                }
                lappend extcmd $attr [dict get $heading $attr] \{$value\}
            }
            relvar updateper $relvar [eval $extcmd]
            return
        }
        proc withAttribute {instref args} {
            if {[llength $args] < 2} {
                tailcall DeclError WITH_ATTR_USAGE
            }
            
            lassign $instref relvar insts
            if {[relation cardinality $insts] != 1} {
                tailcall MUST_BE_SINGULAR $relvar [relation cardinality $insts]
            }
            
            set body [lindex $args end]
            set attrspecs [lrange $args 0 end-1]
            set attrnames [list]
            set varnames [list]
            foreach attrspec $attrspecs {
                set speclen [llength $attrspec]
                if {$speclen == 1} {
                    lappend attrnames [lindex $attrspec 0]
                    lappend varnames [lindex $attrspec 0]
                } elseif {$speclen == 2} {
                    lappend attrnames [lindex $attrspec 0]
                    lappend varnames [lindex $attrspec 1]
                } else {
                    tailcall DeclError ATTR_VAR_SPEC $attrspec
                }
            }
            set idattrs [list]
            foreach identifier [relvar identifiers $relvar] {
                ::struct::set add idattrs $identifier
            }
            set idupdates [::struct::set intersect $idattrs $attrnames]
            if {![::struct::set empty $idupdates]} {
                tailcall DeclError ID_UPDATE [join $idupdates {, }]
            }
            uplevel 1 [list ral relation assign [deRef $instref] {*}$attrspecs]
            uplevel 1 $body
            set extcmd [list relation extend $insts exttuple]
            set heading [relation heading [relvar set $relvar]]
            foreach attr $attrnames var $varnames {
                if {[uplevel 1 [list info exists $var]]} {
                    upvar 1 $var varvalue
                    lappend extcmd $attr [dict get $heading $attr] \{$varvalue\}
                }
            }
            relvar updateper $relvar [eval $extcmd]
        
            return
        }
        proc readAttribute {ref args} {
            # We insist upon a singular reference for reading attributes.  Multiple
            # references can be handled by dereferences and using TclRAL "relation"
            # commands.
            if {![isRefSingular $ref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $ref]
            }
        
            return [expr {[llength $args] == 0 ? {} :\
                [relation extract [deRef $ref {*}$args] {*}$args]}] ; # <1>
        }
        proc assignAttribute {ref args} {
            # We must insist upon a singular references, since assigning to scalar
            # variables from a relation value doesn't make a lot of sense.
            if {![isRefSingular $ref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $ref]
            }
        
            uplevel 1 [list ral relation assign [deRef $ref] {*}$args] ; # <1>
            return
        }
        proc delete {args} {
            foreach instref $args {
                lassign $instref relvar insts
                relvar minus $relvar [deRef $instref]
        
                SplitRelvarName $relvar domain class
                set instrelvar ${domain}::${class}__STATEINST
                if {[relvar exists $instrelvar]} {
                    relvar minus $instrelvar [relation semijoin $insts\
                        [relvar set $instrelvar]]
                }
            }
        
            return
        }
        proc signal {dstset event args} {
            set srcref [SelfInstRef]
            if {![::rosea::Dispatch::MapPolymorphicEvent ::rosea::Dispatch::SignalEvent\
                    $srcref $dstset $event $args]} {
                ::rosea::Dispatch::SignalEvent $srcref $dstset $event $args
            }
            return
        }
        proc delaysignal {time dstset event args} {
            if {!([string is integer -strict $time] && $time >= 0)} {
                tailcall DeclError INVALID_TIME $time
            }
            set srcref [SelfInstRef]
            if {![::rosea::Dispatch::MapPolymorphicEvent\
                    [list ::rosea::Dispatch::SignalDelayedEvent $time]\
                    $srcref $dstset $event $args]} {
                ::rosea::Dispatch::SignalDelayedEvent $time $srcref $dstset $event $args
            }
            return
        }
        proc canceldelayed {srcref dstset event} {
            set srcmult [refMultiplicity $srcref]
            if {$srcmult > 1} {
                tailcall DeclError SINGLE_OR_EMPTY_REF_REQUIRED $srcmult
            }
            forAllRefs dstref $dstset {
                ::rosea::Dispatch::CancelDelayedSignal $srcref $event $dstref
            }
            return
        }
        proc delayremaining {srcref dstref event} {
            set srcmult [refMultiplicity $srcref]
            if {$srcmult > 1} {
                tailcall DeclError SINGLE_OR_EMPTY_REF_REQUIRED $srcmult
            }
            if {![isRefSingular $dstref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $dstref]
            }
            tailcall ::rosea::Dispatch::SignalTimeRemaining $srcref $event $dstref
        }
        proc instop {instref op args} {
            tailcall [lindex $instref 0]::Instance $instref $op {*}$args
        }
    }
    namespace eval RelCmds {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [list\
            [namespace parent]::Helpers\
            [namespace parent]::InstCmds\
        ]
        proc linkSimple {rname instref1 instref2} {
            lassign $instref1 relvar1 inst1
            SplitRelvarName $relvar1 domain1 class1
            
            lassign $instref2 relvar2 inst2
            SplitRelvarName $relvar2 domain2 class2
            
            if {$domain1 ne $domain2} {
                tailcall DeclError NO_CROSS_DOMAIN $domain1 $domain2
            }
            set reflink [relvar restrictone ${domain1}::__Arch_RefLink Relationship $rname]
            if {[relation isempty $reflink]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            relation assign $reflink\
                {ReferringClass referringClass}\
                {ReferencedClass referencedClass}\
                {ReferringAttrs referringAttrs} ; # <1>
            if {$class1 eq $referringClass && $class2 eq $referencedClass} {
                set fromrelvar $relvar1
                set frominsts $inst1
                set torelvar $relvar2
                set toinst $inst2
            } elseif {$class2 eq $referringClass && $class1 eq $referencedClass} {
                set fromrelvar $relvar2
                set frominsts $inst2
                set torelvar $relvar1
                set toinst $inst1
            } else {
                tailcall DeclError NON_PARTICIPANTS $relvar1 $relvar2 $rname\
                    $referringClass $referencedClass
            }
            if {[relation cardinality $toinst] != 1} {
                tailcall MUST_BE_SINGULAR $torelvar [relation cardinality $toinst]
            }
            set refedvalue [relation semijoin $toinst [relvar set $torelvar]]
            set tovalues [pipe {
                relation extend $referringAttrs rfa RefValue string {
                    [relation extract $refedvalue\
                        [tuple extract $rfa ReferencedAttribute]]} |
                relation dict ~ ReferringAttribute RefValue
            }]
            relation foreach frominst $frominsts {
                relvar updateone $fromrelvar fromtup\
                        [tuple get [relation tuple $frominst]] { # <1>
                    tuple update $fromtup {*}$tovalues ; # <2>
                }
            }
        
            return
        }
        proc linkAssoc {rname instref1 instref2 args} {
            lassign $instref1 relvar1 inst1
            SplitRelvarName $relvar1 domain1 class1
            
            lassign $instref2 relvar2 inst2
            SplitRelvarName $relvar2 domain2 class2
            
            if {$domain1 ne $domain2} {
                tailcall DeclError NO_CROSS_DOMAIN $domain1 $domain2
            }
            set assocref [relvar restrictone ${domain1}::__Arch_AssocRef\
                    Relationship $rname]
            if {[relation isempty $assocref]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            
            relation assign $assocref\
                {AssocClass assocClass}\
                {References references}
            set ref1 [relation restrictwith $references {$Participant eq $class1}]
            if {[relation isempty $ref1]} {
                tailcall DeclError NOT_IN_ASSOCIATION $class1 $rname
            }
            if {[relation cardinality $ref1] > 1} {
                set ref2 [relation restrictwith $ref1 {$Role eq "target"}]
                set ref1 [relation minus $ref1 $ref2] ; # <1>
            } else {
                set ref2 [relation restrictwith $references {$Participant eq $class2}]
                if {[relation isempty $ref2]} {
                    tailcall DeclError NOT_IN_ASSOCIATION $class2 $rname
                }
            }
            
            set rattr1 [relation extract $ref1 ReferringAttrs]
            set rattr2 [relation extract $ref2 ReferringAttrs]
            set values1 [relation semijoin $inst1 [relvar set $relvar1]]
            set values2 [relation semijoin $inst2 [relvar set $relvar2]]
            set assoctuples [list]
            relation foreach v1 $values1 { # <1>
                set refto1 [pipe {
                    relation extend $rattr1 rfa RefValue string {
                        [relation extract $v1 [tuple extract $rfa ReferencedAttribute]]
                    } |
                    relation dict ~ ReferringAttribute RefValue
                }]
                relation foreach v2 $values2 {
                    set refto2 [pipe {
                        relation extend $rattr2 rfa RefValue string {
                            [relation extract $v2\
                                [tuple extract $rfa ReferencedAttribute]]
                        } |
                        relation dict ~ ReferringAttribute RefValue
                    }]
            
                    lappend assoctuples [dict merge $args $refto1 $refto2] ; # <2>
                }
            }
            set ref [ToRef ${domain1}::$assocClass\
                    [relvar insert ${domain1}::$assocClass {*}$assoctuples]]
                CreateInInitialStateFromRef $domain1 $assocClass $ref ; # <1>
            return $ref
        }
        proc referenceAssoc {rname assocref instref {dir {}}} {
            if {![isRefSingular $assocref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $assocref]
            }
            lassign $assocref assocrelvar associnst
            SplitRelvarName $assocrelvar assocdomain assocclass
            
            if {![isRefSingular $instref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $instref]
            }
            lassign $instref instrelvar inst
            SplitRelvarName $instrelvar instdomain instclass
            
            if {$assocdomain ne $instdomain} {
                tailcall DeclError NO_CROSS_DOMAIN $domain1 $domain2
            }
            set assocref [relvar restrictone ${instdomain}::__Arch_AssocRef\
                    Relationship $rname]
            if {[relation isempty $assocref]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            
            relation assign $assocref\
                {AssocClass assocClass}\
                {References references}
            
            if {$assocClass ne $assocclass} {
                tailcall DeclError NOT_IN_ASSOCIATION $assocclass $rname
            }
            set ref [relation restrictwith $references {$Participant eq $instclass}]
            set refcard [relation cardinality $ref]
            if {$refcard == 2} {
                switch -exact -- $dir {
                    forward {
                        set role target
                    }
                    backward {
                        set role source
                    }
                    default {
                        tailcall DeclError DIRECTION_REQUIRED $dir
                    }
                }
                set ref [relation restrictwith $ref {$Role eq $role}]
            } elseif {$refcard == 0} {
                tailcall DeclError NOT_IN_ASSOCIATION $instclass $rname
            }
            set referringAttrs [relation extract $ref ReferringAttrs]
            
            set refedvalue [relation semijoin $inst [relvar set $instrelvar]]
            
            set tovalues [pipe {
                relation extend $referringAttrs rfa RefValue string {
                    [relation extract $refedvalue\
                        [tuple extract $rfa ReferencedAttribute]]} |
                relation dict ~ ReferringAttribute RefValue
            }]
            relvar updateone $assocrelvar assoctup [tuple get [relation tuple $associnst]] {
                tuple update $assoctup {*}$tovalues
            }
        }
        proc unlinkSimple {rname instref} {
            lassign $instref relvar inst
            SplitRelvarName $relvar domain class
        
            set reflink [relvar restrictone ${domain}::__Arch_RefLink\
                    Relationship $rname]
            if {[relation isempty $reflink]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            relation assign $reflink\
                {ReferringClass referringClass}\
                {ReferencedClass referencedClass}\
                {ReferringAttrs referringAttrs}
        
            if {$class eq $referringClass} {
                set fromrelvar $relvar
                set frominsts $inst
            } elseif {$class eq $referencedClass} {
                lassign [::rosea::InstCmds::findRelated $instref ~$rname]\
                    fromrelvar frominsts
            } else {
                tailcall DeclError NOT_IN_ASSOCIATION $relvar $rname
            }
        
            set tovalues [pipe {
                relation extend $referringAttrs rfa RefValue string {{}} |
                relation dict ~ ReferringAttribute RefValue
            }]
        
            relation foreach frominst $frominsts {
                relvar updateone $fromrelvar fromtup\
                        [tuple get [relation tuple $frominst]] {
                    tuple update $fromtup {*}$tovalues
                }
            }
        
            return
        }
        proc unlinkAssoc {rname instref} {
            lassign $instref relvar insts
            SplitRelvarName $relvar domain class
        
            set assocref [relvar restrictone ${domain}::__Arch_AssocRef\
                    Relationship $rname]
            if {[relation isempty $assocref]} {
                tailcall DeclError UNKNOWN_RELATIONSHIP $rname
            }
            relation assign $assocref\
                {Relationship relationship}\
                {AssocClass associator}\
                {References references}
        
            # If we are given instances to the associator class, then there is no
            # more work to do.
            if {$class ne $associator} {
                # Otherwise, we have to find the associator class instances ourselves.
                set part [relation restrictwith $references {$Participant eq $class}]
                set partcard [relation cardinality $part]
                if {$partcard == 0} {
                    tailcall DeclError NOT_IN_ASSOCIATION $class $rname
                } elseif {$partcard > 1} {
                    tailcall DeclError AMBIGUOUS_UNLINK $rname $relvar ; # <1>
                } else {
                    # Find associative class instances.  We have to determine the
                    # direction of the relationship traversal.
                    set navdir [expr {[relation extract $part Role] eq "source" ?\
                        "$relationship" : "~$relationship"}]
                    set instref [::rosea::InstCmds::findRelated $instref\
                        [list $navdir [namespace tail $associator]]]
                    lassign $instref relvar insts
                    SplitRelvarName $relvar domain class
                }
            }
        
            # We are going to delete tuples from the relvar that holds the class
            # instances.
            set delrelvars [list ${domain}::$class]
            # If the associative class also has a state model, then we need to also
            # delete the state instance tuples.
            if {[relvar exists ${domain}::${class}__STATEINST]} {
                lappend delrelvars ${domain}::${class}__STATEINST
            }
        
            # Now, we iterate across the associative class instances and delete all the
            # tuples in class relvar and, if necessary, the state instances.
            relation foreach inst $insts {
                set idattrs [tuple get [relation tuple $inst]]
                foreach rv $delrelvars {
                    relvar deleteone $rv {*}$idattrs
                }
            }
            return $instref
        }
        proc migrate {rname instref subclass args} {
            if {![isRefSingular $instref]} {
                tailcall DeclError SINGLE_REF_REQUIRED [refMultiplicity $instref]
            }
            lassign $instref relvar inst
            SplitRelvarName $relvar domns class
        
            set link [relvar restrictone ${domns}::__Arch_AssociationLink Name $rname\
                    SrcClass $class]
            if {[relation isempty $link]} {
                tailcall DeclError NO_SUBCLASS $rname $relvar
            }
        
            # Traverse the relationship to the superclass. We need to get the values of
            # the referenced attributes to use in creating the new subclass instance.
            set superinst [pipe {
                relvar set ${domns}::[relation extract $link DstClass] |
                relation semijoin $inst ~ -using [relation extract $link Attrs]
            }]
        
            set sublink [relvar restrictone ${domns}::__Arch_SubLink\
                    Relationship $rname SubClass $subclass]
            if {[relation isempty $sublink]} {
                tailcall DeclError NO_SUBCLASS $rname $subclass
            }
        
            # Using the same relation extend strategy, we compute a dictionary of the
            # attribute names / values as they must appear in the subclass we are about
            # to create.
            set refedvalues [pipe {
                relation extract $sublink ReferringAttrs |
                relation extend ~ rval Value string {
                    [relation extract $superinst\
                        [tuple extract $rval ReferencedAttribute]]
                } |
                relation dict ~ ReferringAttribute Value
            }]
        
            # We use the class commands to delete the old subclass instance and create
            # the new one. This will make sure that if the subclass has a state model
            # that the initial state is set correctly.
            # N.B. this is _not_ done in a relvar transaction. The transaction
            # boundaries should be set by the current thread of control or domain
            # operation.
            ::rosea::InstCmds::delete $instref
            return [::rosea::ClassCmds::create ${domns}::$subclass\
                    {*}[dict merge $args $refedvalues]]
        }
        proc signalAssigner {rname event args} {
            SplitRelvarName $rname domain relationship
            set assignrelvar ${domain}::${relationship}__STATEINST
            if {![relvar exists $assignrelvar]} {
                tailcall DeclError NO_ASSIGNER $rname
            }
        
            set dstref [pipe {
                relvar set $assignrelvar |
                relation project ~ {*}[lindex [relvar identifiers $assignrelvar] 0] |
                list $rname ~
            }]
            ::rosea::Dispatch::SignalEvent [SelfInstRef] $dstref $event $args
        
            return
        }
        proc signalMultiAssigner {rname idvalues event args} {
            SplitRelvarName $rname domain relationship
            set assignrelvar ${domain}::${relationship}__STATEINST
            if {![relvar exists $assignrelvar]} {
                tailcall DeclError NO_ASSIGNER $rname
            }
            set idattrs [lindex [relvar identifiers $assignrelvar] 0]
            # We will insist that the idvalues contain the necessary identifying
            # attributes.
            if {![struct::set equal [dict keys $idvalues] $idattrs]} {
                tailcall DeclError NO_IDENTIFIER [dict keys $idvalues] $idattrs
            }
            set assigninsts [relvar set $assignrelvar]
            set assignrefs [relation project $assigninsts {*}$idattrs]
        
            # We need to find the tuple in "assignrefs" that matches the attributes and
            # values in "idvalues". We will do this by creating a relation value from
            # the idvalues list and semijoining that to "assignrefs". If we come up
            # non-empty, then we have found our multi-assigner instance.
            set heading [relation heading $assignrefs]
            set dstinst [pipe {
                tuple create $heading $idvalues |
                tuple relation ~ |
                relation semijoin ~ $assignrefs
            }]
            if {[relation isempty $dstinst]} {
                tailcall DeclError UNKNOWN_ASSIGNER $idvalues $rname
            }
        
            set dstref [list $rname $dstinst]
            ::rosea::Dispatch::SignalEvent [SelfInstRef] $dstref $event $args ; # <1>
        
            return
        }
        proc createMultiAssigner {rname args} {
            if {[llength $args] % 2 != 0} {
                tailcall DeclError ARG_FORMAT $args
            }
            SplitRelvarName $rname domain relationship
            set assignrelvar ${domain}::${relationship}__STATEINST
            if {![relvar exists $assignrelvar]} {
                tailcall DeclError NO_ASSIGNER $rname
            }
            set idattrs [lindex [relvar identifiers $assignrelvar] 0]
            if {![struct::set equal [dict keys $args] $idattrs]} {
                tailcall DeclError NO_IDENTIFIER [dict keys $args] $idattrs
            }
            CreateInInitialState $domain $relationship $args
        }
    }
    namespace eval Dispatch {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [list\
            [namespace parent]::Helpers\
            [namespace parent]::InstCmds\
        ]
        variable toc_queue [list]
        variable event_queue [list]
        pipe {
            relvar restrictone ${domain}::__Arch_Transition\
                Class $class State $currstate Event $event |
            relation extract ~ NewState
        } transitionQuery
        relvar create DelayedSignal {
            RefId           int
            SrcInstRef      list
            Event           string
            DstInstRef      list
            TimerId         string
            Expire          bignum
        } RefId {SrcInstRef Event DstInstRef} TimerId
        variable DelayedSignalId 0
        pipe {
            relvar set ${domain}::__Arch_PartitionDst |
            relation restrictwith ~ {$SrcClass eq $dstclass} |
            relation group ~ DstLinks DstClass Attrs
        } polymapQuery
        proc SignalEvent {srcref dstset event arglist} {
            lassign $dstset relvar insts
            SplitRelvarName $relvar domain class
            if {[relation isempty [relvar restrictone ${domain}::__Arch_Event\
                    Class $class Event $event]]} {
                tailcall DeclError UNKNOWN_EVENT $event $class
            }
        
            set callback [namespace code DispatchEvent]
            set eventInfo [dict create\
                type ordinary\
                src $srcref\
                event $event\
                params $arglist\
            ]
            if {[isRefEqual $srcref [nilInstRef]]} {
                variable toc_queue
                forAllRefs dstref $dstset {
                    # Queue the thread of control events.
                    dict set eventInfo dst $dstref
                    lappend toc_queue $eventInfo
                    ::after 0 $callback
                }
            } else {
                variable event_queue
                forAllRefs dstref $dstset {
                    dict set eventInfo dst $dstref
                    if {[isRefEqual $srcref $dstref]} { # <1>
                        for {set eqindex 0} {$eqindex < [llength $event_queue]} {incr eqindex} {
                            set cmpevent [lindex $event_queue $eqindex]
                            if {![isRefEqual [dict get $cmpevent src] [dict get $cmpevent dst]]} {
                                break
                            }
                        }
                        set event_queue [linsert [K $event_queue [set event_queue {}]]\
                                $eqindex $eventInfo] ; # <1>
                    } else {
                        # Non-self directed events are always simply appended to the
                        # event queue.
                        lappend event_queue $eventInfo
                    }
                    ::after 0 $callback
                }
            }
        }
        proc DispatchEvent {} {
            variable event_queue
            variable toc_queue
            
            if {[llength $event_queue] != 0} {
                set eventInfo [lindex $event_queue 0]
                set event_queue [lrange [K $event_queue [set event_queue {}]] 1 end] ; # <1>
            } elseif {[llength $toc_queue] != 0} {
                set eventInfo [lindex $toc_queue 0]
                set toc_queue [lrange [K $toc_queue [set toc_queue {}]] 1 end]
                relvar transaction begin ; # <2>
            } else {
                return
            }
            if {[dict get $eventInfo type] eq "creation"} {
                try {
                    set dstref [::rosea::ClassCmds::createin\
                            [dict get $eventInfo dstClass] @\
                            {*}[dict get $eventInfo dstAttrs]] ; # <1>
                } on error {result} {
                    catch {
                        if {[llength $event_queue] == 0} {
                            relvar transaction end
                        }
                    }
                    tailcall DeclError ASYNC_CREATION_FAILED [dict get $eventInfo dstClass]\
                        [dict get $eventInfo dstAttrs] $result
                }
                dict set eventInfo dst $dstref ; # <2>
                ::rosea::Trace::TraceCreation [dict get $eventInfo src]\
                    [dict get $eventInfo event] $dstref [dict get $eventInfo params]
            }
            set dstref [dict get $eventInfo dst]
            lassign $dstref relvar ref
            SplitRelvarName $relvar domain class
            
            set instrelvar ${domain}::${class}__STATEINST
            set state [relation semijoin $ref [relvar set $instrelvar]]
            if {[relation isempty $state]} {
                tailcall DeclError EVENT_IN_FLIGHT [dict get $eventInfo event] $ref
            }
            set currstate [relation extract $state __State]
            set event [dict get $eventInfo event]
            variable transitionQuery
            set newState [eval $transitionQuery]
            
            ::rosea::Trace::TraceTransition [dict get $eventInfo src]\
                $event $dstref $currstate $newState [dict get $eventInfo params] ; # <1>
            try {
                if {$newState eq "CH"} {
                    TransitionError [dict get $eventInfo src] $event $dstref $currstate
                } elseif {$newState ne "IG"} {
                    set idattrs [tuple get [relation tuple $ref]]
                    relvar updateone $instrelvar is $idattrs {
                        tuple update $is __State $newState
                    }
                    try {
                        ${relvar}::__Activity::$newState $dstref\
                                {*}[dict get $eventInfo params] ; # <1>
                    } on error {result opts} {
                        return -options $opts $result
                    } finally {
                        set term [relvar restrictone ${domain}::__Arch_TerminalState\
                                Class $class State $newState]
                        if {[relation isnotempty $term]} {
                            relvar deleteone $relvar {*}$idattrs
                            relvar deleteone $instrelvar {*}$idattrs
                        }
                    }
                }
            } on error {result opts} {
                catch {
                    if {[llength $event_queue] == 0} {
                        relvar transaction end
                    }
                } ; # <1>
                return -options $opts $result
            }
            
            if {[llength $event_queue] == 0} {
                relvar transaction end
            }
            return
        }
        proc TransitionError {src event dst currstate} {
            tailcall DeclError CANT_HAPPEN_EVENT $src $event $dst $currstate
        }
        proc FindDelayedSignal {srcref event dstref} {
            variable DelayedSignal
            return [relation restrictwith $DelayedSignal {
                    [isRefEqual $SrcInstRef $srcref] && $Event eq $event &&\
                    [isRefEqual $DstInstRef $dstref]}]
        }
        proc DeleteDelayedSignal {srcref event dstref} {
            relvar delete DelayedSignal dsig {
                [isRefEqual [tuple extract $dsig SrcInstRef] $srcref] &&\
                [tuple extract $dsig Event] eq $event &&\
                [isRefEqual [tuple extract $dsig DstInstRef] $dstref]
            }
        }
        proc SignalDelayedEvent {time srcref dstset event arglist} {
            lassign $dstset relvar insts
            SplitRelvarName $relvar domain class
            if {[relation isempty [relvar restrictone ${domain}::__Arch_Event\
                    Class $class Event $event]]} {
                tailcall DeclError UNKNOWN_EVENT $event $class
            }
        
            variable DelayedSignalId
            set eventInfo [dict create\
                id [incr DelayedSignalId]\
                type ordinary\
                src $srcref\
                event $event\
                params $arglist\
            ]
            forAllRefs dstref $dstset {
                dict set eventInfo dst $dstref
                DeleteDelayedSignal $srcref $event $dstref ; # <1>
                relvar insert DelayedSignal [list\
                    RefId       $DelayedSignalId\
                    SrcInstRef  $srcref\
                    Event       $event\
                    DstInstRef  $dstref\
                    TimerId     [::after $time [list\
                                ::rosea::Dispatch::DispatchDelayedEvent $eventInfo]]\
                    Expire      [expr {entier([clock milliseconds]) + entier($time)}]\
                ]
            }
            return
        }
        proc DispatchDelayedEvent {eventInfo} {
            relvar deleteone DelayedSignal RefId [dict get $eventInfo id]
            variable toc_queue
            lappend toc_queue $eventInfo
            tailcall DispatchEvent
        }
        proc CancelDelayedSignal {srcref event dstref} {
            variable DelayedSignal
            set sig [FindDelayedSignal $srcref $event $dstref]
            if {[relation isnotempty $sig]} {
                ::after cancel [relation extract $sig TimerId]
                DeleteDelayedSignal $srcref $event $dstref
            } else {
                # Search the toc_queue to see if the signal delay has already expired
                # and the event is awaiting dispatch.
                variable toc_queue
                for {set i 0} {$i < [llength $toc_queue]} {incr i} {
                    set eventInfo [lindex $toc_queue $i]
                    dict update eventInfo src evtsrc dst evtdst event evtevent {
                        if {[isRefEqual $evtsrc $srcref] &&\
                                [isRefEqual $evtdst $dstref] &&\
                                $evtevent eq $event} {
                            set toc_queue [lreplace\
                                    [K $toc_queue [set toc_queue {}]] $i $i]
                            break
                        }
                    }
                }
            }
        }
        proc SignalTimeRemaining {srcref event dstref} {
            set sig [FindDelayedSignal $srcref $event $dstref]
            return [expr {[relation isempty $sig] ? 0 :\
                max([relation extract $sig Expire] - [clock milliseconds], 0)}] ; # <1>
        }
        proc MapPolymorphicEvent {frwdcmd srcref dstrefs event arglist} {
            lassign $dstrefs dstrelvar dstinsts
            SplitRelvarName $dstrelvar domain dstclass
            set polyevent [relvar restrictone ${domain}::__Arch_PolymorphicEvent\
                Class $dstclass Event $event]
            if {[relation isempty $polyevent]} {
                return false
            }
            variable polymapQuery
            set partitions [eval $polymapQuery]
            relation foreach inst $dstinsts {
                relation foreach partition $partitions {
                    relation assign $partition
                    relation foreach dstlink $DstLinks {
                        relation assign $dstlink
                        set related [relation semijoin $inst\
                            [relvar set ${domain}::$DstClass] -using $Attrs]
                        if {[relation isnotempty $related]} {
                            set dstreference [ToRef ${domain}::${DstClass} $related]
                            set target [ToRef $dstrelvar $inst]
                            ::rosea::Trace::TracePolymorphic $srcref $event $target $dstreference $Name\
                                    $arglist
                            if {![MapPolymorphicEvent $frwdcmd $srcref $dstreference $event $arglist]} {
                                {*}$frwdcmd $srcref $dstreference $event $arglist ; # <1>
                            }
                            break
                        }
                    }
                }
            }
        
            return true
        }
    }
    namespace eval Config {
        logger::initNamespace [namespace current]
    
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [namespace parent]::Helpers
        variable evalLambda {{body} {
            upvar #0 ::rosea::Config::errcount errcount ; # <1>
            upvar #0 ::rosea::Config::configlineno configlineno
            set lineno $configlineno
            set command {}
            foreach line [split $body \n] { # <2>
                append command $line \n
                incr lineno ; # <3>
                if {[info complete $command]} {
                    try {
                        eval $command
                    } on error {result} {
                        log::error "line $configlineno: \"$result\""
                        incr errcount
                    }
                    set command {} ; # <4>
                    set configlineno $lineno
                }
            }
            return $errcount
        }}
        relvar create Domain {
            Name        string
            Location    string
        } Name
        relvar create DomainElement {
            Domain  string
            Element string
        } {Domain Element}
        relvar association R1\
            DomainElement Domain *\
            Domain Name 1
        relvar create Class {
            Domain  string
            Name    string
        } {Domain Name}
        relvar create Relationship {
            Domain  string
            Name    string
        } {Domain Name}
        relvar create DomainOperation {
            Domain      string
            Name        string
            Parameters  list
            Body        string
        } {Domain Name}
        relvar partition R2 DomainElement {Domain Element}\
            Class {Domain Name}\
            Relationship {Domain Name}\
            DomainOperation {Domain Name}
        relvar create Attribute {
            Domain  string
            Class   string
            Name    string
            Type    string
        } {Domain Class Name}
        relvar association R3\
            Attribute {Domain Class} +\
            Class {Domain Name} 1
        relvar create Identifier {
            Domain  string
            Class   string
            Number  int
        } {Domain Class Number}
        relvar association R4\
            Identifier {Domain Class} +\
            Class {Domain Name} 1
        relvar create IdentifyingAttribute {
            Domain      string
            Class       string
            Attribute   string
            Number      int
        } {Domain Class Attribute Number}
        relvar correlation R5 IdentifyingAttribute\
            {Domain Class Number} + Identifier {Domain Class Number}\
            {Domain Class Attribute} * Attribute {Domain Class Name}
        relvar create DefaultValue {
            Domain      string
            Class       string
            Attribute   string
        } {Domain Class Attribute}
        relvar association R6\
            DefaultValue {Domain Class Attribute} ?\
            Attribute {Domain Class Name} 1
        relvar create UserSuppliedValue {
            Domain      string
            Class       string
            Attribute   string
            Value       string
        } {Domain Class Attribute}
        relvar create SystemSuppliedValue {
            Domain      string
            Class       string
            Attribute   string
            StartValue  int
        } {Domain Class Attribute}
        relvar create GeneratedValue {
            Domain      string
            Class       string
            Attribute   string
            Cmd         string
        } {Domain Class Attribute}
        relvar partition R18 DefaultValue {Domain Class Attribute}\
            UserSuppliedValue {Domain Class Attribute}\
            SystemSuppliedValue {Domain Class Attribute}\
            GeneratedValue {Domain Class Attribute}
        relvar create ValueCheck {
            Domain      string
            Class       string
            Attribute   string
            Expression  string
        } {Domain Class Attribute}
        relvar association R17\
            ValueCheck {Domain Class Attribute} ?\
            Attribute {Domain Class Name} 1
        relvar create AttributeReference {
            Domain              string
            ReferringClass      string
            ReferringAttribute  string
            ReferringRole       string
            ReferencedClass     string
            ReferencedAttribute string
            ReferencedRole      string
            ReferencedIdNumber  int
            Relationship        string
        } {Domain ReferringClass ReferringAttribute ReferringRole\
            ReferencedClass ReferencedAttribute ReferencedRole ReferencedIdNumber\
            Relationship}
        relvar association R13\
            AttributeReference {Domain ReferringClass ReferringAttribute} *\
            Attribute {Domain Class Name} 1
        relvar create ReferencedIdAttribute {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Attribute       string
            Number          int
        } {Domain Class Relationship Role Attribute Number}
        relvar create Operation {
            Domain  string
            Class   string
            Name    string
        } {Domain Class Name}
        
        relvar association R8\
            Operation {Domain Class} * Class {Domain Name} 1
        
        relvar create InstanceOperation {
            Domain  string
            Class   string
            Name    string
        } {Domain Class Name}
        
        relvar create ClassOperation {
            Domain  string
            Class   string
            Name    string
        } {Domain Class Name}
        
        relvar partition R7 Operation {Domain Class Name}\
            InstanceOperation {Domain Class Name}\
            ClassOperation {Domain Class Name}
        
        relvar create UserInstanceOperation {
            Domain      string
            Class       string
            Name        string
            Parameters  string
            Body        string
        } {Domain Class Name}
        
        relvar create SystemInstanceOperation {
            Domain      string
            Class       string
            Name        string
        } {Domain Class Name}
        
        relvar partition R9 InstanceOperation {Domain Class Name}\
            UserInstanceOperation {Domain Class Name}\
            SystemInstanceOperation {Domain Class Name}
        
        relvar create UserClassOperation {
            Domain  string
            Class   string
            Name    string
            Parameters  string
            Body        string
        } {Domain Class Name}
        
        relvar create SystemClassOperation {
            Domain  string
            Class   string
            Name    string
        } {Domain Class Name}
        
        relvar partition R10 ClassOperation {Domain Class Name}\
            UserClassOperation {Domain Class Name}\
            SystemClassOperation {Domain Class Name}
        
        relvar create SuppliedOperation {
            Name                string
            Command             string
            RequiresStateModel  boolean
        } Name
        
        relvar create SuppliedClassOperation {
            Name    string
        } Name
        
        relvar create SuppliedInstanceOperation {
            Name    string
        } Name
        
        relvar partition R14 SuppliedOperation Name\
            SuppliedClassOperation Name\
            SuppliedInstanceOperation Name
        
        relvar association R15\
            SystemClassOperation Name *\
            SuppliedClassOperation Name 1
        
        relvar association R16\
            SystemInstanceOperation Name *\
            SuppliedInstanceOperation Name 1
        relvar eval {
            relvar insert SuppliedOperation {
                Name                findAll
                Command             ::rosea::ClassCmds::findAll
                RequiresStateModel  false
            } {
                Name                findById
                Command             ::rosea::ClassCmds::findById
                RequiresStateModel  false
            } {
                Name                findWhere
                Command             ::rosea::ClassCmds::findWhere
                RequiresStateModel  false
            } {
                Name                create
                Command             ::rosea::ClassCmds::create
                RequiresStateModel  false
            } {
                Name                createin
                Command             ::rosea::ClassCmds::createin
                RequiresStateModel  true
            } {
                Name                createasync
                Command             ::rosea::ClassCmds::createasync
                RequiresStateModel  true
            } {
                Name                update
                Command             ::rosea::ClassCmds::update
                RequiresStateModel  false
            }
        
            relvar insert SuppliedClassOperation {
                Name    findAll
            } {
                Name    findById
            } {
                Name    findWhere
            } {
                Name    create
            } {
                Name    createin
            } {
                Name    createasync
            } {
                Name    update
            }
        }
        relvar eval {
            relvar insert SuppliedOperation {
                Name                findRelated
                Command             ::rosea::InstCmds::findRelated
                RequiresStateModel  false
            } {
                Name                findUnrelated
                Command             ::rosea::InstCmds::findById
                RequiresStateModel  false
            } {
                Name                findRelatedWhere
                Command             ::rosea::InstCmds::findRelatedWhere
                RequiresStateModel  false
            } {
                Name                findUnrelatedWhere
                Command             ::rosea::InstCmds::findUnrelatedWhere
                RequiresStateModel  false
            } {
                Name                updateAttribute
                Command             ::rosea::InstCmds::updateAttribute
                RequiresStateModel  false
            } {
                Name                withAttribute
                Command             ::rosea::InstCmds::withAttribute
                RequiresStateModel  false
            } {
                Name                readAttribute
                Command             ::rosea::InstCmds::readAttribute
                RequiresStateModel  false
            } {
                Name                assignAttribute
                Command             ::rosea::InstCmds::assignAttribute
                RequiresStateModel  false
            } {
                Name                delete
                Command             ::rosea::InstCmds::delete
                RequiresStateModel  false
            } {
                Name                signal
                Command             ::rosea::InstCmds::signal
                RequiresStateModel  true
            } {
                Name                delaysignal
                Command             ::rosea::InstCmds::delaysignal
                RequiresStateModel  true
            } {
                Name                canceldelayed
                Command             ::rosea::InstCmds::canceldelayed
                RequiresStateModel  true
            } {
                Name                delayremaining
                Command             ::rosea::InstCmds::delayremaining
                RequiresStateModel  true
            } {
                Name                instop
                Command             ::rosea::InstCmds::instop
                RequiresStateModel  false
            } {
                Name                deRef
                Command             ::rosea::InstCmds::deRef
                RequiresStateModel  false
            } {
                Name                isEmptyRef
                Command             ::rosea::InstCmds::isEmptyRef
                RequiresStateModel  false
            } {
                Name                isNotEmptyRef
                Command             ::rosea::InstCmds::isNotEmptyRef
                RequiresStateModel  false
            } {
                Name                refMultiplicity
                Command             ::rosea::InstCmds::refMultiplicity
                RequiresStateModel  false
            } {
                Name                isRefSingular
                Command             ::rosea::InstCmds::isRefSingular
                RequiresStateModel  false
            } {
                Name                limitRef
                Command             ::rosea::InstCmds::limitRef
                RequiresStateModel  false
            } {
                Name                isRefEqual
                Command             ::rosea::InstCmds::isRefEqual
                RequiresStateModel  false
            } {
                Name                forAllRefs
                Command             ::rosea::InstCmds::forAllRefs
                RequiresStateModel  false
            }
        
            relvar insert SuppliedInstanceOperation {
                Name    findRelated
            } {
                Name    findUnrelated
            } {
                Name    findRelatedWhere
            } {
                Name    findUnrelatedWhere
            } {
                Name    updateAttribute
            } {
                Name    withAttribute
            } {
                Name    readAttribute
            } {
                Name    assignAttribute
            } {
                Name    delete
            } {
                Name    signal
            } {
                Name    delaysignal
            } {
                Name    canceldelayed
            } {
                Name    delayremaining
            } {
                Name    instop
            } {
                Name    deRef
            } {
                Name    isEmptyRef
            } {
                Name    isNotEmptyRef
            } {
                Name    refMultiplicity
            } {
                Name    isRefSingular
            } {
                Name    limitRef
            } {
                Name    isRefEqual
            } {
                Name    forAllRefs
            }
        }
        relvar create Association {
            Domain      string
            Name        string
        } {Domain Name}
        relvar create Generalization {
            Domain      string
            Name        string
        } {Domain Name}
        relvar partition R30 Relationship {Domain Name}\
            Association {Domain Name}\
            Generalization {Domain Name}
        relvar create SimpleAssociation {
            Domain      string
            Name        string
        } {Domain Name}
        relvar create ClassBasedAssociation {
            Domain      string
            Name        string
        } {Domain Name}
        relvar partition R31 Association {Domain Name}\
            SimpleAssociation {Domain Name}\
            ClassBasedAssociation {Domain Name}
        relvar create SimpleReferringClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Conditionality  boolean
            Multiplicity    boolean
        } {Domain Class Relationship Role}
        relvar association R32\
            SimpleReferringClass {Domain Relationship} 1\
            SimpleAssociation {Domain Name} 1
        relvar create SimpleReferencedClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Conditionality  boolean
        } {Domain Class Relationship Role}
        relvar association R33\
            SimpleReferencedClass {Domain Relationship} 1\
            SimpleAssociation {Domain Name} 1
        relvar create SourceClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Conditionality  boolean
            Multiplicity    boolean
        } {Domain Class Relationship Role}
        relvar association R34\
            SourceClass {Domain Relationship} 1\
            ClassBasedAssociation {Domain Name} 1
        relvar create TargetClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
            Conditionality  boolean
            Multiplicity    boolean
        } {Domain Class Relationship Role}
        relvar association R35\
            TargetClass {Domain Relationship} 1\
            ClassBasedAssociation {Domain Name} 1
        relvar create AssociatorClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar association R42\
            AssociatorClass {Domain Relationship} 1\
            ClassBasedAssociation {Domain Name} 1
        relvar create Superclass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar association R36\
            Superclass {Domain Relationship} 1\
            Generalization {Domain Name} 1
        relvar create Subclass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar association R37\
            Subclass {Domain Relationship} +\
            Generalization {Domain Name} 1
        relvar create ReferringClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar partition R38 ReferringClass {Domain Class Relationship Role}\
            SimpleReferringClass {Domain Class Relationship Role}\
            AssociatorClass {Domain Class Relationship Role}\
            Subclass {Domain Class Relationship Role}
        relvar create ReferencedClass {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar partition R39 ReferencedClass {Domain Class Relationship Role}\
            SimpleReferencedClass {Domain Class Relationship Role}\
            SourceClass {Domain Class Relationship Role}\
            TargetClass {Domain Class Relationship Role}\
            Superclass {Domain Class Relationship Role}
        relvar create ClassRole {
            Domain          string
            Class           string
            Relationship    string
            Role            string
        } {Domain Class Relationship Role}
        relvar partition R40 ClassRole {Domain Class Relationship Role}\
            ReferringClass {Domain Class Relationship Role}\
            ReferencedClass {Domain Class Relationship Role}
        relvar correlation R41 ClassRole\
            {Domain Relationship} + Relationship {Domain Name}\
            {Domain Class} * Class {Domain Name}
        relvar correlation R11 ReferencedIdAttribute\
            {Domain Class Relationship Role} +\
                ReferencedClass {Domain Class Relationship Role}\
            {Domain Class Attribute Number} *\
                IdentifyingAttribute {Domain Class Attribute Number}
        relvar correlation R12 AttributeReference\
            {Domain ReferringClass Relationship ReferringRole} +\
                ReferringClass {Domain Class Relationship Role}\
            {Domain ReferencedClass Relationship ReferencedRole ReferencedAttribute\
                    ReferencedIdNumber} +\
                ReferencedIdAttribute {Domain Class Relationship Role Attribute Number}
        relvar create Config_AssocSpec {
            Spec                string
            NeedsAssociator     boolean
            ReflexiveAllowed    boolean
            ReferringCond       boolean
            ReferringMult       boolean
            ReferencedCond      boolean
            ReferencedMult      boolean
        } Spec
        
        relvar insert Config_AssocSpec {
            Spec 1--1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond false ReferringMult false
                ReferencedCond false ReferencedMult false
        } {
            Spec 0..1--1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond true ReferringMult false
                ReferencedCond false ReferencedMult false
        } {
            Spec 0..1--0..1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond true ReferringMult false
                ReferencedCond true ReferencedMult false
        } {
            Spec 1..*--1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond false ReferringMult true
                ReferencedCond false ReferencedMult false
        } {
            Spec 0..*--1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond true ReferringMult true
                ReferencedCond false ReferencedMult false
        } {
            Spec 1..*--0..1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond false ReferringMult true
                ReferencedCond true ReferencedMult false
        } {
            Spec 0..*--0..1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond true ReferringMult true
                ReferencedCond true ReferencedMult false
        } {
            Spec 1..*--1..* NeedsAssociator true ReflexiveAllowed true
                ReferringCond false ReferringMult true
                ReferencedCond false ReferencedMult true
        } {
            Spec 0..*--1..* NeedsAssociator true ReflexiveAllowed false
                ReferringCond true ReferringMult true
                ReferencedCond false ReferencedMult true
        } {
            Spec 1..*--0..* NeedsAssociator true ReflexiveAllowed false
                ReferringCond false ReferringMult true
                ReferencedCond true ReferencedMult true
        } {
            Spec 0..*--0..* NeedsAssociator true ReflexiveAllowed true
                ReferringCond true ReferringMult true
                ReferencedCond true ReferencedMult true
        } {
            Spec ?--1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond true ReferringMult false
                ReferencedCond false ReferencedMult false
        } {
            Spec ?--? NeedsAssociator false ReflexiveAllowed true
                ReferringCond true ReferringMult false
                ReferencedCond true ReferencedMult false
        } {
            Spec +--1 NeedsAssociator false ReflexiveAllowed true
                ReferringCond false ReferringMult true
                ReferencedCond false ReferencedMult false
        } {
            Spec *--1 NeedsAssociator false ReflexiveAllowed false
                ReferringCond true ReferringMult true
                ReferencedCond false ReferencedMult false
        } {
            Spec +--? NeedsAssociator false ReflexiveAllowed false
                ReferringCond false ReferringMult true
                ReferencedCond true ReferencedMult false
        } {
            Spec *--? NeedsAssociator false ReflexiveAllowed true
                ReferringCond true ReferringMult true
                ReferencedCond true ReferencedMult false
        } {
            Spec +--+ NeedsAssociator true ReflexiveAllowed true
                ReferringCond false ReferringMult true
                ReferencedCond false ReferencedMult true
        } {
            Spec *--+ NeedsAssociator true ReflexiveAllowed false
                ReferringCond true ReferringMult true
                ReferencedCond false ReferencedMult true
        } {
            Spec +--* NeedsAssociator true ReflexiveAllowed false
                ReferringCond false ReferringMult true
                ReferencedCond true ReferencedMult true
        } {
            Spec *--* NeedsAssociator true ReflexiveAllowed true
                ReferringCond true ReferringMult true
                ReferencedCond true ReferencedMult true
        }
        relvar create Config_ClassAssoc {
            Domain              string
            Relationship        string
            AssocClass          string
            SourceClass         string
        } {Domain Relationship AssocClass SourceClass}
        relvar create Config_NonReflexiveAssoc {
            Domain              string
            Relationship        string
            AssocClass          string
            SourceClass         string
            TargetClass         string
        } {Domain Relationship AssocClass SourceClass}
        relvar create Config_ReflexiveAssoc {
            Domain              string
            Relationship        string
            AssocClass          string
            SourceClass         string
        } {Domain Relationship AssocClass SourceClass}
        relvar create Config_ReflexivePath {
            Domain              string
            Relationship        string
            AssocClass          string
            SourceClass         string
            SourceAttr          string
            TargetAttr          string
        } {Domain Relationship AssocClass SourceClass SourceAttr}
        relvar partition Config1\
            Config_ClassAssoc\
                {Domain Relationship AssocClass SourceClass}\
            Config_NonReflexiveAssoc\
                {Domain Relationship AssocClass SourceClass}\
            Config_ReflexiveAssoc\
                {Domain Relationship AssocClass SourceClass}
        relvar association Config2\
            Config_ReflexivePath {Domain Relationship AssocClass SourceClass} +\
            Config_ReflexiveAssoc {Domain Relationship AssocClass SourceClass} 1
        pipe {
            relvar set ::rosea::Config::AttributeReference |
            relation project ~ Domain ReferencedClass Relationship ReferencedRole\
                    ReferencedAttribute ReferencedIdNumber |
            relation rename ~ ReferencedClass Class ReferencedRole Role\
                    ReferencedAttribute Attribute ReferencedIdNumber Number |
            relvar union ::rosea::Config::ReferencedIdAttribute
        } refIdQuery
        relvar create StateModel {
            Domain          string
            Model           string
            InitialState    string
            DefaultTrans    string
        } {Domain Model}
        
        relvar create InstanceStateModel {
            Domain          string
            Class           string
        } {Domain Class}
        
        relvar association R51\
            InstanceStateModel {Domain Class} ?\
            Class {Domain Name} 1
        
        relvar create AssignerStateModel {
            Domain          string
            Relationship    string
        } {Domain Relationship}
        
        relvar association R52\
            AssignerStateModel {Domain Relationship} ?\
            Association {Domain Name} 1
        
        relvar partition R50 StateModel {Domain Model}\
            InstanceStateModel {Domain Class}\
            AssignerStateModel {Domain Relationship}
        
        relvar create SingleAssigner {
            Domain          string
            Relationship    string
        } {Domain Relationship}
        
        relvar create MultipleAssigner {
            Domain          string
            Relationship    string
            Class           string
            Number          int
        } {Domain Relationship}
        
        relvar partition R53 AssignerStateModel {Domain Relationship}\
            SingleAssigner {Domain Relationship}\
            MultipleAssigner {Domain Relationship}
        
        relvar association R54\
            MultipleAssigner {Domain Class Number} ?\
            Identifier {Domain Class Number} 1
        
        relvar create State {
            Domain          string
            Model           string
            Name            string
            Parameters      string
            Action          string
            IsFinal         boolean
        } {Domain Model Name}
        
        relvar association R55\
            State {Domain Model} +\
            StateModel {Domain Model} 1
        
        relvar association R58\
            StateModel {Domain Model InitialState} ?\
            State {Domain Model Name} 1
        
        relvar create TransitionRule {
            Name    string
        } Name
        
        relvar insert TransitionRule {Name IG} {Name CH}
        
        relvar association R59\
            StateModel DefaultTrans *\
            TransitionRule Name 1
        
        relvar create CreationState {
            Domain          string
            Model           string
            Name            string
        } {Domain Model Name}
        
        relvar create StatePlace {
            Domain          string
            Model           string
            Name            string
        } {Domain Model Name}
        
        relvar partition R57 StatePlace {Domain Model Name}\
            State {Domain Model Name}\
            CreationState {Domain Model Name}
        relvar create Event {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar create DeferredEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar create EffectiveEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar partition R80 Event {Domain Model Event}\
            DeferredEvent {Domain Model Event}\
            EffectiveEvent {Domain Model Event}
        
        relvar create DeferralPath {
            Domain          string
            Model           string
            Event           string
            Relationship    string
            Role            string
        } {Domain Model Event Relationship Role}
        
        relvar correlation R86 DeferralPath\
            {Domain Model Event} + DeferredEvent {Domain Model Event}\
            {Domain Model Relationship Role} * Superclass\
                {Domain Class Relationship Role}
        
        relvar create PolymorphicEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar create InheritedEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar partition R81 DeferredEvent {Domain Model Event}\
            PolymorphicEvent {Domain Model Event}\
            InheritedEvent {Domain Model Event}
        
        relvar create MappedEvent {
            Domain      string
            Model       string
            Event       string
            ParentModel string
        } {Domain Model Event}
        
        relvar association R84\
            MappedEvent {Domain ParentModel Event} *\
            DeferredEvent {Domain Model Event} 1
        
        relvar create LocalEvent {
            Domain  string
            Model   string
            Event   string
        } {Domain Model Event}
        
        relvar partition R82 EffectiveEvent {Domain Model Event}\
            MappedEvent {Domain Model Event}\
            LocalEvent {Domain Model Event}
        
        relvar create NonLocalEvent {
            Domain          string
            Model           string
            Event           string
            Relationship    string
            Role            string
        } {Domain Model Event}
        
        relvar partition R83 NonLocalEvent {Domain Model Event}\
            MappedEvent {Domain Model Event}\
            InheritedEvent {Domain Model Event}
        
        relvar association R85\
            NonLocalEvent {Domain Model Relationship Role} *\
            Subclass {Domain Class Relationship Role} 1
        
        relvar association R87\
            EffectiveEvent {Domain Model} +\
            StateModel {Domain Model} 1
        relvar create TransitionPlace {
            Domain  string
            Model   string
            State   string
            Event   string
        } {Domain Model State Event}
        
        relvar correlation R70 TransitionPlace\
            {Domain Model State} * StatePlace {Domain Model Name}\
            {Domain Model Event} * EffectiveEvent {Domain Model Event}
        
        relvar create StateTransition {
            Domain      string
            Model       string
            State       string
            Event       string
            NewState    string
        } {Domain Model State Event}
        
        relvar create NonStateTransition {
            Domain      string
            Model       string
            State       string
            Event       string
            TransRule   string
        } {Domain Model State Event}
        
        relvar partition R71 TransitionPlace {Domain Model State Event}\
            StateTransition {Domain Model State Event}\
            NonStateTransition {Domain Model State Event}
        
        relvar association R72\
            StateTransition {Domain Model NewState} *\
            State {Domain Model Name} 1
        
        relvar association R73\
            NonStateTransition TransRule *\
            TransitionRule Name 1
        relvar create Config_DataError {
            Relationship        string
            RefClass            string
            RefType             string
            Format              string
        } {Relationship RefClass RefType}
        relvar insert Config_DataError {
            Relationship        R3
            RefClass            Class
            RefType             notrefed
            Format              {in domain, \"$Domain\", class, \"$Name\",\
                                has no attributes}
        } {
            Relationship        R4
            RefClass            Class
            RefType             notrefed
            Format              {in domain, \"$Domain\", class, \"$Name\",\
                                has no identifiers}
        } {
            Relationship        R11
            RefClass            ReferencedClass
            RefType             notrefed
            Format              {in domain, \"$Domain\", for relationship,\
                                \"$Relationship\", no class has defined a reference\
                                to class, \"$Class\"}
        } {
            Relationship        R11
            RefClass            ReferencedIdAttribute
            RefType             refnone
            Format              {in domain, \"$Domain\", relationship,\
                                \"$Relationship\", references attribute,\
                                \"$Attribute\", in class, \"$Class\", which is\
                                not an identifying attribute, does not exist\
                                or \"$Relationship\" does not exist}
        } {
            Relationship        R12
            RefClass            AttributeReference
            RefType             refnone
            Format              {in domain, \"$Domain\", the attribute,\
                                \"$ReferringAttribute\", in class, \"$ReferringClass\",\
                                refers to, \"$ReferencedAttribute\", in class,\
                                \"$ReferencedClass\", but the class, attribute or\
                                relationship does not exist}
        } {
            Relationship        R12
            RefClass            ReferringClass
            RefType             notrefed
            Format              {in domain, \"$Domain\", in class, \"$Class\",\
                                makes a reference along relationship,\
                                \"$Relationship\", but $Class does not pariticipate\
                                in $Relationship}
        } {
            Relationship        R13
            RefClass            AttributeReference
            RefType             refnone
            Format              {in domain, \"$Domain\", the attribute,\
                                \"$ReferringAttribute\", in class, \"$ReferringClass\",\
                                does not exist, but is used as a referential attribute}
        } {
            Relationship        R41
            RefClass            ClassRole
            RefType             refnone
            Format              {in domain, \"$Domain\", relationship,\
                                \"$Relationship\", references class, \"$Class\",\
                                which does not exist}
        } {
            Relationship        R52
            RefClass            AssignerStateModel
            RefType             refnone
            Format              {in domain, \"$Domain\", an assigner state model is\
                                defined on relationship, \"$Relationship\", which is\
                                not an association type relationship}
        } {
            Relationship        R70
            RefClass            TransitionPlace
            RefType             refnone
            Format              {in domain, \"$Domain\", the state model for,\
                                \"$Model\", contains a transition for event,\
                                \"$Event\", but $Event was a polymorphic event\
                                consumed by a superclass of $Model}
        } {
            Relationship        R72
            RefClass            StateTransition
            RefType             refnone
            Format              {in domain, \"$Domain\", the state model for,\
                                \"$Model\", contains the transition,\
                                \"$State - $Event -> $NewState\",\
                                but state \"$NewState\" does not exist}
        } {
            Relationship        R81
            RefClass            DeferredEvent
            RefType             multrefed
            Format              {in domain, \"$Domain\", in the state model for,\
                                \"$Model\", event, \"$Event\", is both an inherited\
                                polymorphic event and a locally defined one}
        } {
            Relationship        R86
            RefClass            DeferredEvent
            RefType             notrefed
            Format              {in domain, \"$Domain\", in the state model for,\
                                \"$Model\", event, \"$Event\", is defined as\
                                polymorphic but \"$Model\" is not a superclass\
                                of a generalization}
        } {
            Relationship        R87
            RefClass            EffectiveEvent
            RefType             refnone
            Format              {in domain, \"$Domain\", event, \"$Event\" has been\
                                inherited, but no state model exists for, \"$Model\"}
        }
        namespace export ConfigEvaluate
        
        proc ConfigEvaluate {ns body} {
            variable evalLambda
            tailcall ::apply [concat $evalLambda [list $ns]] $body ; # <1>
        }
        proc domain {name body} {
            namespace upvar DomainDef DomainName DomainName ; # <1>
            set DomainName $name
        
            relvar insert ::rosea::Config::Domain [list Name $name Location {}]
            try {
                if {$name eq {}} {
                    tailcall DeclError EMPTY_NAME domain
                }
        
                relvar eval { # <2>
                    ConfigEvaluate [namespace current]::DomainDef $body
        
                    # At this point we have the definition of the domain and enough
                    # information to tie together the referential attributes and
                    # the association definitions.
                    variable Config_NonReflexiveAssoc
                    
                    relation foreach nra $Config_NonReflexiveAssoc {
                        relation assign $nra
                        relvar update ::rosea::Config::AttributeReference ar {
                            [tuple extract $ar Domain] eq $Domain &&
                            [tuple extract $ar Relationship] eq $Relationship &&
                            [tuple extract $ar ReferringClass] eq $AssocClass
                        } {tuple update $ar ReferringRole associator}
                    
                        relvar update ::rosea::Config::AttributeReference ar {
                            [tuple extract $ar Domain] eq $Domain &&
                            [tuple extract $ar Relationship] eq $Relationship &&
                            [tuple extract $ar ReferringClass] eq $AssocClass &&
                            [tuple extract $ar ReferencedClass] eq $SourceClass
                        } {tuple update $ar ReferencedRole source}
                    }
                    variable Config_ReflexivePath
                    
                    relation foreach rp $Config_ReflexivePath {
                        relation assign $rp
                        relvar update ::rosea::Config::AttributeReference ar {
                            [tuple extract $ar Domain] eq $Domain &&
                            [tuple extract $ar Relationship] eq $Relationship &&
                            [tuple extract $ar ReferringClass] eq $AssocClass
                        } {tuple update $ar ReferringRole associator}
                    
                        relvar update ::rosea::Config::AttributeReference ar {
                            [tuple extract $ar Domain] eq $Domain &&
                            [tuple extract $ar Relationship] eq $Relationship &&
                            [tuple extract $ar ReferringClass] eq $AssocClass &&
                            [tuple extract $ar ReferringAttribute] eq $SourceAttr
                        } {tuple update $ar ReferencedRole source}
                    }
                    variable refIdQuery
                    
                    eval $refIdQuery
        
                    # We must also compute how polymorphic events are inherited
                    # down generalization hierarchies.
                    # Create Deferral Path instances
                    
                    variable PolymorphicEvent
                    variable DeferredEvent
                    variable Superclass
                    variable Subclass
                    variable DeferralPath
                    
                    set dpaths [pipe {
                        relation restrictwith $PolymorphicEvent {$Domain eq $name} |
                        relation semijoin ~ $DeferredEvent |
                        relation join ~ $Superclass -using {Domain Domain Model Class}
                    }]
                    relvar insert ::rosea::Config::DeferralPath {*}[relation body $dpaths]
                    set supers [relation semiminus $Subclass $Superclass\
                        -using {Domain Domain Class Class}]
                    
                    relation foreach super $supers {
                        PropagatePolyEvents $super
                    }
                }
            } on error {result} {
                # puts $::errorInfo
                ::rosea::Config::HandleConfigError $result
            }
        }
        proc HandleConfigError {result} {
            set lines [split [string trimright $result] \n]
            set nlines [llength $lines]
            set lineno 0
            upvar #0 ::rosea::Config::errcount errcount
            while {$lineno < $nlines} {
                set line [lindex $lines $lineno]
                incr lineno
                if {[regexp {^for[^:]+([^(]+)\(.+\), in relvar (.+)$} $line\
                        match rnum refclass]} {
                    set rnum [namespace tail $rnum]
                    set refclass [namespace tail $refclass]
                
                    # Now iterate over the "tuple" lines that follow the constraint message.
                    while {$lineno < $nlines} {
                        set tupline [lindex $lines $lineno]
                        if {[regexp {^tuple {(.+)} (.+)$} $tupline match tuple phrase]} {
                            incr lineno
                            incr errcount
                            if {[string match {is not referenced*} $phrase]} {
                                set reftype notrefed
                            } elseif {[string match {references no*} $phrase]} {
                                set reftype refnone
                            } elseif {[string match {*to by multiple*} $phrase]} {
                                set reftype multrefed
                            } elseif {[string match {is not referred to*} $phrase]} {
                                set reftype notrefto
                            } else {
                                log::error "unknown constraint phrasing, \"$phrase\""
                                continue
                            }
                            set cde [relvar restrictone Config_DataError Relationship $rnum RefClass\
                                    $refclass RefType $reftype]
                            if {[relation isnotempty $cde]} {
                                dict with tuple {
                                    log::error [subst -nocommands [relation extract $cde Format]]
                                }
                            } else {
                                log::error "$line\n$tupline"
                            }
                        } else {
                            break
                        }
                    }
                } else {
                    log::error "unknown configuration error, \"$result\""
                }
            }
        
            return
        }
        namespace eval DomainDef {
            logger::initNamespace [namespace current]
        
            namespace import\
                ::ral::relation\
                ::ral::tuple\
                ::ral::relformat\
                ::ralutil::pipe
            namespace import ::ral::relvar
            namespace import ::rosea::Config::ConfigEvaluate
            namespace import ::rosea::Helpers::DeclError
            proc class {name body} {
                namespace upvar [namespace current] DomainName DomainName ; # <1>
                namespace upvar ClassDef ClassName ClassName
                set ClassName $name
            
                if {![regexp {\A[[:alnum:]].*} $name]} {
                    tailcall DeclError BAD_CLASS_NAME $name
                }
                try {
                    relvar insert ::rosea::Config::DomainElement [list\
                        Domain  $DomainName\
                        Element $name\
                    ]
                } trap {RAL relvar insert DUPLICATE_TUPLE} {} {
                    tailcall DeclError DUP_ELEMENT_NAME $name
                } ; # <2>
                relvar insert ::rosea::Config::Class [list\
                    Domain  $DomainName\
                    Name    $name\
                ]
                set instops [pipe {
                    relvar set ::rosea::Config::SuppliedInstanceOperation |
                    relation extend ~ ioptuple\
                        Domain string {[set DomainName]}\
                        Class string {[set ClassName]}
                }]
                relvar union ::rosea::Config::SystemInstanceOperation $instops
                relvar union ::rosea::Config::InstanceOperation $instops
                relvar union ::rosea::Config::Operation $instops
                set classops [pipe {
                    relvar set ::rosea::Config::SuppliedClassOperation |
                    relation extend ~ coptuple\
                        Domain string {[set DomainName]}\
                        Class string {[set ClassName]}
                }]
                relvar union ::rosea::Config::SystemClassOperation $classops
                relvar union ::rosea::Config::ClassOperation $classops
                relvar union ::rosea::Config::Operation $classops
            
                ConfigEvaluate [namespace current]::ClassDef $body
            }
            proc association {name source spec target args} {
                if {[llength $args] % 2 != 0} {
                    tailcall DeclError ARG_FORMAT $args
                }
                if {$name eq {}} {
                    tailcall DeclError EMPTY_NAME association
                }
                if {[string index $name 0] eq "~"} {
                    tailcall DeclError TILDE_NAME $name
                }
            
                # Obtain references to the domain and class context.
                namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
            
                set associator {}
                set path {}
                
                foreach {option value} $args {
                    switch -exact -- $option {
                        -associator {
                            set associator $value
                        }
                        -path {
                            set path $value
                            if {[llength $path] % 2 != 0} {
                                tailcall DeclError ARG_FORMAT $path
                            }
                        }
                        default {
                            tailcall DeclError UNKNOWN_OPTION association $option
                        }
                    }
                }
                set cas [relvar restrictone ::rosea::Config::Config_AssocSpec Spec $spec]
                if {[relation isempty $cas]} {
                    tailcall DeclError BAD_RELATIONSHIP_SPEC $spec
                }
                set needsassoc [relation extract $cas NeedsAssociator]
                if {$needsassoc && $associator eq {}} {
                    tailcall DeclError NEED_ASSOCIATOR $spec
                }
                if {$source eq $target} {
                    if {![relation extract $cas ReflexiveAllowed]} {
                        tailcall DeclError REFLEXIVE_NOT_ALLOWED $spec
                    }
                    if {$needsassoc && $path eq {}} {
                        tailcall DeclError NEED_REFLEXIVE_PATH $name $source $spec $target
                    }
                }
            
                try {
                    relvar insert ::rosea::Config::DomainElement [list\
                        Domain  $DomainName\
                        Element $name\
                    ]
                } trap {RAL relvar insert DUPLICATE_TUPLE} {result opts} {
                    tailcall DeclError DUP_ELEMENT_NAME $name
                }
            
                # Many relvars have tuples with the same heading, so we construct it
                # once here.
                set reltuple [list\
                    Domain  $DomainName\
                    Name $name\
                ]
            
                # Populate the data for a Relationship and Association since that
                # is what this command defines.
                relvar insert ::rosea::Config::Relationship $reltuple
                relvar insert ::rosea::Config::Association $reltuple
            
                # Populate the type of association we are dealing with.
                if {$associator eq {}} {
                    relvar insert ::rosea::Config::SimpleAssociation $reltuple
                    relvar insert ::rosea::Config::SimpleReferringClass [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                        Conditionality  [relation extract $cas ReferringCond]\
                        Multiplicity    [relation extract $cas ReferringMult]\
                    ]
                    relvar insert ::rosea::Config::ReferringClass [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                    ]
                    relvar insert ::rosea::Config::SimpleReferencedClass [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                        Conditionality  [relation extract $cas ReferencedCond]\
                    ]
                    relvar insert ::rosea::Config::ReferencedClass [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                    ]
                } else {
                    relvar insert ::rosea::Config::Config_ClassAssoc [list\
                        Domain              $DomainName\
                        Relationship        $name\
                        AssocClass          $associator\
                        SourceClass         $source\
                    ]
                    if {[llength $path] == 0} {
                        relvar insert ::rosea::Config::Config_NonReflexiveAssoc [list\
                            Domain              $DomainName\
                            Relationship        $name\
                            AssocClass          $associator\
                            SourceClass         $source\
                            TargetClass         $target\
                        ]
                    } else {
                        relvar insert ::rosea::Config::Config_ReflexiveAssoc [list\
                            Domain              $DomainName\
                            Relationship        $name\
                            AssocClass          $associator\
                            SourceClass         $source\
                        ]
                        foreach {sourceattr targetattr} $path {
                            relvar insert ::rosea::Config::Config_ReflexivePath [list\
                                Domain              $DomainName\
                                Relationship        $name\
                                AssocClass          $associator\
                                SourceClass         $source\
                                SourceAttr          $sourceattr\
                                TargetAttr          $targetattr\
                            ]
                        }
                    }
                    
                    relvar insert ::rosea::Config::ClassBasedAssociation $reltuple
                    relvar insert ::rosea::Config::SourceClass [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                        Conditionality  [relation extract $cas ReferringCond]\
                        Multiplicity    [relation extract $cas ReferringMult]\
                    ]
                    relvar insert ::rosea::Config::ReferencedClass [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $source\
                        Relationship    $name\
                        Role            source\
                    ]
                    relvar insert ::rosea::Config::TargetClass [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                        Conditionality  [relation extract $cas ReferencedCond]\
                        Multiplicity    [relation extract $cas ReferencedMult]\
                    ]
                    relvar insert ::rosea::Config::ReferencedClass [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $target\
                        Relationship    $name\
                        Role            target\
                    ]
                    relvar insert ::rosea::Config::AssociatorClass [list\
                        Domain          $DomainName\
                        Class           $associator\
                        Relationship    $name\
                        Role            associator\
                    ]
                    relvar insert ::rosea::Config::ReferringClass [list\
                        Domain          $DomainName\
                        Class           $associator\
                        Relationship    $name\
                        Role            associator\
                    ]
                    relvar insert ::rosea::Config::ClassRole [list\
                        Domain          $DomainName\
                        Class           $associator\
                        Relationship    $name\
                        Role            associator\
                    ]
                }
            }
            proc generalization {name super args} {
                if {[llength $args] < 2} {
                    tailcall DeclError TOO_FEW_SUBCLASSES [llength $args]
                }
                if {$name eq {}} {
                    tailcall DeclError EMPTY_NAME generalization
                }
                if {[string index $name 0] eq "~"} {
                    tailcall DeclError TILDE_NAME $name
                }
            
                namespace upvar ::rosea::Config::DomainDef DomainName DomainName
            
                try {
                    relvar insert ::rosea::Config::DomainElement [list\
                        Domain  $DomainName\
                        Element $name\
                    ]
                } trap {RAL relvar insert DUPLICATE_TUPLE} {result opts} {
                    tailcall DeclError DUP_ELEMENT_NAME $name
                }
            
                set reltuple [list\
                    Domain  $DomainName\
                    Name $name\
                ]
                relvar insert ::rosea::Config::Relationship $reltuple
                relvar insert ::rosea::Config::Generalization $reltuple
            
                set supertuple [list\
                    Domain          $DomainName\
                    Class           $super\
                    Relationship    $name\
                    Role            target\
                ]
                relvar insert ::rosea::Config::Superclass $supertuple
                relvar insert ::rosea::Config::ReferencedClass $supertuple
                relvar insert ::rosea::Config::ClassRole $supertuple
            
                set subtuple [dict create\
                    Domain          $DomainName\
                    Relationship    $name\
                    Role            source\
                ]
                foreach sub $args {
                    dict set subtuple Class $sub
                    relvar insert ::rosea::Config::Subclass $subtuple
                    relvar insert ::rosea::Config::ReferringClass $subtuple
                    relvar insert ::rosea::Config::ClassRole $subtuple
                }
            }
            proc assigner {rname body} {
                namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                namespace upvar AssignerDef\
                    RelationshipName RelationshipName\
                    multiClass multiClass\
                    multiIdNum multiIdNum\
                    InitialState InitialState\
                    DefaultTrans DefaultTrans
            
                set RelationshipName $rname
                set multiClass {}
                set multiIdNum 1
                set InitialState {}
                set DefaultTrans {}
            
                try {
                    ConfigEvaluate [namespace current]::AssignerDef $body
            
                    if {$DefaultTrans eq {}} {
                        set DefaultTrans CH
                    }
                    relvar insert ::rosea::Config::StateModel [list\
                        Domain          $DomainName\
                        Model           $rname\
                        InitialState    $InitialState\
                        DefaultTrans    $DefaultTrans\
                    ]
                    set assigntuple [list\
                        Domain          $DomainName\
                        Relationship    $rname\
                    ]
                    relvar insert ::rosea::Config::AssignerStateModel $assigntuple
                    if {$multiClass eq {}} {
                        relvar insert ::rosea::Config::SingleAssigner $assigntuple
                    } else {
                        lappend assigntuple Class $multiClass Number $multiIdNum
                        relvar insert ::rosea::Config::MultipleAssigner $assigntuple
                    }
                } on error {result opts} {
                    log::error $result
                    upvar #0 ::rosea::Config::errcount errcount
                    incr errcount
                }
            }
            proc operation {name params body} {
                if {$name eq {}} {
                    tailcall DeclError EMPTY_NAME operation
                }
                namespace upvar ::rosea::Config::DomainDef DomainName DomainName
            
                try {
                    relvar insert ::rosea::Config::DomainElement [list\
                        Domain      $DomainName\
                        Element     $name\
                    ]
                } trap {RAL relvar insert DUPLICATE_TUPLE} {result opts} {
                    tailcall DeclError DUP_ELEMENT_NAME $name
                }
                relvar insert ::rosea::Config::DomainOperation [list\
                    Domain      $DomainName\
                    Name        $name\
                    Parameters  $params\
                    Body        $body\
                ]
            }
        
            namespace eval ClassDef {
                logger::initNamespace [namespace current]
            
                namespace import\
                    ::ral::relation\
                    ::ral::tuple\
                    ::ral::relformat\
                    ::ralutil::pipe
                namespace import ::ral::relvar
                namespace import ::rosea::Config::ConfigEvaluate
                namespace import ::rosea::Helpers::DeclError
            
                proc attribute {name type args} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME attribute
                    }
                    if {[string range $name 0 1] eq "__"} {
                        tailcall DeclError RESERVED_NAME $name
                    }
                    if {[llength $args] % 2 != 0} {
                        tailcall DeclError ARG_FORMAT $args
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    relvar insert ::rosea::Config::Attribute [list\
                        Domain  $DomainName\
                        Class   $ClassName\
                        Name    $name\
                        Type    $type\
                    ]
                
                    foreach {option value} $args {
                        switch -exact -- $option {
                            -default {
                                relvar insert ::rosea::Config::DefaultValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                ]
                                relvar insert ::rosea::Config::UserSuppliedValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    Value       $value\
                                ]
                            }
                            -system {
                                if {$type ne "int"} {
                                    tailcall DeclError INT_TYPE_REQUIRED $type
                                }
                                if {![string is integer -strict $value]} {
                                    tailcall DeclError INT_VALUE_REQUIRED $value
                                }
                                relvar insert ::rosea::Config::DefaultValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                ]
                                relvar insert ::rosea::Config::SystemSuppliedValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    StartValue  $value\
                                ]
                            }
                            -generate {
                                relvar insert ::rosea::Config::DefaultValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                ]
                                relvar insert ::rosea::Config::GeneratedValue [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    Cmd         $value\
                                ]
                            }
                            -id {
                                relvar uinsert ::rosea::Config::Identifier [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Number      $value\
                                ] ; # <1>
                                relvar insert ::rosea::Config::IdentifyingAttribute [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    Number      $value\
                                ]
                            }
                            -check {
                                relvar insert ::rosea::Config::ValueCheck [list\
                                    Domain      $DomainName\
                                    Class       $ClassName\
                                    Attribute   $name\
                                    Expression  $value\
                                ]
                            }
                            default {
                                tailcall DeclError UNKNOWN_OPTION attribute $option
                            }
                        }
                    }
                }
                proc reference {relname rclass args} {
                    if {[llength $args] % 2 != 0} {
                        tailcall DeclError ARG_FORMAT $args
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    set refnum 1
                    set linkopts [list]
                
                    foreach {option value} $args {
                        switch -exact -- $option {
                            -refid {
                                set refnum $value
                            }
                            -link {
                                if {[llength $value] < 1 || [llength $value] > 2} {
                                    tailcall DeclError ARG_FORMAT $value
                                }
                                lappend linkopts $value
                            }
                            default {
                                tailcall DeclError UNKNOWN_OPTION reference $option
                            }
                        }
                    }
                
                    # We defer processing the link options until the end so as not
                    # to impose an order on the -refid option.
                    foreach linkopt $linkopts {
                        lassign $linkopt referring referenced
                        if {$referenced eq {}} {
                            set referenced $referring
                        }
                        relvar insert ::rosea::Config::AttributeReference [list\
                            Domain              $DomainName\
                            ReferringClass      $ClassName\
                            ReferringAttribute  $referring\
                            ReferringRole       source\
                            ReferencedClass     $rclass\
                            ReferencedAttribute $referenced\
                            ReferencedRole      target\
                            ReferencedIdNumber  $refnum\
                            Relationship        $relname
                        ] ; # <1>
                    }
                }
                proc classop {name params body} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME "class operation"
                    } elseif {[string first :: $name] != -1} {
                        tailcall DeclError NS_QUALIFIERS $name
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    set sysop [relvar restrictone ::rosea::Config::Operation\
                        Domain $DomainName Class $ClassName Name $name]
                    if {[relation isnotempty $sysop]} {
                        tailcall DeclError DUP_OP_NAME $name
                    }
                
                    set optuple [list Domain $DomainName Class $ClassName Name $name]
                    relvar insert ::rosea::Config::Operation $optuple
                    relvar insert ::rosea::Config::ClassOperation $optuple
                
                    lappend optuple Parameters $params Body $body
                    relvar insert ::rosea::Config::UserClassOperation $optuple
                }
                proc instop {name params body} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME "instance operation"
                    } elseif {[string first :: $name] != -1} {
                        tailcall DeclError NS_QUALIFIERS $name
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    set sysop [relvar restrictone ::rosea::Config::Operation\
                        Domain $DomainName Class $ClassName Name $name]
                    if {[relation isnotempty $sysop]} {
                        tailcall DeclError DUP_OP_NAME $name
                    }
                
                    set optuple [list Domain $DomainName Class $ClassName Name $name]
                    relvar insert ::rosea::Config::Operation $optuple
                    relvar insert ::rosea::Config::InstanceOperation $optuple
                
                    lappend optuple Parameters $params Body $body
                    relvar insert ::rosea::Config::UserInstanceOperation $optuple
                }
                proc statemodel {body} {
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    variable ClassName
                
                    namespace upvar StateModelDef\
                        InitialState InitialState\
                        DefaultTrans DefaultTrans\
                        Terminals Terminals
                
                    set InitialState {}
                    set DefaultTrans {}
                    set Terminals [list]
                
                    try {
                        ConfigEvaluate [namespace current]::StateModelDef $body
                
                        if {$DefaultTrans eq {}} {
                            set DefaultTrans CH
                        }
                        relvar insert ::rosea::Config::StateModel [list\
                            Domain          $DomainName\
                            Model           $ClassName\
                            InitialState    $InitialState\
                            DefaultTrans    $DefaultTrans\
                        ]
                        relvar insert ::rosea::Config::InstanceStateModel [list\
                            Domain          $DomainName\
                            Class           $ClassName\
                        ]
                
                        foreach terminal $Terminals {
                            relvar updateone ::rosea::Config::State stup [list\
                                    Domain $DomainName Model $ClassName Name $terminal] {
                                tuple update $stup IsFinal true
                            }
                        }
                    } on error {result opts} {
                        log::error $result
                        upvar #0 ::rosea::Config::errcount errcount
                        incr errcount
                    }
                }
                proc polymorphic {args} {
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                
                    foreach polyevent $args {
                        set eventtuple [list\
                            Domain $DomainName\
                            Model $ClassName\
                            Event $polyevent\
                        ]
                        relvar insert ::rosea::Config::PolymorphicEvent $eventtuple
                        relvar insert ::rosea::Config::DeferredEvent $eventtuple
                        relvar insert ::rosea::Config::Event $eventtuple
                    }
                    return
                }
            
                namespace eval StateModelDef {
                    logger::initNamespace [namespace current]
                
                    namespace import\
                        ::ral::relation\
                        ::ral::tuple\
                        ::ral::relformat\
                        ::ralutil::pipe
                    namespace import ::ral::relvar
                    namespace import ::rosea::Config::ConfigEvaluate
                    namespace import ::rosea::Helpers::DeclError
                
                    proc state {name params body} {
                        if {$name eq {}} {
                            tailcall DeclError EMPTY_NAME state
                        }
                        if {$name in {@ CH IG}} {
                            tailcall DeclError PSEUDO_STATE $name state
                        }
                    
                        namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                        namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                    
                        variable InitialState
                    
                        if {$InitialState eq {}} {
                            set InitialState $name
                        }
                    
                        relvar insert ::rosea::Config::State [list\
                            Domain          $DomainName\
                            Model           $ClassName\
                            Name            $name\
                            Parameters      $params\
                            Action          $body\
                            IsFinal         false\
                        ]
                        relvar insert ::rosea::Config::StatePlace [list\
                            Domain          $DomainName\
                            Model           $ClassName\
                            Name            $name\
                        ]
                        return
                    }
                    proc transition {source - event -> target} {
                        if {$event eq {}} {
                            tailcall DeclError EMPTY_NAME event
                        }
                        if {$source in {CH IG}} {
                            tailcall DeclError PSEUDO_STATE $source "transition source state"
                        }
                        namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                        namespace upvar ::rosea::Config::DomainDef::ClassDef ClassName ClassName
                    
                        if {$source eq "@"} {
                            if {$target in {CH IG}} {
                                tailcall DeclError BAD_CREATION_TARGET $target
                            }
                            set cstuple [list\
                                Domain          $DomainName\
                                Model           $ClassName\
                                Name            @\
                            ]
                            relvar uinsert ::rosea::Config::CreationState $cstuple
                            relvar uinsert ::rosea::Config::StatePlace $cstuple
                        }
                    
                        set eventtuple [list\
                            Domain  $DomainName\
                            Model   $ClassName\
                            Event   $event\
                        ]
                        relvar uinsert ::rosea::Config::Event $eventtuple ; # <1>
                        relvar uinsert ::rosea::Config::EffectiveEvent $eventtuple
                        relvar uinsert ::rosea::Config::LocalEvent $eventtuple
                    
                        set tranrule [relvar restrictone ::rosea::Config::TransitionRule\
                            Name $target]
                        set transtuple [list\
                            Domain  $DomainName\
                            Model   $ClassName\
                            State   $source\
                            Event   $event\
                        ]
                        relvar insert ::rosea::Config::TransitionPlace $transtuple
                    
                        if {[relation isnotempty $tranrule]} {
                            lappend transtuple TransRule $target
                            set tpsubtype NonStateTransition
                        } else {
                            lappend transtuple NewState $target
                            set tpsubtype StateTransition
                        }
                        relvar insert ::rosea::Config::$tpsubtype $transtuple
                        return
                    }
                    proc initialstate {name} {
                        if {$name eq {}} {
                            tailcall DeclError EMPTY_NAME initialstate
                        }
                        if {$name in {@ CH IG}} {
                            tailcall DeclError PSEUDO_STATE $name initialstate
                        }
                        variable InitialState $name
                        return
                    }
                    proc defaulttrans {name} {
                        if {$name ni {CH IG}} {
                            tailcall DeclError EXPECTED_PSEUDO_STATE $name
                        }
                        variable DefaultTrans $name
                        return
                    }
                    proc terminal {args} {
                        variable Terminals
                        ::struct::set add Terminals $args
                        return
                    }
                }
            }
            namespace eval AssignerDef {
                logger::initNamespace [namespace current]
            
                namespace import\
                    ::ral::relation\
                    ::ral::tuple\
                    ::ral::relformat\
                    ::ralutil::pipe
                namespace import ::ral::relvar
                namespace import ::rosea::Config::ConfigEvaluate
                namespace import ::rosea::Helpers::DeclError
            
                proc state {name params body} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME state
                    }
                    if {$name in {CH IG}} {
                        tailcall DeclError PSEUDO_STATE $name state
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::AssignerDef\
                        RelationshipName RelationshipName
                
                    variable InitialState
                
                    if {$InitialState eq {}} {
                        set InitialState $name
                    }
                
                    relvar insert ::rosea::Config::State [list\
                        Domain          $DomainName\
                        Model           $RelationshipName\
                        Name            $name\
                        Parameters      $params\
                        Action          $body\
                        IsFinal         false\
                    ]
                    relvar insert ::rosea::Config::StatePlace [list\
                        Domain          $DomainName\
                        Model           $RelationshipName\
                        Name            $name\
                    ]
                    return
                }
                proc transition {source - event -> target} {
                    if {$event eq {}} {
                        tailcall DeclError EMPTY_NAME event
                    }
                    if {$source in {CH IG}} {
                        tailcall DeclError PSEUDO_STATE $name "transition source state"
                    }
                
                    namespace upvar ::rosea::Config::DomainDef DomainName DomainName
                    namespace upvar ::rosea::Config::DomainDef::AssignerDef\
                        RelationshipName RelationshipName
                
                    set eventtuple [list\
                        Domain  $DomainName\
                        Model   $RelationshipName\
                        Event   $event\
                    ]
                    relvar uinsert ::rosea::Config::Event $eventtuple
                    relvar uinsert ::rosea::Config::EffectiveEvent $eventtuple
                    relvar uinsert ::rosea::Config::LocalEvent $eventtuple
                
                    set tranrule [relvar restrictone ::rosea::Config::TransitionRule\
                        Name $target]
                    set transtuple [list\
                        Domain  $DomainName\
                        Model   $RelationshipName\
                        State   $source\
                        Event   $event\
                    ]
                    relvar insert ::rosea::Config::TransitionPlace $transtuple
                
                    if {[relation isnotempty $tranrule]} {
                        lappend transtuple TransRule $target
                        set tpsubtype NonStateTransition
                    } else {
                        lappend transtuple NewState $target
                        set tpsubtype StateTransition
                    }
                    relvar insert ::rosea::Config::$tpsubtype $transtuple
                    return
                }
                proc initialstate {name} {
                    if {$name eq {}} {
                        tailcall DeclError EMPTY_NAME initialstate
                    }
                    if {$name in {CH IG}} {
                        tailcall DeclError PSEUDO_STATE $name initialstate
                    }
                    variable InitialState $name
                    return
                }
                proc defaulttrans {name} {
                    if {$name ni {CH IG}} {
                        tailcall DeclError EXPECTED_PSEUDO_STATE $name
                    }
                    variable DefaultTrans $name
                    return
                }
                proc identifyby {name args} {
                    if {[llength $args] % 2 != 0} {
                        tailcall DeclError ARG_FORMAT $args
                    }
                
                    variable multiClass $name
                
                    foreach {option value} $args {
                        switch -exact -- $option {
                            -id {
                                variable multiIdNum $value
                            }
                            default {
                                tailcall DeclError UNKNOWN_OPTION identifyby $option
                            }
                        }
                    }
                
                    return
                }
            }
        }
    }
    namespace eval Populate {
        logger::initNamespace [namespace current]
    
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace import ::rosea::Config::ConfigEvaluate
        namespace import ::rosea::Helpers::DeclError
        proc domain {name body} {
            set domain [relvar restrictone ::rosea::Config::Domain Name $name]
            if {[relation isempty $domain]} {
                tailcall DeclError UNKNOWN_DOMAIN $domain
            }
        
            namespace upvar DomainPop DomainName DomainName DomainLoc DomainLoc
            relation assign $domain {Name DomainName} {Location DomainLoc}
        
            try {
                relvar eval {
                    ConfigEvaluate [namespace current]::DomainPop $body
                }
            } on error {result opts} {
                log::error $result
                upvar #0 ::rosea::Config::errcount errcount
                incr errcount
            }
        }
        namespace eval DomainPop {
            logger::initNamespace [namespace current]
        
            namespace import\
                ::ral::relation\
                ::ral::tuple\
                ::ral::relformat\
                ::ralutil::pipe
            namespace import ::ral::relvar
            namespace path ::rosea::Helpers
            proc class {class heading args} {
                # Determine if we have one big list or a bunch of values.
                set popvalues [expr {[llength $args] == 1 ? [lindex $args 0] : $args}]
                set headlen [llength $heading]
                if {[llength $popvalues] % $headlen != 0} {
                    tailcall DeclError ARG_MISMATCH $headlen [llength $popvalues]
                }
            
                # Iterate over the attribute values taking them in chunks that are the same
                # size as the heading.
                set body [list]
                for {set vindex 0} {$vindex < [llength $popvalues]} {incr vindex $headlen} {
                    set values [lrange $popvalues $vindex [expr {$vindex + $headlen - 1}]]
                    # Create a tuple as a list of attribute name / value pairs.
                    set tuple [list]
                    foreach attr $heading value $values {
                        # Check if we are skipping a value to use a default.  We must also
                        # allow some way to specify the value as "-".
                        if {$value eq "-"} {
                            continue
                        } elseif {$value eq "\\-"} {
                            set value -
                        }
                        lappend tuple $attr $value
                    }
                    # Accumulate the tuples as a list to form the body that will be
                    # inserted into the relvar.
                    lappend body $tuple
                }
            
                # Insert the body into the relvar.
                namespace upvar [namespace current]\
                    DomainName DomainName\
                    DomainLoc DomainLoc
                set domns ${DomainLoc}::${DomainName}
                set relvar ${domns}::$class
                set insts [relvar insert $relvar {*}$body]
            
                # Now we have to deal with any state model that might be present.  We have
                # to set up the initial state properly if such a thing exists for this
                # class.
                set idattrs [lindex [relvar identifiers $relvar] 0]
                relation foreach inst $insts {
                    CreateInInitialState $domns $class [pipe {
                        relation project $inst {*}$idattrs |
                        relation tuple ~ |
                        tuple get ~
                    }]
                }
            
                return [relation body $insts]
            }
            proc assigner {rname heading args} {
                # Determine if we have one big list or a bunch of values.
                set popvalues [expr {[llength $args] == 1 ? [lindex $args 0] : $args}]
                set headlen [llength $heading]
                if {[llength $popvalues] % $headlen != 0} {
                    tailcall DeclError ARG_MISMATCH $headlen [llength $popvalues]
                }
            
                namespace upvar [namespace current]\
                    DomainName DomainName\
                    DomainLoc DomainLoc
                set domns ${DomainLoc}::${DomainName}
                set relvar ${domns}::${rname}__STATEINST
                set idattrs [lindex [relvar identifiers $relvar] 0]
                if {![struct::set equal $heading $idattrs]} {
                    tailcall DeclError NO_IDENTIFIER $heading $idattrs
                }
            
                # Iterate over the attribute values taking them in chunks that are the same
                # size as the heading.
                for {set vindex 0} {$vindex < [llength $popvalues]} {incr vindex $headlen} {
                    set values [lrange $popvalues $vindex [expr {$vindex + $headlen - 1}]]
                    # Create a tuple as a list of attribute name / value pairs.  We assume
                    # the values are in the same order as the heading -- that is the point.
                    set tuple [list]
                    foreach attr $heading value $values {
                        lappend tuple $attr $value
                    }
                    CreateInInitialState $domns $rname $tuple
                }
            
                return
            }
        }
    }
    namespace eval Info {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace import ::rosea::Helpers::DeclError
        proc domain {arglist} {
            set arglist [lassign $arglist subcmd domainname]
            set dominst [relvar restrictone ::rosea::Config::Domain Name $domainname]
            if {[relation isempty $dominst]} {
                tailcall DeclError UNKNOWN_DOMAIN $domainname
            }
        
            switch -exact -- $subcmd {
                classes {
                    return [pipe {
                        relvar set ::rosea::Config::Class |
                        relation semijoin $dominst ~ -using {Name Domain} |
                        relation list ~ Name
                    }]
                }
                relationships {
                    return [pipe {
                        relvar set ::rosea::Config::Relationship |
                        relation semijoin $dominst ~ -using {Name Domain} |
                        relation list ~ Name
                    }]
                }
                operations {
                    return [FormatOpsInfo [pipe {
                        relvar set ::rosea::Config::DomainOperation |
                        relation semijoin $dominst ~ -using {Name Domain} |
                        relation project ~ Name Parameters Body
                    }]]
                }
                default {
                    tailcall DeclError UNKNOWN_INFO_CMD $subcmd
                }
            }
        }
        proc FormatOpsInfo {ops} {
            set result [list]
            relation foreach op $ops {
                relation assign $op
                lappend result $Name $Parameters $Body
            }
            return $result
        }
        proc class {arglist} {
            set arglist [lassign $arglist subcmd domainname classname]
            set dominst [relvar restrictone ::rosea::Config::Domain Name $domainname]
            if {[relation isempty $dominst]} {
                tailcall DeclError UNKNOWN_DOMAIN $domainname
            }
        
            set classinst [pipe {
                relvar set ::rosea::Config::Class |
                relation semijoin $dominst ~ -using {Name Domain} |
                relation restrictwith ~ {$Name eq $classname}
            }]
            if {[relation isempty $classinst]} {
                tailcall DeclError UNKNOWN_CLASS $classname $domainname
            }
        
            switch -exact -- $subcmd {
                attributes {
                    return [pipe {
                        relvar set ::rosea::Config::Attribute |
                        relation semijoin $classinst ~ -using {Domain Domain Name Class} |
                        relation dict ~ Name Type
                    }]
                }
                classops {
                    return [FormatOpsInfo [pipe {
                        relvar set ::rosea::Config::UserClassOperation |
                        relation semijoin $classinst ~ -using {Domain Domain Name Class} |
                        relation project ~ Name Parameters Body
                    }]]
                }
                instops {
                    return [FormatOpsInfo [pipe {
                        relvar set ::rosea::Config::UserInstanceOperation |
                        relation semijoin $classinst ~ -using {Domain Domain Name Class} |
                        relation project ~ Name Parameters Body
                    }]]
                }
                default {
                    tailcall DeclError UNKNOWN_INFO_CMD $subcmd
                }
            }
        }
        proc statemodel {arglist} {
            set arglist [lassign $arglist subcmd domainname classname statename]
            set dominst [relvar restrictone ::rosea::Config::Domain Name $domainname]
            if {[relation isempty $dominst]} {
                tailcall DeclError UNKNOWN_DOMAIN $domainname
            }
            set domns [string cat [relation extract $dominst Location] :: $domainname]
        
            set classinst [pipe {
                relvar set ::rosea::Config::Class |
                relation semijoin $dominst ~ -using {Name Domain} |
                relation restrictwith ~ {$Name eq $classname}
            }]
            if {[relation isempty $classinst]} {
                tailcall DeclError UNKNOWN_CLASS $classname $domainname
            }
        
            switch -exact -- $subcmd {
                states {
                    set states [pipe {
                        relvar set ::rosea::Config::State |
                        relation restrictwith ~\
                            {$Domain eq $domainname && $Model eq $classname} |
                        relation project ~ Name Parameters Action
                    }]
                    set result [list]
                    relation foreach state $states {
                        relation assign $state
                        lappend result $Name $Parameters $Action
                    }
                    return $result
                }
                events {
                    return [pipe {
                        relvar set ::rosea::Config::EffectiveEvent |
                        relation restrictwith ~\
                            {$Domain eq $domainname && $Model eq $classname} |
                        relation list ~ Event
                    }]
                }
                transitions {
                    return [pipe {
                        relvar set ${domns}::__Arch_Transition |
                        relation restrictwith ~ {$Class eq $classname} |
                        relation eliminate ~ Class |
                        relation group ~ Transition Event NewState |
                        relation extend ~ trtup TranCol dict {
                            [relation dict [tuple extract $trtup Transition] Event NewState]} |
                        relation dict ~ State TranCol
                    }] ; # <1>
                }
                activityproc {
                    return ${domns}::${classname}::__Activity::${statename}
                }
            }
        }
    }
    namespace eval Trace {
        namespace import\
            ::ral::relation\
            ::ral::tuple\
            ::ral::relformat\
            ::ralutil::pipe
        namespace import ::ral::relvar
        namespace path [list\
            [namespace parent]::Helpers\
            [namespace parent]::InstCmds\
        ]
        relvar create Trace {
            Trace_Id    int
            Timestamp   bignum
            Source      list
            Event       string
            Target      list
            Params      list
        } Trace_Id
        
        relvar create Creation {
            Trace_Id    int
        } Trace_Id
        
        relvar create Polymorphic {
            Trace_Id    int
            SubInst     string
            Linkage     string
        } Trace_Id
        
        relvar create Transition {
            Trace_Id    int
            CurrState   string
            NewState    string
        } Trace_Id
        
        relvar partition R1 Trace Trace_Id\
            Creation Trace_Id\
            Polymorphic Trace_Id\
            Transition Trace_Id
        variable targetCmpFunc [lambda {instrefs target} {
            lassign $target trelvar tinst
            foreach instref $instrefs {
                lassign $instref crelvar cinst
                if {$trelvar eq $crelvar && [ral relation is $tinst subsetof $cinst]} {
                    return true
                }
            }
            return false
        }]
        variable traceState off
        variable traceNumber 0
        variable traceLogState off
        variable traceLogLevel info
        variable traceLogCmd [::logger::init rosea]
        proc QueryClassTraces {classes} {
            variable Trace
            return [relation restrictwith $Trace {
                [lindex $Target 0] in $classes ||\
                    [namespace tail [lindex $Target 0]] in $classes
            }] ; # <1>
        }
        proc QueryTargetTraces {targets} {
            variable Trace
            variable targetCmpFunc
            return [relation restrictwith $Trace {[{*}$targetCmpFunc $targets $Target]}]
        }
        proc TraceCreation {source event target params} {
            variable traceState
            if {$traceState} {
                relvar eval {
                    set trace [NewTrace $source $event $target $params]
                    relvar insert Creation [list\
                        Trace_Id    [relation extract $trace Trace_Id]\
                    ]
                }
                LogTrace $trace
            }
        }
        proc TracePolymorphic {source event target sub link params} {
            variable traceState
            if {$traceState} {
                relvar eval {
                    set trace [NewTrace $source $event $target $params]
                    relvar insert Polymorphic [list\
                        Trace_Id    [relation extract $trace Trace_Id]\
                        SubInst     $sub\
                        Linkage     $link\
                    ]
                }
                LogTrace $trace
            }
        }
        proc TraceTransition {source event target curr new params} {
            variable traceState
            if {$traceState} {
                relvar eval {
                    set trace [NewTrace $source $event $target $params]
                    relvar insert Transition [list\
                        Trace_Id    [relation extract $trace Trace_Id]\
                        CurrState   $curr\
                        NewState    $new\
                    ]
                }
                LogTrace $trace
            }
        }
        proc NewTrace {src event target params} {
            variable traceNumber
            return [relvar insert Trace [list\
                Trace_Id    [incr traceNumber]\
                Timestamp   [clock microseconds]\
                Source      $src\
                Event       $event\
                Target      $target\
                Params      $params\
            ]]
        }
        proc LogTrace {trace} {
            variable traceLogState
            if {$traceLogState} {
                set rec [FormatTraceRec [lindex [TracesToRecords $trace] 0]] ; # <1>
        
                variable traceLogCmd
                variable traceLogLevel
                ${traceLogCmd}::${traceLogLevel} $rec
            }
        }
        proc TracesToRecords {traces} {
            foreach rvname {Creation Polymorphic Transition} { # <1>
                set traces [::ralutil::rvajoin $traces [relvar set $rvname] $rvname]
            }
        
            set result [list]
            relation foreach trace $traces -ascending Trace_Id { # <2>
                relation assign $trace
                set labeled [dict create\
                    id      $Trace_Id\
                    time    $Timestamp\
                    source  $Source\
                    event   $Event\
                    target  $Target\
                    params  $Params\
                    class   [lindex $Target 0]\
                ] ; # <3>
                if {[relation isnotempty $Transition]} { # <4>
                    relation assign $Transition
                    dict set labeled type transition
                    dict set labeled current $CurrState
                    dict set labeled new $NewState
                } elseif {[relation isnotempty $Polymorphic]} {
                    relation assign $Polymorphic
                    dict set labeled type polymorphic
                    dict set labeled sub $SubInst
                    dict set labeled link $Linkage
                } elseif {[relation isnotempty $Creation]} {
                    dict set labeled type creation
                }
        
                lappend result $labeled
            }
            return $result
        }
        proc DecodeAllTraces {} {
            variable Trace
            tailcall TracesToRecords $Trace
        }
        proc DecodeClassTraces {args} {
            return [TracesToRecords [QueryClassTraces $args]]
        }
        proc DecodeTargetTraces {args} {
            tailcall TracesToRecords [QueryTargetTraces $args]
        }
        proc FormatTraceRec {rec} {
            dict with rec {
                switch -exact -- $type {
                    transition {
                        append result\
                            "Transition: "\
                            [FormatTransition $source $event $params $target]\
                            " ==> $current -> $new"
                    }
                    polymorphic {
                        append result\
                            "Polymorphic : "\
                            [FormatTransition $source $event $params $target]\
                            " ==> $link -> [FormatInstRef $sub]"
                    }
                    creation {
                        append result\
                            "Creation: "\
                            "[FormatInstRef $source] - "\
                            "[FormatEvent $event $params] -> $class\
                            " ==> [FormatInstRef $target]"
                    }
                    default {
                        DeclError BAD_TRACETYPE $type
                    }
                }
            }
            return $result
        }
        proc FormatTransition {source event params target} {
            return "[FormatInstRef $source] - [FormatEvent $event $params] ->\
                [FormatInstRef $target]"
        }
        proc FormatEvent {event params} {
            return [string cat\
                $event\
                [expr {[llength $params] != 0 ? "\([join $params {, }]\)" : {}}]\
            ]
        }
        proc FormatInstRef {instref} {
            lassign $instref relvar inst
            if {$relvar eq {}} {
                return {{}}
            } else {
                return "$relvar\{[tuple get [relation tuple $inst]]\}"
            }
        }
        proc FormatTimestamp {time} {
            set sec [clock format [expr {$time / 1000000}] -format %T] ; # <1>
            set time [expr {$time % 1000000}]
            set msec [expr {$time / 1000}]
            set usec [expr {$time % 1000}]
        
            return [format %s.%03ld.%03ld $sec $msec $usec]
        }
        proc FormatTimeAsSec {time} {
            set sec [expr {$time / 1000000}]
            set time [expr {$time % 1000000}]
            set msec [expr {$time / 1000}]
            set usec [expr {$time % 1000}]
        
            return [format %3ld.%03ld.%03ld $sec $msec $usec]
        }
        proc DiagTraces {traces args} {
            set result {}
            append result "seqdiag \{\n"
            append result "    activation = none;\n"
            foreach {option value} $args {
                append result "    $option = $value;\n"
            }
        
            foreach rvname {Creation Polymorphic Transition} {
                set traces [::ralutil::rvajoin $traces [relvar set $rvname] $rvname]
            }
        
            relation foreach trace $traces -ascending Trace_Id {
                relation assign $trace
                if {[isEmptyRef $Source]} {
                    set Source EXTERNAL
                } else {
                    set Source [namespace tail [lindex $Source 0]]
                }
                set Target [namespace tail [lindex $Target 0]]
                set evtlabel [FormatEvent $Event $Params]
                if {[relation isnotempty $Polymorphic]} {
                    relation assign $Transition Linkage
                    append evtlabel " <<Polymorphic $Linkage>>"
                } elseif {[relation isnotempty $Creation]} {
                    append evtlabel " <<Creation>>"
                }
                append result "    $Source ->> $Target \[label=\"$evtlabel\"\];\n"
            }
        
            append result "\}\n"
        
            return $result
        }
        proc DiagAllTraces {filename args} {
            set chan [open $filename w]
            variable Trace
            try {
                chan puts $chan [DiagTraces $Trace {*}$args]
            } finally {
                chan close $chan
            }
            return
        }
        proc DiagClassTraces {filename classes args} {
            set chan [open $filename w]
            try {
                chan puts $chan [DiagTraces [QueryClassTraces $classes] {*}$args]
            } finally {
                chan close $chan
            }
            return
        }
        proc DiagTargetTraces {filename targets args} {
            set chan [open $filename w]
            try {
                chan puts $chan [DiagTraces [QueryTargetTraces $targets] {*}$args]
            } finally {
                chan close $chan
            }
            return
        }
    }

    namespace path ::rosea::Helpers
    namespace import ::rosea::Config::ConfigEvaluate
}

package provide rosea $::rosea::version