PC World 1997 November/PCWorld_1997-11_cd.bin/software/programy/komix/DATA.Z/cpp_funcs.tcl

Text File | 1997-05-21 | 59.5 KB | 2,062 lines

#---------------------------------------------------------------------------
#
# Copyright (c) 1993-1995 by Cadre Technologies Inc.
#
# This software is furnished under a license and may be used only in
# accordance with the terms of such license and with the inclusion of
# the above copyright notice. This software or any other copies thereof
# may not be provided or otherwise made available to any other person.
# No title to and ownership of the software is hereby transferred.
#
# The information in this software is subject to change without notice
# and should not be construed as a commitment by Cadre Technologies Inc.
#
#---------------------------------------------------------------------------
#
#    File        : @(#)cpp_funcs.tcl    /main/hindenburg/7
#    Original date    : 4-2-1993
#    Description    : C++ generator functions
#
#---------------------------------------------------------------------------
#
global classesOfInterest
set classesOfInterest ""

proc oopl_model::generate {model} {
    global classesOfInterest
    set classesOfInterest  [getSelectedOoplClasses $model]
    check_unique_file_names $model

    foreach class $classesOfInterest {
        if [$class isExternal] {
            continue
        }
        if {[$class getName] == ""} {
            puts stderr "Class without name skipped"
            continue
        }
        class2tgtfiles $class nts nth
        global skip_file
        global gen_file
        global import_new
        if [info exists gen_file($nth)] {
            set gen_file($nts) 1
        }
        if {[$class getPropertyValue class_source] != ""} {
            process_external_class_source $class
            continue
        }
        if {( $import_new &&
              ([is_special_class $class] ||
               [info exists skip_file($nts)]) &&
              [info exists skip_file($nth)]) ||
            ( !$import_new &&
              ![info exists gen_file($nts)] &&
              ![info exists gen_file($nth)])} {
            continue
        }

        global cpp_error_state
        set cpp_error_state 0

        generate $class
    }
}

# Check uniqueness of filenames
#
proc check_unique_file_names {model } {
    global classesOfInterest

    foreach class $classesOfInterest {
        set cl_name [$class getName]
        set file_name [class2file $cl_name]
        if [$class isExternal] {
            continue
        }
        if [info exists names($file_name)] {
            error "Classes '$cl_name' and '$names($file_name)' map to the same file name" "" ERR_UNIQUE_FILENAME
        }
        set names($file_name) $cl_name
    }
}

proc class::generate {class} {
    if [catch {prepare_regeneration $class} result] {
        # something went wrong, find out what
        switch $errorCode {
            ERR_REGEN {puts stderr $result}
            default {error $result $errorInfo $errorCode}
        }
        class2tgtfiles $class src_file h_file
        global gen_file
        catch {unset gen_file($src_file)}
        if {! [info exists gen_file($h_file)]} {
            return
        }
    }
    create_cpp_sections [concat $cpp_hdr_sections $cpp_src_sections]
    init_cpp_sections $class
    puts stdout "Generating for class '[$class getName]'"
    class::gen_description $class $cpp_sections(h_class_nm_sect)
    set is_db [is_db_class $class]
    if {$is_db} {
        db_class_before $class
    }
    gen_user_added_include
    add_src_inc $class
    gen_start_protector $class
    gen_class_decl $class
    set sect $cpp_sections(h_pub_func_sect)
    foreach feat [$class featureSet] {
        generate $feat $class
    }
    if {$is_db} {
        db_class_after $class
    }
    gen_delayed_code $class
    gen_user_added_ctor
    gen_user_added_dtor
    gen_end_protector $class
    append_obsolete_code $class
    exit_cpp_sections $class
    write_cpp_sections $class $cpp_hdr_sections $cpp_src_sections
}

proc class::gen_description {class sect} {
    set ftext [$class getFreeText]
    if {$ftext != ""} {
        $sect append "\n"
        string_to_oopl_comment $sect $ftext "//"
        $sect append "\n"
    }
}

proc class_enum::generate {class} {
    puts stdout "Generating for enum class '[$class getName]'"
    create_cpp_sections $limited_cpp_hdr_sections
    gen_start_protector $class
    set sect $cpp_sections(h_inl_sect)
    class::gen_description $class $sect
    $sect append "enum [$class getName] \{\n"
    $sect indent +
    set first 1
    foreach feat [$class featureSet] {
        if {$first} {
            set first 0
        } else {
            $sect append ",\n"
        }
        $sect append [$feat getName]
        set iv [$feat getPropertyValue initial_value]
        if {$iv != ""} {
            $sect append " = $iv"
        }
    }
    $sect append "\n"
    $sect indent -
    $sect append "\};\n"
    gen_end_protector $class
    write_cpp_sections $class $limited_cpp_hdr_sections ""

        if {[$class specNodeSet] != ""} {
        if {![is_derivable_class $class]} {
                puts "ERROR: Enum Class '[$class getName]'\
                    cannot have subclasses since it is a standard type"
        }
        }
}

proc class_typedef::generate {class} {
    puts stdout "Generating for typedef class '[$class getName]'"
    create_cpp_sections $limited_cpp_hdr_sections
    gen_start_protector $class
    set sect $cpp_sections(h_inl_sect)
    class::gen_description $class $sect
    set feat [$class dataAttrSet]
    $sect append \
        "typedef [gen_var_decl [$feat ooplType] [$class getName]];\n"

    gen_delayed_code $class
    gen_end_protector $class
    write_cpp_sections $class $limited_cpp_hdr_sections ""

        if {[$class specNodeSet] != ""} {
        if {![is_derivable_class $class]} {
                puts "ERROR: Typedef Class '[$class getName]'\
                    cannot have subclasses since it is a standard type"
        }
        }
}

proc class_generic_typedef::generate {class} {
    puts stdout "Generating for generic typedef class '[$class getName]'"
    create_cpp_sections $limited_cpp_hdr_sections
    gen_start_protector $class
    set sect $cpp_sections(h_inl_sect)
    class::gen_description $class $sect
    set feat [$class genAssocAttrSet]
    gen_typedef $feat $class
    gen_delayed_code $class

    gen_end_protector $class
    write_cpp_sections $class $limited_cpp_hdr_sections ""

        if {[$class specNodeSet] != ""} {
        if {![is_derivable_class $class]} {
                puts "ERROR: Generic Typedef Class '[$class getName]'\
                    cannot have subclasses since it is a standard type"
        }
        }
}

# look in global 're_user_includes' for previous user includes

proc gen_user_added_include {} {
    set sect $cpp_sections(c_hdr_sect)

    global re_user_includes
    $sect append "$START_INCLUDE_MESSAGE\n"
    $sect append $re_user_includes
    $sect append "$END_INCLUDE_MESSAGE\n\n"
}

# look in global 're_ctor' for previous user additions to constructor

proc gen_user_added_ctor {} {
    set sect $cpp_sections(c_ctor_body_iv_sect)
    global re_ctor
    set old_ind [$sect indent]
    $sect append "$START_CTOR_MESSAGE\n"
    $sect indent 0
    $sect append $re_ctor
    $sect indent $old_ind
    $sect append "$END_CTOR_MESSAGE\n"
}

# look in global 're_dtor' for previous user additions to destructor

proc gen_user_added_dtor {} {
    set sect $cpp_sections(c_dtor_sect)
    global re_dtor
    set old_ind [$sect indent]
    $sect append "$START_DTOR_MESSAGE\n"
    $sect indent 0
    $sect append $re_dtor
    $sect indent $old_ind
    $sect append "$END_DTOR_MESSAGE\n"
}

proc gen_start_protector {class} {
    set protector [protector_name [$class getName]]
    expand_text $cpp_sections(h_hdr_sect) {
        #ifndef ~$protector
        #define ~$protector

    }
}

proc gen_end_protector {class} {
    set protector [protector_name [$class getName]]
    $cpp_sections(h_trailer_sect) append "\n#endif /* $protector */\n"
}

proc class::gen_class_decl {class} {
    set sect $cpp_sections(h_class_nm_sect)
    $sect append "class [$class getName] "
    set first 1
    foreach super [$class genNodeSet] {
        generate $super first
    }
    $sect append "\{\n"
}

proc link_class::generate {class} {
    puts stdout "Generating for link class '[$class getName]'"
    if {[$class getName] == ""} {
        puts stderr "Link class without name skipped"
        return
    }
    class::generate $class
}

proc link_class::gen_class_decl {class} {
    class::gen_class_decl $class
}

proc inher_group::generate {group f} {
    upvar $f first
    set sect $cpp_sections(h_class_nm_sect)
    if {$first} {
        $sect append ": "
        set first 0
    } else {
        $sect append ", "
    }
    set access [$group getPropertyValue inher_access]
    if {$access != ""} {
        set access [string tolower $access]
    } else {
        set access public
    }
    $sect append "$access "
    if {[$group isOverlapping] == "1"} {
        $sect append "virtual "
    }
    add_hdr_inc [$group superClass]
    $sect append "[$group getSuperClassName] "
}

proc feature::gen_description {feature sect} {
    set ftext [$feature getFreeText]
    if {$ftext != ""} {
        string_to_oopl_comment $sect $ftext "//"
    }
}

proc data_attrib::generate {attrib class} {
    if [info exists cpp_sections(h_priv_data_user-defined_sect)] {
        set sect $cpp_sections(h_priv_data_user-defined_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    feature::gen_description $attrib $sect
    if {[$attrib isClassFeature] == "1"} {
        set static_string "static "
        # static funcs: not const
        set const_string ""
    } else {
        set static_string ""
        set const_string " const"
    }
    set name [cap [$attrib getName]]
    # set type as value and as parameter
    # next line says:
    # generate type with header include,
    # look at modifier, use Value if modifier not set
        set type [$attrib ooplType]
    set t_val [generate $type inc "" Value]
        set obj_type [$type get_obj_type]
    if {$obj_type == "base_type" || $obj_type == "enum_type" ||
            ($obj_type == "typedef_type" && [$type getType3GL] != "")} {
        set t_par [generate $type fwd Value]
    } else {
        set t_par [generate $type fwd "Reference to Const"]
    }
    set iv [$attrib getPropertyValue initial_value]
    if { $iv != "" } {
        set dflt " /* = $iv */"
    } else {
        set dflt ""
    }
    # special treatment for char array
    if [type_is_char_array $type] {
        set tp_nm [gen_var_decl $type [$attrib getName]]
        $sect append "$static_string$tp_nm$dflt;\n"
    } else {
        $sect append "$static_string$t_val[$attrib getName]$dflt;\n"
    }
    data_attrib_initial_value $attrib $class
    set mdf [$attrib getPropertyValue modifier]
    if {$mdf != "" && $mdf != "Default"} {
        # when a modifier is specified
        # do not generate access funcs
        return
    }
    set sect [get_attrib_hdr_sect $attrib r]
    expand_text $sect {
        ~${static_string}~${t_par}get~${name}()~${const_string};
    }
    set sect [get_attrib_hdr_sect $attrib w]
    expand_text $sect {
        ~${static_string}void set~${name}(~${t_par}new~${name});
    }
    set sect [get_attrib_src_sect $attrib 1 r]
    expand_text $sect {
        inline ~${t_par}~[$class getName]::get~${name}()~${const_string}
        {
            return ~[$attrib getName];
        }

    }
    set sect [get_attrib_src_sect $attrib 1 w]
    expand_text $sect {
        inline void ~[$class getName]::set~${name}(~${t_par}new~${name})
        {
            ~[assign_var [$attrib getName] new${name} \
                     [$attrib ooplType] $sect]
        }

    }
}

# generate an initial value line

proc data_attrib_initial_value {attrib class} {
    set is_static 0
    if {[$attrib isClassFeature] == "1"} {
        set is_static 1
    } else {
        set is_static 0
    }
    set iv [$attrib getPropertyValue initial_value]
    set a_name [$attrib getName]
    set c_name [$class getName]
    if $is_static {
        set sect $cpp_sections(c_static_sect)
        set t_val [generate [$attrib ooplType] inc Value]
        $sect append "${t_val}$c_name::$a_name"
        if {$iv != ""} {
            $sect append " = $iv"
        } else {
            gen_def_init_val $attrib $sect
        }
        $sect append ";\n"
        return
    }
    if {$iv == ""} {
        return
    }

    set type [$attrib ooplType]
    if {[type_is_char_array $type] || [is_db_class $class]} {
        if [is_db_class $class] {
            set a_name "data.$a_name"
        }
        set sect $cpp_sections(c_ctor_body_iv_sect)
        $sect append "[assign_var $a_name $iv $type $sect]\n"
        return
    }
    append_ctor_iv_init $a_name $iv
}

# Returns the default initial value for $attrib
#
proc gen_def_init_val {attrib sect} {
    set type [$attrib ooplType]

    if {[$type get_obj_type] == "typedef_type"} {
        # search type def
        set type_class [$type ooplClass]

        if {[$type_class get_obj_type] != "class_generic_typedef"} {
            return
        }

        set attrib [$type_class genAssocAttrSet]
    }

    if {[$attrib get_obj_type] != "qual_assoc_attrib"} {
        return
    }
    set key [[$attrib qualifier] ooplType]
    set value [$attrib ooplType]
    if {[$attrib getMultiplicity] == "one"} {
        set result [dict::initializer "" $key $value]
    } else {
        set setpfx [set_prefix $attrib]
        set result [${setpfx}psdict::initializer "" $key $value]
    }
    $sect append $result
}


# produces 'mem(value)' in ctor initializers section

proc append_ctor_init {mem value} {
    ### to do: should also do char array test
    set sect $cpp_sections(c_ctor_init_sect)
    gen_ctor_sep $sect
    $sect append "${mem}($value)"
}

proc append_ctor_iv_init {mem value} {
    ### to do: should also do char array test
    set sect $cpp_sections(c_ctor_init_iv_sect)
    gen_ctor_iv_sep $sect
    $sect append "${mem}($value)"
}

# produce correct separator for constructor initializer part

proc gen_ctor_sep {sect} {
    global ctor_init_sep
    if $ctor_init_sep {
        set ctor_init_sep 0
        $sect append " :\n"
    } else {
        $sect append ",\n"
    }
}

proc gen_ctor_iv_sep {sect} {
    global ctor_init_iv_sep
    if $ctor_init_iv_sep {
        set ctor_init_iv_sep 0
        $sect indent +
    } else {
        $sect append ",\n"
    }
}

# Common generate dispatch function for associations
#
proc gen_for_assoc {attrib class} {
    set prefix "[$attrib get_obj_type]::[$attrib getMultiplicity]"
    ${prefix}_data $attrib
    ${prefix}_get $attrib $class
    ${prefix}_set_self $attrib $class
    ${prefix}_rm_self $attrib $class
    ${prefix}_dtor $attrib $class
    set type [$attrib ooplType]
    if {[$attrib opposite] != ""} {
        add_friend $type
        add_src_inc $type
    } else {
        add_forward $type
    }
}

# Common generate dispatch function for database associations
#
proc gen_for_db_assoc {attrib class} {
    set prefix "[$attrib get_obj_type]::[$attrib getMultiplicity]"
    ${prefix}_get $attrib $class
    ${prefix}_set $attrib $class
    ${prefix}_remove $attrib $class
    set type [$attrib ooplType]
    add_src_inc $type
    add_forward $type
}

# Common generate dispatch function for links
#
proc gen_for_link {attrib class} {
    set prefix "[$attrib get_obj_type]::[$attrib getMultiplicity]"
    ${prefix}_data $attrib
    ${prefix}_get $attrib $class
    set type [$attrib ooplType]
    if {[$attrib opposite] != ""} {
        add_friend $type
        add_src_inc $type
    } else {
        add_forward $type
    }
}

# Common generate dispatch function for reverse links
#
proc gen_for_rv_link {attrib class} {
    set prefix "[$attrib get_obj_type]::[$attrib getMultiplicity]"
    ${prefix}_data $attrib
    ${prefix}_get $attrib $class
    ${prefix}_dtor $attrib $class
    set type [$attrib ooplType]
    add_forward $type
}

# Dispatch functions for rm/set other
#
proc rm_other {attrib sect ptr} {
    set prefix "[$attrib get_obj_type]::[$attrib getMultiplicity]"
    ${prefix}_rm_other $attrib $sect $ptr
}

proc set_other {attrib sect ptr} {
    set prefix "[$attrib get_obj_type]::[$attrib getMultiplicity]"
    ${prefix}_set_other $attrib $sect $ptr
}

proc assoc_attrib::generate {attrib class} {
    gen_for_assoc $attrib $class
}

proc assign_var {to from type_obj {sect "src"}} {
    if [type_is_char_array $type_obj] {
                add_[determine_sect_type $sect]_inc_name "string" "h"
        return "strcpy($to, $from);"
    }
    return "$to = $from;"
}

proc assoc_attrib::one_typedef {attrib class} {
    set sect $cpp_sections(h_inl_sect)
    set name [$class getName]
    set type [$attrib ooplType]
    set type_nm [$type getName]
    ###add_forward $type
    # gen_var_decl does not deliver it the format we want, alas
    set dum [gen_var_decl $type $name]
    $sect append "typedef $type_nm *$name;\n"
}

proc assoc_attrib::one_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    set type [[$attrib ooplType] getName]
    set name [uncap [pointer_name [$attrib getName]]]
    $sect append "$type *$name;\n"
    if [$attrib isMandatory] {
        return
    }
    set sect $cpp_sections(c_ctor_body_iv_sect)
    $sect append "$name = 0;\n"
}

proc assoc_attrib::one_set_self {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib w]
    $sect append "void set${name}($type *new${name});\n"
    set sect [get_assoc_src_sect $attrib 0 w]
    $sect append "void $cl_name::set${name}($type *new${name})\n\{\n"
    $sect indent +
    set opposite [$attrib opposite]
    set ptr_name [uncap [pointer_name $name]]
    if {$opposite != ""} {
        $sect append "if ($ptr_name) \{\n"
        $sect indent +
        rm_other $opposite $sect $ptr_name
        $sect indent -
        $sect append "\}\n"
        set_other $opposite $sect new${name}
    }
    $sect append "$ptr_name = new${name};\n"
    $sect indent -
    $sect append "\}\n\n"
}

proc assoc_attrib::one_rm_self {attrib class} {
    if [$attrib isMandatory] {
        return
    }
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib w]
    $sect append "void remove${name}();\n"
    set sect [get_assoc_src_sect $attrib 0 w]
    $sect append "void $cl_name::remove${name}()\n\{\n"
    $sect indent +
    set opposite [$attrib opposite]
    set ptr_name [uncap [pointer_name $name]]
    if {$opposite != ""} {
        $sect append "if ($ptr_name) \{\n"
        $sect indent +
        rm_other $opposite $sect $ptr_name
        $sect indent -
        $sect append "\}\n"
    }
    $sect append "$ptr_name = 0;\n"
    $sect indent -
    $sect append "\}\n\n"
}

proc assoc_attrib::one_set_other {attrib sect ptr} {
    set name [$attrib getName]
    set ptrname [uncap [pointer_name $name]]
    $sect append "$ptr->$ptrname = this;\n"
}

proc assoc_attrib::one_rm_other {attrib sect ptr} {
    set name [$attrib getName]
    set ptr_name [uncap [pointer_name $name]]
    $sect append "$ptr->$ptr_name = 0;\n"
}

proc assoc_attrib::one_dtor {attrib class} {
    set opposite [$attrib opposite]
    if {$opposite != ""} {
        set ptr [uncap [pointer_name [$attrib getName]]]
        set sect $cpp_sections(c_dtor_sect)
        $sect append "if ($ptr) \{\n"
        $sect indent +
        rm_other $opposite $sect $ptr
        $sect indent -
        $sect append "\}\n"
    }
}

proc assoc_attrib::one_get {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib r]
    $sect append "$type *get${name}() const;\n"
    set sect [get_assoc_src_sect $attrib 1 r]
    $sect append "inline $type *$cl_name::get${name}"
    set ptr_name [uncap [pointer_name $name]]
    $sect append "() const\n\{\n\treturn $ptr_name;\n\}\n\n";
}

proc assoc_attrib::many_typedef {attrib class} {
    set sect $cpp_sections(h_inl_sect)
    set name [$class getName]
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_type_name [$attrib ooplType]]
    $sect append "typedef $type $name;\n"
}

proc assoc_attrib::many_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_type_name [$attrib ooplType]]
    set name [uncap [${setpfx}set_name [$attrib getName]]]
    $sect append "$type $name;\n"
}

proc assoc_attrib::many_set_self {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib w]
    $sect append "void add${name}($type *new${name});\n"
    set sect [get_assoc_src_sect $attrib 0 w]
    $sect append "void $cl_name::add${name}($type *new${name})\n\{\n"
    $sect indent +
    set opposite [$attrib opposite]
    set setpfx [set_prefix $attrib]
    set set_name [uncap [${setpfx}set_name $name]]
    set add_func [set ${setpfx}set::add]
    $sect append "$set_name.${add_func}(new${name});\n"
    if {$opposite != ""} {
        set_other $opposite $sect new${name}
    }
    $sect indent -
    $sect append "\}\n\n"
}

proc assoc_attrib::many_rm_self {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib w]
    $sect append "void remove${name}($type *old${name});\n"
    set sect [get_assoc_src_sect $attrib 0 w]
    $sect append "void $cl_name::remove${name}($type *old${name})\n\{\n"
    $sect indent +
    set opposite [$attrib opposite]
    set setpfx [set_prefix $attrib]
    set set_name [uncap [${setpfx}set_name $name]]
    set remove_func [set ${setpfx}set::remove]
    $sect append "$set_name.${remove_func}(old${name});\n"
    if {$opposite != ""} {
        rm_other $opposite $sect old${name}
    }
    $sect indent -
    $sect append "\}\n\n"
}

proc assoc_attrib::many_set_other {attrib sect ptr} {
    set setpfx [set_prefix $attrib]
    set name [uncap [${setpfx}set_name [$attrib getName]]]
    set add_func [set ${setpfx}set::add]
    $sect append "$ptr->$name.${add_func}(this);\n"
}

proc assoc_attrib::many_rm_other {attrib sect ptr} {
    set setpfx [set_prefix $attrib]
    set name [uncap [${setpfx}set_name [$attrib getName]]]
    set remove_func [set ${setpfx}set::remove]
    $sect append "$ptr->$name.${remove_func}(this);\n"
}

proc assoc_attrib::many_dtor {attrib class} {
    set opposite [$attrib opposite]
    if {$opposite != ""} {
        set sect $cpp_sections(c_dtor_sect)
        set type [[$attrib ooplType] getName]
        set name [$attrib getName]
        set action "rm_other $opposite $sect"
        set setpfx [set_prefix $attrib]
        ${setpfx}set::iter $sect $name $type $action
    }
}

proc assoc_attrib::many_get {attrib class} {
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_type_name [$attrib ooplType]]
    set name [cap [${setpfx}set_name [$attrib getName]]]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib r]
    $sect append "const $type& get${name}() const;\n"
    set sect [get_assoc_src_sect $attrib 1 r]
    $sect append "inline const $type& $cl_name::"
    $sect append "get${name}() const\n\{\n\treturn [uncap $name];\n\}\n\n"
}

proc get_qualifier_type {assoc modifier} {
    return [generate [[$assoc qualifier] ooplType] fwd $modifier]
}

proc get_qualifier_name {assoc} {
    return [[$assoc qualifier] getName]
}

proc qual_assoc_attrib::generate {attrib class} {
    gen_for_assoc $attrib $class
}

proc qual_assoc_attrib::one_typedef {attrib class} {
    set sect $cpp_sections(h_inl_sect)
    set name [$class getName]
    set type [dict_type_name [[$attrib qualifier] ooplType] \
        [$attrib ooplType]]
    $sect append "typedef $type $name;\n"
}

proc qual_assoc_attrib::one_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    set type [dict_type_name [[$attrib qualifier] ooplType] \
                 [$attrib ooplType]]
    set name [uncap [dict_name [$attrib getName]]]
    $sect append "$type $name;\n"

    set sect $cpp_sections(c_ctor_init_sect)
    set key [[$attrib qualifier] ooplType]
    set value [$attrib ooplType]
    set result [dict::initializer $name $key $value]
    if {$result == ""} {
        return
    }
    gen_ctor_sep $sect
    $sect append $result

}

proc qual_assoc_attrib::one_set_self {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set key [get_qualifier_name $attrib]
    set q_type [get_qualifier_type $attrib "Reference to Const"]
    set sect [get_assoc_hdr_sect $attrib w]
    $sect append \
        "void set${name}($q_type$key, $type *new${name});\n"
    set sect [get_assoc_src_sect $attrib 0 w]
    $sect append "void $cl_name::set${name}($q_type$key, "
    $sect append "$type *new${name})\n\{\n"
    $sect indent +
    set opposite [$attrib opposite]
    set dct_name [uncap [dict_name $name]]
    if {$opposite != ""} {
        set action "rm_other $opposite $sect"
        dict::get_test_and_act $sect $name $key $type $action
        set_other $opposite $sect new${name}
    }
    $sect append "$dct_name.${dict::set}($key, new${name});\n"
    $sect indent -
    $sect append "\}\n\n"
}

proc qual_assoc_attrib::one_rm_self {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set key [get_qualifier_name $attrib]
    set q_type [get_qualifier_type $attrib "Reference to Const"]
    set sect [get_assoc_hdr_sect $attrib w]
    $sect append "void remove${name}($q_type$key);\n"
    set sect [get_assoc_src_sect $attrib 0 w]
    $sect append "void $cl_name::remove${name}($q_type$key"
    $sect append ")\n\{\n"
    $sect indent +
    set opposite [$attrib opposite]
    set dct_name [uncap [dict_name $name]]
    set ptr_name [uncap [pointer_name $name]]
    if {$opposite != ""} {
        set action "rm_other $opposite $sect"
        dict::get_test_and_act $sect $name $key $type $action
    }
    $sect append "$dct_name.${dict::remove}($key);\n"
    $sect indent -
    $sect append "\}\n\n"
}

proc qual_assoc_attrib::one_set_other {attrib sect ptr} {
    set name [uncap [dict_name [$attrib getName]]]
    $sect append \
        "$ptr->$name.${dict::set}(/* supply key here */, this);\n"
}

proc qual_assoc_attrib::one_rm_other {attrib sect ptr} {
    set name [uncap [dict_name [$attrib getName]]]
    $sect append \
        "$ptr->$name.${dict::remove}(/* supply key here */);\n"
}

proc qual_assoc_attrib::one_dtor {attrib class} {
    set opposite [$attrib opposite]
    if {$opposite != ""} {
        set sect $cpp_sections(c_dtor_sect)
        set type [[$attrib ooplType] getName]
        set qual_type [[[$attrib qualifier] ooplType] getName]
        set name [$attrib getName]
        set action "rm_other $opposite $sect"
        dict::iter $sect $name $type $qual_type $action
    }
}

proc qual_assoc_attrib::one_get {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set key [get_qualifier_name $attrib]
    set q_type [get_qualifier_type $attrib "Reference to Const"]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib r]
    $sect append "$type *get${name}($q_type$key) const;\n"
    set sect [get_assoc_src_sect $attrib 1 r]
    $sect append "inline $type *$cl_name::get${name}"
    $sect append "($q_type$key) const\n\{\n"
    set dct_name [uncap [dict_name $name]]
    $sect indent +
    dict::get_and_return $sect $dct_name $key $type
    $sect indent -
    $sect append "\}\n\n"
}

proc qual_assoc_attrib::many_typedef {attrib class} {
    set sect $cpp_sections(h_inl_sect)
    set name [$class getName]
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_dict_type_name \
         [[$attrib qualifier] ooplType] [$attrib ooplType]]
    $sect append "typedef $type $name;\n"
}

proc qual_assoc_attrib::many_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_dict_type_name \
        [[$attrib qualifier] ooplType] [$attrib ooplType]]
    set name [uncap [${setpfx}set_dict_name [$attrib getName]]]
    $sect append "$type $name;\n"

    set sect $cpp_sections(c_ctor_init_sect)
    set key [[$attrib qualifier] ooplType]
    set value [$attrib ooplType]
    set result [${setpfx}psdict::initializer $name $key $value]
    if {$result == ""} {
        return
    }
    gen_ctor_sep $sect
    $sect append $result
}

proc qual_assoc_attrib::many_set_self {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set key [get_qualifier_name $attrib]
    set q_type [get_qualifier_type $attrib "Reference to Const"]
    set sect [get_assoc_hdr_sect $attrib w]
    $sect append "void add${name}($q_type$key, $type *new${name});\n"
    set sect [get_assoc_src_sect $attrib 0 w]
    $sect append "void $cl_name::add${name}($q_type$key, "
    $sect append "$type *new${name})\n\{\n"
    $sect indent +
    set setpfx [set_prefix $attrib]
    set sdct_name [uncap [${setpfx}set_dict_name [$attrib getName]]]
    set add_func [set ${setpfx}psdict::add]
    $sect append "$sdct_name.${add_func}($key, new${name});\n"

    set opposite [$attrib opposite]
    if {$opposite != ""} {
        set_other $opposite $sect new${name}
    }
    $sect indent -
    $sect append "\}\n\n"
}

proc qual_assoc_attrib::many_rm_self {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set cl_name [$class getName]
    set key [get_qualifier_name $attrib]
    set q_type [get_qualifier_type $attrib "Reference to Const"]
    set sect [get_assoc_hdr_sect $attrib w]
    $sect append "void remove${name}($q_type$key, $type *old${name});\n"
    set sect [get_assoc_src_sect $attrib 0 w]
    $sect append "void $cl_name::remove${name}($q_type$key"
    $sect append ", $type *old${name})\n\{\n"
    $sect indent +
    set opposite [$attrib opposite]
    if {$opposite != ""} {
        rm_other $opposite $sect old${name}
    }
    set setpfx [set_prefix $attrib]
    set sdct_name [uncap [${setpfx}set_dict_name [$attrib getName]]]
    set remove_func [set ${setpfx}psdict::remove]
    $sect append "$sdct_name.${remove_func}($key, old${name});\n"
    $sect indent -
    $sect append "\}\n\n"
}

proc qual_assoc_attrib::many_set_other {attrib sect ptr} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set setpfx [set_prefix $attrib]
    set sdct_name [uncap [${setpfx}set_dict_name $name]]
    set add_func [set ${setpfx}psdict::add]
    $sect append \
           "$ptr->$sdct_name.${add_func}(/* supply key here */, this);\n"
}

proc qual_assoc_attrib::many_rm_other {attrib sect ptr} {
    set type [[$attrib ooplType] getName]
    set name [cap [$attrib getName]]
    set setpfx [set_prefix $attrib]
    set sdct_name [uncap [${setpfx}set_dict_name $name]]
    set remove_func [set ${setpfx}psdict::remove]
    $sect append \
        "$ptr->$sdct_name.${remove_func}(/* supply key here */, this);\n"
}

proc qual_assoc_attrib::many_dtor {attrib class} {
    set opposite [$attrib opposite]
    if {$opposite != ""} {
        set sect $cpp_sections(c_dtor_sect)
        set type [$attrib ooplType]
        set q_type [string trimright [generate [ [$attrib qualifier]\
                        ooplType] inc Value]]
        set name [cap [$attrib getName]]
        set action "rm_other $opposite $sect"
        set setpfx [set_prefix $attrib]
        ${setpfx}psdict::iter $sect $name $type $q_type $action
    }
}

proc qual_assoc_attrib::many_get {attrib class} {
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_type_name [$attrib ooplType]]
    set name [cap [$attrib getName]]
    set key [get_qualifier_name $attrib]
    set q_type [get_qualifier_type $attrib "Reference to Const"]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib r]
    $sect append "$type *get${name}($q_type$key) const;\n"
    set sect [get_assoc_src_sect $attrib 1 r]
    $sect append "inline $type *$cl_name::get${name}"
    $sect append "($q_type$key) const\n\{\n"
    set sdct_name [uncap [${setpfx}set_dict_name $name]]
    $sect indent +
    ${setpfx}psdict::get_and_return $sect $name $key $type
    $sect indent -
    $sect append "\}\n\n"
}

proc operation::generate {oper class} {
    global cpp_error_state
    if [is_eq_db_ctor $oper $class] {
        # skip, will be generated with runtime system
        return
    }
    set h_sect [get_hdr_sect [$oper getPropertyValue method_access] user-defined]
    feature::gen_description $oper $h_sect
    set c_sect $cpp_sections(c_impl_sect)
    set tmp_c_sect [TextSection new]
    set name [map_oper [$oper getName]]
    set is_ctor [expr {$name == "create" && [$oper isClassFeature]== "1"}]
    set is_abstract [expr {[$oper isAbstract] == "1"}]
    set is_type_conv [expr {$name == "type_conv"}]
    if $is_ctor {
        set type ""
        set name [$class getName]
    } else {
        set type [generate [$oper ooplType] fwd "" Value]
    }
    set is_static [expr {[$oper isClassFeature] == "1"} && !$is_ctor]
    if $is_static {
        $h_sect append "static "
    }
    if {[$oper isDynBound] == "1" || $is_abstract} {
                if $is_static {
            puts "ERROR: static member function '[$class getName]::${name}()' cannot be virtual or abstract"
            set cpp_error_state 1
                }
        $h_sect append "virtual "
    }
    if $is_type_conv {
        if {$is_static} {
            puts "ERROR: '[$class getName]::operator ${type}()' cannot be static"
            set cpp_error_state 1
        }
        $h_sect append "operator ${type}("
        if {!$is_abstract} {
            $c_sect append "[$class getName]::operator ${type}("
        }
    } else {
        $h_sect append "${type}${name}("
        if {!$is_abstract} {
            $c_sect append "${type}[$class getName]::${name}"
            $tmp_c_sect append "("
        }
    }
    set params [get_parameters $oper]
    if {$is_type_conv && $params != ""} {
            puts "ERROR: '[$class getName]::operator ${type}()' cannot have parameters"
            set cpp_error_state 1
    }
    set first 1
    foreach param [get_parameters $oper] {
        generate $param $h_sect first
        set default [$param getPropertyValue default_value]
        if {$default != ""} {
                    if [default_value_allowed [get_parameters $oper] $param] {
            $h_sect append " = $default"
                    } else {
                        puts "WARNING: default value for parameter\
                            '[$param getName]' of\
                            '[$class getName]::[$oper getName]()' is not\n   \
                generated since this parameter is followed by parameters\
                            without\n    default values"
                    }
        }
    }
    if {!$is_abstract} {
        set first 1
        foreach param [get_parameters $oper] {
            generate $param $tmp_c_sect first
        }
        $tmp_c_sect append ")"
    }
    $h_sect append ")"
    set constStr ""
    if {[$oper isConstFunc] == "1"} {
        global cpp_error_state
        if $is_static {
            puts "ERROR: static member function '[$class getName]::${name}()' cannot be const"
            set cpp_error_state 1
        }
        if $is_ctor {
            puts "ERROR: constructor of class '[$class getName]' cannot be const"
            set cpp_error_state 1
        }
        set constStr " const"
        $h_sect append " const"
        if {!$is_abstract} {
            $tmp_c_sect append " const"
        }
    }
    if {$is_abstract} {
        $h_sect append " = 0"
    }
    $h_sect append ";\n"

    $c_sect appendSect $tmp_c_sect
    set method_type [$tmp_c_sect contents]

    if $is_abstract {
        return
    }

    # $c_sect append "\n"
    set impl_proc [string trim [$oper getPropertyValue method_impl]]
    if {$impl_proc == ""} {
        # get previously prepared body
        if $is_type_conv {
            get_method_body "operator $type" "()$constStr" $c_sect \
                                        "operator_[[$oper ooplType] getName]"
        } else {
            get_method_body $name $method_type $c_sect \
                                        [$oper getName]
        }
    } else {
        set impl_proc operation::$impl_proc
        if {[info procs $impl_proc] != ""} {
            $c_sect append "\n\{\n"
            $c_sect indent +
            $c_sect append [$impl_proc $oper $class $c_sect]
            $c_sect indent -
            $c_sect append "\}\n\n"
            regen_unset $name $method_type
        } else {
            puts stderr "WARNING: Tcl procedure " nonewline
            puts stderr "'$impl_proc' not found"
            # fall back to regeneration
            if $is_type_conv {
                get_method_body "operator $type" "()$constStr" $c_sect \
                                                "operator_[[$oper ooplType] getName]"
            } else {
                get_method_body $name $method_type $c_sect \
                                                [$oper getName]
            }
        }
    }
}

proc parameter::generate {param sect f} {
    upvar $f first

    if $first {
        set first 0
    } else {
        $sect append ", "
    }
    # if modifier is 'Value' then include else forward
    # (is there a better way to do this?)
    set type [$param ooplType]
    set mf [$type getPropertyValue modifier]
    if {$mf == "Value"} {
        set dc inc
    } else {
        set dc fwd
    }
    $sect append "[generate [$param ooplType] $dc][$param getName]"
}

proc base_type::generate {type decl {modifier ""} {default_modifier ""}} {
    set result [$type getType3GL]
    if [regexp {(var)?char\[[0-9][0-9]*]} $result] {
        return "const char *"
    }
    if {$default_modifier == ""} {
        set default_modifier Value
    }
    return [gen_modifier $result $type $modifier $default_modifier]
}

proc base_type::gen_var_decl {type name {col ""}} {
    set type [$type getType3GL]
    if [regsub {(var)?char\[} $type "char $name\[" type] {
        regexp {\[(.*)\]$} $type dummy index
        set index [expr {$index + 1}]
        regsub {\[(.*)\]$} $type "\[$index]" type
        return $type
    }
    return "$type $name"
}

proc class_type::generate {type decl {modifier ""} {default_modifier ""}} {
    set name [$type getName]
    if {$name == ""} {
        return "void "
    }
    if {$decl == "fwd"} {
        add_forward $type
        add_src_inc $type
    } else {
        add_hdr_inc $type
    }
    if {$default_modifier == ""} {
        global default_type_modifier
        set default_modifier $default_type_modifier
    }
    return [gen_modifier $name $type $modifier $default_modifier]
}

proc class_type::gen_var_decl {type name {col ""}} {
    add_forward $type
    return "[$type getName] $name"
}

proc typedef_type::generate {type decl {modifier ""} {default_modifier ""}} {
    if [type_is_char_array $type] {
        return [base_type::generate $type $decl $modifier $default_modifier]
    }
    set name [$type getName]
    if {$name == ""} {
        return "void "
    }
    add_hdr_inc $type
    if {$default_modifier == ""} {
            if {[$type getType3GL] == ""} {
        global default_type_modifier
        set default_modifier $default_type_modifier
            } else {
                set default_modifier Value
            }
    }
    return [gen_modifier $name $type $modifier $default_modifier]
}

proc typedef_type::gen_var_decl {type name {col ""}} {
    add_hdr_inc $type
    return "[$type getName] $name"
}

proc enum_type::generate {type decl {modifier ""} {default_modifier ""}} {
    set name [$type getName]
    if {$name == ""} {
        return "void "
    }
    add_hdr_inc $type
    if {$default_modifier == ""} {
        set default_modifier Value
    }
    return [gen_modifier $name $type $modifier $default_modifier]
}

proc enum_type::gen_var_decl {type name {col ""}} {
    add_hdr_inc $type
        if {$col != ""} {
            return "[$col getType3GL] $name"
        }
    return "[$type getName] $name"
}

proc generic_typedef_type::generate {type decl {modifier ""} {default_modifier ""}} {
    set name [$type getName]
    if {$name == ""} {
        return "void "
    }
    add_hdr_inc $type
    if {$default_modifier == ""} {
        global default_type_modifier
        set default_modifier $default_type_modifier
    }
    return [gen_modifier $name $type $modifier $default_modifier]
}

proc generic_typedef_type::gen_var_decl {type name {col ""}} {
    add_hdr_inc $type
    return "[$type getName] $name"
}

proc gen_modifier {name type modifier default_modifier} {
    if {$modifier != "Other" && $modifier != "" && \
                    [$type getPropertyValue other_modifier] != ""} {
        puts -nonewline "WARNING: type '$name' has Type Modifier "
        puts -nonewline "'$modifier'; ignoring Other Type Modifier "
        puts "'[$type getPropertyValue other_modifier]'"
    }
    case $modifier in {
        {Default ""}
        {
            set mf [$type getPropertyValue modifier]
            if {$mf != "" && $mf != "Default"} {
                return [gen_modifier $name $type \
                            $mf $default_modifier]
            }
            if {[$type getPropertyValue other_modifier] != ""} {
                puts stdout "WARNING: type '$name' has both 'Default' and 'Other Type Modifier' specified, using 'Other Type Modifier'"
                return [gen_modifier $name $type \
                            Other $default_modifier]
            }
        }
        {Reference} {return "$name &"}
        {"Reference to Const"} {return "const $name &"}
        {Pointer} {return "$name *"}
        {"Pointer to Const"} {return "const $name *"}
        {Value} {return "$name "}
        {Other}
        {
            set omf [$type getPropertyValue other_modifier]
            if {$omf != ""} {
                if [string match {*~$name*} $omf] {
                    set sect [TextSection new]
                    expand_text $sect $omf name $name
                    set result [$sect contents]
                    return $result
                }
                return "$name [$type getPropertyValue other_modifier] "
            }
        }
    }
    return [gen_modifier $name $type $default_modifier ""]
}


# Determine if all initializers for a class refer to a part of the key
# This is done by comparing the signature of all keys with that of all
# creation parameters
#
proc all_inits_are_keys {class} {
    set ctor_list ""
    foreach ct_param [$class fullCreationParamSet] {
        lappend ctor_list [[$ct_param ooplType] getType3GL]
    }
    set key_list ""
    foreach key [get_col_list [$class table] KEYS] {
        if {[$key getUniqueName] != $TYPE_ID_NM} {
            lappend key_list [$key getType3GL]
        }
    }
    return [expr {$ctor_list == $key_list}]
}

# test if a operation signature equals the
# database-runtime-constructor
#
proc is_eq_db_ctor {oper class} {
    set is_db [is_db_class $class]
    # easy tests first
    if {! $is_db || [$oper getName] != "create"}  {
        return 0
    }
    if {[$oper get_obj_type] == "constructor"} {
        set params [$class fullCreationParamSet]
    } else {
        set params [get_parameters $oper]
    }
    set keys [get_col_list [$class table] KEYS]
    # number of parameters must be equal
    # correct for extra key
    set lp [llength $params]
    incr lp
    if {$lp != [llength $keys]} {
        return 0
    }
    foreach param $params {
        set key [lvarpop keys]
        if {[$key getUniqueName] == $TYPE_ID_NM} {
            set key [lvarpop keys]
        }
        set key_t [string trim [$key getType3GL]]
        if [regexp {(var)?char\[[0-9][0-9]*]} $key_t] {
            set key_t "const char *"
        }
        set par_t [string trim [generate [$param ooplType] fwd]]
        if {$key_t != $par_t} {
            set type_obj [$param ooplType]
            if {[$type_obj get_obj_type] == "typedef_type" ||
                [$type_obj get_obj_type] == "enum_type"} {
                # param is typedef_type or enum_type
                if {[$type_obj getType3GL] != $key_t} {
                                    return 0
                                }

                global default_type_modifier
                set mod [$type_obj getPropertyValue modifier]

                                # the default type modifier is used for the
                                # database-runtime-constructor, so consider
                                # param/key equal if no modifier specified
                                if {$mod != "" && $mod != $default_type_modifier} {
                                    return 0
                }

                # OK
                continue
            }
            return 0
        }
        # OK, continue
    }
    return 1
}

proc constructor::generate {ctor class} {
    global exists_ctor
    set exists_ctor 1
    set is_db [is_db_class $class]
    if {$is_db} {
        if [is_eq_db_ctor $ctor $class] {
            # it wil be generated later
            global db_ctor_is_unique
            set db_ctor_is_unique 1
            return
        }
        # we have a double ctor !
    }
    set sect $cpp_sections(h_ctor_sect)
    gen_ctor_decl $class $sect 1
    $sect append ";\n"
    set sect $cpp_sections(c_ctor_init_sect)
    $sect append [$class getName]::
    gen_ctor_decl $class $sect 0
    $sect indent +
    if $is_db {
        gen_ctor_sep $sect
        $sect append "DBObject([$class getName]Str)"
    }
    set body $cpp_sections(c_ctor_body_sect)
    if $is_db {
        set table [$class table]
        gen_col_list $body $table NULL_AND_NO_INIT nullInd. " = -1;\n" ""
        gen_col_list $body $table NOT_NULL_OR_INIT nullInd. " = 0;\n" ""
        $body append "strcpy(data.$TYPE_ID_NM, getClassName());\n"
    }
    foreach init [$ctor fullInitializerSet] {
        generate $init $sect $body
    }
}

#
# Check if the given parameter is allowed to have a default value.
#
# This is the case if all parameters following this one have default values.
#
proc default_value_allowed {paramlist param} {
    set i [lsearch $paramlist $param]
    if {$i != -1} {
    foreach p [lrange $paramlist $i end] {
            if {[$p getPropertyValue default_value] == ""} {
                return 0
            }
    }
    }
    return 1
}

proc gen_ctor_decl {class sect with_default} {
    set class_nm [$class getName]
    $sect append "${class_nm}"
    set tmp_sect [TextSection new]
    $tmp_sect append "("
    set first 1
    foreach param [$class fullCreationParamSet] {
        ctor_param::generate $param $tmp_sect first
        set default [$param getPropertyValue default_value]
        if {$with_default && $default != "" &&
                    [default_value_allowed [$class fullCreationParamSet] $param]} {
            $tmp_sect append " = $default"
        }
    }
    $tmp_sect append ")"
    $sect appendSect $tmp_sect
    set method_type [$tmp_sect contents]
    ### quick hack
    global re_found_ctor
    if {$with_default && $re_found_ctor} {
        regen_unset $class_nm $method_type
    }
}

proc ctor_param::generate {param sect f} {
    upvar $f first
    if $first {
        set first 0
    } else {
        $sect append ", "
    }
    set type [$param ooplType]
    set mf [$type getPropertyValue modifier]
    if {$mf == "Value"} {
        set dc inc
    } else {
        set dc fwd
    }

        #
        # Check if this ctor param was generated because of a non-nullable
        # data attribute; if so, it must be added as a "const &" argument
        # to the constructor.  But only if it doesn't have a 3gl type,
        # because in this case the actual C++ type is a basic type.
        #
        if {[$param attrib] != "" && [$type getType3GL] == ""} {
        $sect append [generate $type $dc "" "Reference to Const"]
        } else {
        $sect append [generate $type $dc]
        }

    $sect append [$param getName]
}

proc attrib_init::generate {init init_sect body_sect} {
    ### hack !?
    set data_struct 0
    set attrib [$init attrib]
    if {[$attrib get_obj_type] == "db_data_attrib"} {
        set tgt "data.[[$attrib column] getUniqueName]"
        set data_struct 1
    } else {
        set tgt [$attrib getName]
    }
    if [type_is_char_array [$attrib ooplType]] {
                add_[determine_sect_type $body_sect]_inc_name "string" "h"
        $body_sect append "strcpy($tgt, [$init getName]);\n"
    } else {
        if $data_struct {
            $body_sect append "$tgt = [$init getName];\n"
            return
        }
        append_ctor_init $tgt [$init getName]
    }
}

proc assoc_init::generate {init init_sect body_sect} {
    gen_initializer [$init assoc] $init_sect \
        $body_sect [$init getName]
}

proc qual_init::generate {init init_sect body_sect} {
    set qual [$init qualifier]
    set from [$init getName]
    if {[$qual get_obj_type] == "db_qualifier"} {
        set to data.[[$qual column] getUniqueName]
        $body_sect append \
            "[assign_var $to $from [$qual ooplType] $body_sect]\n"
    }
    # non-db qualifier does not need initialization
}

proc sc_init::generate {init sect unused_sect} {
    gen_ctor_sep $sect
    $sect append "[[$init ooplClass] getName]("
    set nm_list ""
    foreach param [$init fullParameterSet] {
        lappend nm_list [$param getName]
    }
    $sect append "[join $nm_list ", "])"
}

proc inher_key_init::generate {init init_sect body_sect} {
    set col [$init key]
    set name [$col getUniqueName]
    if {$name == $TYPE_ID_NM} {
        return
    }
    set class_nm [[$init ooplClass] getName]
    set base_name [$col getForeignName]

    $body_sect append \
        "[assign_var data.$name $class_nm::data.$base_name $col $body_sect]\n"
}


# Generate code to call func for all bases
#
proc call_for_all_bases {class sect func} {
    set supers [$class genNodeSet]
    if [lempty $supers] {
        return
    }
    $sect append "\n"
    $sect indent +
    foreach super $supers {
        set name [$super getSuperClassName]
        expand_text $sect {
            if (~$name::~${func}() < 0)
                return -1;
        }
    }
    $sect indent -
}

proc get_root_class {class} {
    set supers [$class genNodeSet]
    if [lempty $supers] {
        return $class
    }
    return [get_root_class [[lindex $supers 0] superClass]]
}

proc rv_link_attrib::generate {attrib class} {
    # multiplicity should always be 'one' here
    gen_for_rv_link $attrib $class
}

proc rv_link_attrib::one_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    set type [[$attrib ooplType] getName]
    set name [reference_name [$attrib getName]]
    $sect append "$type& $name;\n"
}

proc rv_link_attrib::one_get {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [$attrib getName]
    set cl_name [$class getName]
    if [info exists cpp_sections(h_pub_func_assoc-access_sect)] {
        set sect $cpp_sections(h_pub_func_assoc-access_sect)
    } else {
        set sect $cpp_sections(h_pub_func_sect)
    }
    $sect append "$type& get[cap $name]() const;\n"
    set sect $cpp_sections(h_inl_sect)
    $sect append "inline $type& $cl_name::get[cap $name]"
    set ref_name [reference_name $name]
    $sect append "() const\n\{\n\treturn $ref_name;\n\}\n\n";
}

proc rv_link_attrib::one_dtor {attrib class} {
    set opposite [$attrib opposite]
    if {$opposite != ""} {
        set ref [reference_name [$attrib getName]]
        set sect $cpp_sections(c_dtor_sect)
        rm_other $opposite $sect $ref
    }
}

proc qual_link_attrib::generate {attrib class} {
    gen_for_link $attrib $class
}

proc qual_link_attrib::one_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    set type [dict_type_name [[$attrib qualifier] ooplType] \
                 [$attrib ooplType]]
    set name [uncap [dict_name \
        "[[$attrib ooplType] getName]Of[cap [$attrib getName]]"]]
    $sect append "$type $name;\n"
    set sect $cpp_sections(c_ctor_init_sect)
    set key [[$attrib qualifier] ooplType]
    set value [$attrib ooplType]
    set result [dict::initializer $name $key $value]
    if {$result == ""} {
        return
    }
    gen_ctor_sep $sect
    $sect append $result
}

proc qual_link_attrib::one_rm_other {attrib sect ref} {
    set name [uncap [dict_name \
        [[$attrib ooplType] getName]Of[cap [$attrib getName]]]]
    $sect append "$ref.$name.${dict::remove}(/* supply key here */);\n"
}

proc qual_link_attrib::one_set_other {attrib sect ref} {
    set name [uncap [dict_name \
        [[$attrib ooplType] getName]Of[cap [$attrib getName]]]]
    set qual [[$attrib qualifier] getName]
    $sect append "$ref.$name.${dict::set}($qual, this);\n"
}

proc qual_link_attrib::one_get {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap [[$attrib ooplType] getName]Of[cap [$attrib getName]]]
    set key [get_qualifier_name $attrib]
    set q_type [get_qualifier_type $attrib "Reference to Const"]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib r]
    $sect append "$type *get${name}($q_type$key) const;\n"
    set sect [get_assoc_src_sect $attrib 1 r]
    $sect append "inline $type *$cl_name::get${name}"
    $sect append "($q_type$key) const\n\{\n"
    set dct_name [uncap [dict_name $name]]
    $sect indent +
    dict::get_and_return $sect $dct_name $key $type
    $sect indent -
    $sect append "\}\n\n"
}

proc qual_link_attrib::many_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_dict_type_name \
        [[$attrib qualifier] ooplType] [$attrib ooplType]]
    set name [uncap [${setpfx}set_dict_name \
        [[$attrib ooplType] getName]Of[cap [$attrib getName]]]]
    $sect append "$type $name;\n"
    set sect $cpp_sections(c_ctor_init_sect)
    set key [[$attrib qualifier] ooplType]
    set value [$attrib ooplType]
    set result [${setpfx}psdict::initializer $name $key $value]
    if {$result == ""} {
        return
    }
    gen_ctor_sep $sect
    $sect append $result
}

proc qual_link_attrib::many_get {attrib class} {
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_type_name [$attrib ooplType]]
    set name [cap [[$attrib ooplType] getName]Of[cap [$attrib getName]]]
    set key [get_qualifier_name $attrib]
    set q_type [get_qualifier_type $attrib "Reference to Const"]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib r]
    $sect append "$type *get${name}($q_type$key) const;\n"
    set sect [get_assoc_src_sect $attrib 1 r]
    $sect append "inline $type *$cl_name::get${name}"
    $sect append "($q_type$key) const\n\{\n"
    $sect indent +
    ${setpfx}psdict::get_and_return $sect $name $key $type
    $sect indent -
    $sect append "\}\n\n"
}

proc qual_link_attrib::many_set_other {attrib sect ref} {
    set type [[$attrib ooplType] getName]
    set name [cap "${type}Of[cap [$attrib getName]]"]
    set qual [[$attrib qualifier] getName]
    set setpfx [set_prefix $attrib]
    set s_name [uncap [${setpfx}set_dict_name $name]]
    set add_func [set ${setpfx}psdict::add]
    $sect append "$ref.$s_name.${add_func}($qual, this);\n"
}

proc qual_link_attrib::many_rm_other {attrib sect ref} {
    set type [[$attrib ooplType] getName]
    set name [cap "${type}Of[cap [$attrib getName]]"]
    set setpfx [set_prefix $attrib]
    set s_name [uncap [${setpfx}set_dict_name $name]]
    set remove_func [set ${setpfx}psdict::remove]
    $sect append \
        "$ref.$s_name.${remove_func}(/* supply key here */, this);\n"
}

proc link_attrib::generate {attrib class} {
    gen_for_link $attrib $class
}

proc link_attrib::one_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }

    set type [[$attrib ooplType] getName]
    set name [uncap [pointer_name "${type}Of[cap [$attrib getName]]"]]
    $sect append "$type *$name;\n"
}

proc link_attrib::one_get {attrib class} {
    set type [[$attrib ooplType] getName]
    set name [cap "${type}Of[cap [$attrib getName]]"]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib r]
    $sect append "$type *get${name}() const;\n"
    set sect [get_assoc_src_sect $attrib 1 r]
    $sect append "inline $type *$cl_name::get${name}"
    set ptr_name [uncap [pointer_name $name]]
    $sect append "() const\n\{\n\treturn $ptr_name;\n\}\n\n";
}

proc link_attrib::one_rm_other {attrib sect ref} {
    set type [[$attrib ooplType] getName]
    set name [cap "${type}Of[cap [$attrib getName]]"]
    set ptr_name [uncap [pointer_name $name]]
    $sect append "$ref.$ptr_name = 0;\n"
}

proc link_attrib::one_set_other {attrib sect ref} {
    set type [[$attrib ooplType] getName]
    set name [cap "${type}Of[cap [$attrib getName]]"]
    set ptr_name [uncap [pointer_name $name]]
    $sect append "$ref.$ptr_name = this;\n"
}

proc link_attrib::many_data {attrib} {
    if [info exists cpp_sections(h_priv_data_assoc-storage_sect)] {
        set sect $cpp_sections(h_priv_data_assoc-storage_sect)
    } else {
        set sect $cpp_sections(h_priv_data_sect)
    }
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_type_name [$attrib ooplType]]
    set name [uncap [${setpfx}set_name "[[$attrib ooplType] getName]Of[cap [$attrib getName]]"]]
    $sect append "$type $name;\n"
}

proc link_attrib::many_get {attrib class} {
    set setpfx [set_prefix $attrib]
    set type [${setpfx}set_type_name [$attrib ooplType]]
    set name [cap [${setpfx}set_name "[[$attrib ooplType] getName]Of[cap [$attrib getName]]"]]
    set cl_name [$class getName]
    set sect [get_assoc_hdr_sect $attrib r]
    $sect append "const $type& get${name}() const;\n"
    set sect [get_assoc_src_sect $attrib 1 r]
    $sect append "inline const $type& $cl_name::"
    $sect append "get${name}() const\n\{\n\treturn [uncap $name];\n\}\n\n"
}

proc link_attrib::many_set_other {attrib sect ref} {
    set type [[$attrib ooplType] getName]
    set name [cap "${type}Of[cap [$attrib getName]]"]
    set setpfx [set_prefix $attrib]
    set s_name [uncap [${setpfx}set_name $name]]
    set add_func [set ${setpfx}set::add]
    $sect append "$ref.$s_name.${add_func}(this);\n"
}

proc link_attrib::many_rm_other {attrib sect ref} {
    set type [[$attrib ooplType] getName]
    set name [cap "${type}Of[cap [$attrib getName]]"]
    set setpfx [set_prefix $attrib]
    set s_name [uncap [${setpfx}set_name $name]]
    set remove_func [set ${setpfx}set::remove]
    $sect append "$ref.$s_name.${remove_func}(this);\n"
}

proc assoc_attrib::gen_initializer {attrib init_s body_s name} {
    gen_ctor_sep $init_s
    set ptrname [uncap [pointer_name [$attrib getName]]]
    $init_s append ${ptrname}(&[$attrib getName])
    set opposite [$attrib opposite]
    if {$opposite != ""} {
        set_other $opposite $body_s $ptrname
    }
}

proc rv_link_attrib::gen_initializer {attrib init_s body_s name} {
    gen_ctor_sep $init_s
    set refname [uncap [reference_name [$attrib getName]]]
    $init_s append ${refname}([$attrib getName])
    set opposite [$attrib opposite]
    if {$opposite != ""} {
        set_other $opposite $body_s $refname
        add_src_inc [$attrib ooplType]
    }
}

# Generate a C++ parameter declaration
#
proc gen_param_decl_cxx {section object selector {separator ", "}
               {newline ""}} {

    gen_param_decl_cxx_c $section [get_col_list $object $selector] \
                $separator $newline
}

proc gen_param_decl_cxx_c {section columns {separator ", "} {newline ""}} {

    if [lempty $columns] {
        return
    }
    set col [lvarpop columns]
    $section pushIndent
    $section append "[base_type::generate $col Value][$col getUniqueName]"
    set newpf $separator$newline
    foreach col $columns {
        $section append \
              "$newpf[base_type::generate $col Value][$col getUniqueName]"
    }
    $section popIndent
    $section append $newline
}

# Generate a check for the nullability of the columns of a link.  These columns
# are either ALL null or ALL not null, so it suffices to check only the
# first column.
#
proc gen_null_check {sect link ind_var {ret_val 0}} {
    set col [lindex [$link columnSet] 0]
    if {$ret_val == ""} {
        set space ""
    } else {
        set space " "
    }
    expand_text $sect {
        if (~$ind_var~[$col getUniqueName] == -1)
            return~${space}~$ret_val;
    }
}

proc is_db_class {class} {
    return [string match {db_*} [$class get_obj_type]]
}

proc class2tgtfiles {class src inc} {
    upvar $src src_f
    upvar $inc inc_f
    set is_db [is_db_class $class]
    if {$is_db} {
        set src_type $esqlcplus_type
    } else {
        set src_type $cplus_type
    }
    set class_name [class2file [$class getName]]
    set src_f $class_name.$src_type
    set inc_f $class_name.$hplus_type
}

# we want    'class_typedef'
#      or    'class_enum'
#      or    'class_generic_typedef'
proc is_special_class {class} {
    return [string match {*class_*} [$class get_obj_type]]
}

#
# Function to determine if a class can have subclasses.
#
# - for an class_enum this is never the case since it's not possible in
#   C++;
#
# - for a class_typedef this is so if the "source" type is a real class and
#   not a standard type;
#
# - for a class_generic_typedef this is so if the "source" type is a container
#   class, i.e. if its assoc attrib has multiplicity many or is qualified.
#
proc is_derivable_class {class} {
    switch [$class get_obj_type] {
        "class_enum" {
            return 0
        }
        "class_typedef" {
        set attrib [lindex [$class dataAttrSet] 0]
        if {[[$attrib ooplType] getType3GL] == ""} {
        return 1
        } else {
        return 0
            }
        }
        "class_generic_typedef" {
        set assoc [lindex [$class genAssocAttrSet] 0]
        if {[$assoc getMultiplicity] == "many" ||
        [string match {qual_*} [$assoc get_obj_type]]} {
        return 1
        } else {
        return 0
            }
    }
        default {
            return 1
        }
    }
}


global opermap
set opermap(operatorDIV)        operator/
set opermap(operatorASSIGN)        operator=
set opermap(operatorASS_PLUS)        operator+=
set opermap(operatorASS_MIN)        operator-=
set opermap(operatorASS_STAR)        operator*=
set opermap(operatorASS_DIV)        operator/=
set opermap(operatorASS_MOD)        operator%=
set opermap(operatorASS_CIRCUM)        operator^=
set opermap(operatorASS_AMPER)        operator&=
set opermap(operatorASS_PIPE)        operator|=
set opermap(operatorASS_LSHIFT)        operator<<=
set opermap(operatorASS_RSHIFT)        operator>>=
set opermap(operatorEQ)            operator==
set opermap(operatorNEQ)        operator!=
set opermap(operatorLE)            operator<=
set opermap(operatorGE)            operator>=
set opermap(operatorCOMMA)        operator,
set opermap(operatornew)        "operator new"
set opermap(operatordelete)        "operator delete"
set opermap(operatorFUNC)        operator()

proc map_oper {name} {
    if [info exists opermap($name)] {
        return $opermap($name)
    }
    return $name
}

# return set prefix "o" in case ordered set are needed
#
proc set_prefix {attrib} {
    if {[$attrib isOrdered] == "1"} {
        return o
    } else {
        return
    }
}