job:  #589  Merge branch 'master' into 589_returnstring

.//============================================================================
.// $RCSfile: q.class.pei.arc,v $
.//
.// Description:
.// This archetype file contains the functions for generating
.// preexisting instances initialization code.
.//
.// Notice:
.// (C) Copyright 1998-2013 Mentor Graphics Corporation
.//     All rights reserved.
.//
.// This document contains confidential and proprietary information and
.// property of Mentor Graphics Corp.  No part of this document may be
.// reproduced without the express written permission of Mentor Graphics Corp.
.//============================================================================
.//
.//
.//============================================================================
.// Initialize the instance subsystem.
.// Update the instance and link records with array index values
.// and container counts.
.// The mapping of the instances to a particular array index is
.// arbitrary.
.//============================================================================
.function PEIInstanceSubsystemInit
  .param inst_ref_set o_objs
  .//
  .for each o_obj in o_objs
    .select many i_inss related by o_obj->CSME_CIE[R2961]->I_INS[R2962]
    .// Check for preexisting instance population requirement.
    .// The class must have instances and also be colored.
    .assign i = cardinality i_inss
    .select one te_class related by o_obj->TE_CLASS[R2019]
    .if ( ( i > 0 ) and ( te_class.PEIsDefinedInData ) )
      .assign te_class.PEIsDefinedInData = TRUE
    .else
      .assign te_class.PEIsDefinedInData = FALSE
    .end if
    .//
    .assign i = 0
    .for each i_ins in i_inss
      .assign i_ins.Name = "${i}"
      .assign i = i + 1
    .end for
  .end for
.end function
.//
.//
.//============================================================================
.// Count the preexisting instances of the given type.
.// Return the number of preexisting instances for obj.
.//============================================================================
.function PEINumberOfPreexistingInstances
  .param inst_ref o_obj
  .select many i_inss related by o_obj->CSME_CIE[R2961]->I_INS[R2962]
  .assign attr_result = cardinality i_inss
  .// .assign msg =       "PEINumberOfPreexistingInstances is ${attr_result} "
  .// .assign msg = msg + "for ${o_obj.Name} (${o_obj.Key_Lett})"
  .// .print "${msg}"
.end function
.//
.//
.//=============================================================================
.// Generate initializers for preexisting instances.
.// We generate the initializers in array index order.  C initializers
.// will assume sequential ordering.
.//=============================================================================
.function PEIRenderInitializers
  .param inst_ref o_obj
  .assign attr_assset = ""
  .select any te_set from instances of TE_SET
  .select one te_class related by o_obj->TE_CLASS[R2019]
  .if ( te_class.PEIsDefinedInData )
    .assign inst_count = 0
    .select many i_inss related by o_obj->CSME_CIE[R2961]->I_INS[R2962]
    .assign i_inss_cardinality = cardinality i_inss
    .while ( inst_count < i_inss_cardinality )
      .for each i_ins in i_inss
        .if ( i_ins.Name == "$t{inst_count}" )
          .invoke initializercode = PEIRenderInitializerBody( i_ins, o_obj )
          .assign attr_assset = attr_assset + initializercode.assset
  { ${initializercode.result} }\
          .if ( last i_inss )

          .else
,
          .end if
          .break for
        .end if
      .end for
      .assign inst_count = inst_count + 1
    .end while .// inst_count
    .// If there is a need for relationship set containers, build them up.
    .if ( attr_assset != "" )
      .invoke rel_set_name = PEIGetRelationshipSetContainerName( te_class )
      .assign attr_assset = "static ${te_set.element_type} ${rel_set_name.result}[] = {\n" + attr_assset
      .assign attr_assset = "/* PEI relationship set containers.  */\n" + attr_assset
      .assign attr_assset = attr_assset + "\n};\n"
    .end if
  .end if
.end function
.//
.//
.//=============================================================================
.// Generate body of one preexisting instance initializer.
.// First, the initial state initializer is output.
.// The class instance attribute data variable values are generated
.// in the same order in which they appear in the application analysis OIM.
.// The relationship optimization initializers are then generated.
.//=============================================================================
.function PEIRenderInitializerBody
  .param inst_ref i_ins
  .param inst_ref o_obj
  .assign attr_result = ""
  .assign attr_assset = ""
  .//
  .// Generate state machine state (if needed).
  .//
  .invoke cs_init = PEIRenderInitializerBodyCurrentState( i_ins, o_obj )
  .assign attr_result = attr_result + cs_init.result
  .if ( "" != attr_result )
    .assign attr_result = attr_result + ", "
  .end if
  .//
  .// Generate the attribute value initializers.
  .//
  .select any te_attr related by o_obj->TE_CLASS[R2019]->TE_ATTR[R2061] where ( selected.prevID == 0 )
  .if ( not_empty te_attr )
    .select one o_attr related by te_attr->O_ATTR[R2033]
    .while ( not_empty te_attr )
      .if ( te_attr.translate )
        .select any i_avl related by i_ins->I_AVL[R2909] where ( selected.Attr_ID == o_attr.Attr_ID )
        .invoke avlcode = PEIRenderInitializerBodyAttribute( o_attr, i_avl )
        .assign attr_result = attr_result + avlcode.result
      .end if
      .//
      .// Advance to the next object attribute, if any.
      .select one te_attr related by te_attr->TE_ATTR[R2087.'succeeds']
      .//
      .// Generate comma separator.
      .if ( not_empty te_attr )
        .if ( te_attr.translate )
          .assign attr_result = attr_result + ", "
        .end if
      .end if
    .end while
  .end if
  .//
  .// Generate the association linkage (if needed).
  .//
  .invoke ass_init = PEIRenderInitializerBodyAssociation( i_ins, o_obj )
  .assign attr_result = attr_result + ass_init.result
  .assign attr_assset = attr_assset + ass_init.assset
  .//
.end function
.//
.//
.//=============================================================================
.// Generate initialization for a single attribute value.
.// Return the value as a string quoted correctly (if needed).
.//=============================================================================
.function PEIRenderInitializerBodyAttribute
  .param inst_ref o_attr
  .param inst_ref i_avl
  .assign attr_result = "0"
  .// Get the attribute data type.  Strings need to be quoted.
  .invoke r = GetAttributeCodeGenType( o_attr )
  .assign te_dt = r.result
  .if ( 4 == te_dt.Core_Typ )
    .// string
    .if ( empty i_avl )
      .// In absence of a populated attribute, use the attribute default value.
      .if ( "" != o_attr.DefaultValue )
        .assign attr_result = o_attr.DefaultValue
      .else
        .assign attr_result = """"""
      .end if
    .else
      .assign attr_result = """${i_avl.Value}"""
    .end if
  .else
    .if ( empty i_avl )
      .assign attr_result = "0"
    .else
      .assign attr_result = i_avl.Value
    .end if
  .end if
.end function
.//
.//
.//=============================================================================
.// Generate the optimized association linkage for this instance.
.// Select the relationship set for this object.  Loop through each one
.// generating linkage anywhere storage is provided (for pointer refs).
.// Get the multiplicity so we know whether we need sets or simple
.// pointers.
.// Do the right thing for each flavor of association, simple, reflexive,
.// associative and sub/super.
.// Return the static initializer body material.
.//=============================================================================
.function PEIRenderInitializerBodyAssociation
  .param inst_ref i_ins
  .param inst_ref o_obj
  .//
  .assign multiplicity = 0
  .assign attr_assset = ""
  .assign attr_result = ""
  .select many te_rels related by o_obj->R_OIR[R201]->R_REL[R201]->TE_REL[R2034]
  .if ( not_empty te_rels )
    .// Pre-order the relationships ascending by their relationship number.
    .// Note:  This decouples code generation from SQL table
    .//        insertion ordering internals.
    .invoke SortSetAscendingByAttr_Numb( te_rels )
    .assign rel_count = 0
    .assign rel_cardinality = cardinality te_rels
    .//
    .while ( rel_count < rel_cardinality )
      .for each te_rel in te_rels
        .if ( te_rel.Order == rel_count )
          .select one rel related by te_rel->R_REL[R2034]
          .if ( not te_rel.storage_needed )
            .break for
          .end if
          .// Simple relationship?
          .select one simple_rel related by rel->R_SIMP[R206]
          .if ( not_empty simple_rel )
            .select one participant related by simple_rel->R_PART[R207]
            .select one formalizer related by simple_rel->R_FORM[R208]
            .if ( empty formalizer )
              .print "\n\tRelationship R${rel.Numb} is not formalized!\n"
              .exit 101
            .end if
            .// Deal with reflexives.
            .if ( participant.Obj_ID == formalizer.Obj_ID )
              .invoke s = PEIRelInitSimpleReflexive( i_ins, o_obj, rel, participant, formalizer )
              .assign attr_result = attr_result + s.result
              .assign attr_assset = attr_assset + s.assset
            .else
              .// Get multiplicity to pass to the code generator.
              .if ( o_obj.Obj_ID == participant.Obj_ID )
                .assign multiplicity = formalizer.Mult
              .else
                .assign multiplicity = participant.Mult
              .end if
              .invoke s = PEIRelInitSimple( i_ins, o_obj, rel, multiplicity )
              .assign attr_result = attr_result + s.result
              .assign attr_assset = attr_assset + s.assset
            .end if .// reflexive
          .else
            .// elif Subtype-Supertype relationship?
            .select one r_subsup related by rel->R_SUBSUP[R206]
            .if ( not_empty r_subsup )
              .invoke s = PEIRelInitSubSuper( i_ins, o_obj, rel, r_subsup )
              .assign attr_result = attr_result + s.result
          .else
            .// elif Associative relationship?
            .select one assrel related by rel->R_ASSOC[R206]
            .if ( not_empty assrel )
              .invoke s = PEIRelInitAssociative( i_ins, o_obj, rel, assrel )
              .assign attr_result = attr_result + s.result
              .assign attr_assset = attr_assset + s.assset
          .else
            .// elif Composed relationship?
            .select one composed_rel related by rel->R_COMP[R206]
            .if ( not_empty composed_rel )
              .print "\nWARNING:  R${rel.Numb} is COMPOSITION - No code generated.\n"
              .invoke s = PEIRelInitComposed( o_obj, rel )
              .assign attr_result = attr_result + s.result
          .else
            .// elif Error: New subtype of R_REL or a corrupted model SQL...
            .print "ERROR:  Unknown association type:R${rel.Numb} for class '${o_obj.Name}' (${o_obj.Key_Lett})"
            .exit 101
          .end if  .// not_empty composed_rel
          .end if  .// not_empty associative_rel
          .end if  .// not_empty subtype_supertype_rel
          .end if  .// not_empty simp_rel
          .break for
        .end if
      .end for
      .assign rel_count = rel_count + 1
    .end while .// rel_count < rel_cardinality
  .end if .// not_empty rel_set
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for a simple association.
.// of multiplicity ONE.
.//=============================================================================
.function PEIRelInitSimple
  .param inst_ref i_ins
  .param inst_ref o_obj
  .param inst_ref r_rel
  .param integer multiplicity
  .//
  .assign attr_result = ""
  .assign attr_assset = ""
  .select any related_i_ins from instances of I_INS
  .//
  .// Find related instance index.
  .// Traverse the instance to link to instance chain
  .// to get the instance ArrayIndex.
  .if ( multiplicity == 0 )
    .// ONE
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
    .if ( empty related_i_ins )
      .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
      .select one related_i_ins related by i_lnk->I_LIP[R2902]->I_INS[R2958]
    .end if
    .if ( not_empty related_i_ins )
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .assign attr_result = ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
    .else
      .// not participating
      .assign attr_result = ", 0"
    .end if  .// not empty
  .else
    .// MANY
    .// Build linked list of containers pointing to related instances.
    .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select many related1_i_ins related by i_lnks->I_LIP[R2901]->I_INS[R2958]
    .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select many related2_i_inss related by i_lnks->I_LIP[R2902]->I_INS[R2958]
    .assign related_i_inss = related1_i_ins | related2_i_inss
    .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
    .assign attr_result = attr_result + s.result
    .assign attr_assset = attr_assset + s.assset
  .end if
  .//
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for a simple reflexive
.// association.
.// In the reflexive case, the part and form are aligned with R2901 and R2902.
.//=============================================================================
.function PEIRelInitSimpleReflexive
  .param inst_ref i_ins
  .param inst_ref o_obj
  .param inst_ref r_rel
  .param inst_ref r_part
  .param inst_ref r_form
  .//
  .assign attr_result = ""
  .assign attr_assset = ""
  .select one related_te_class related by o_obj->TE_CLASS[R2019]
  .select any related_i_ins from instances of I_INS
  .//
  .// Link the formalizer to the participant.
  .//
  .if ( r_part.Mult == 0 )
    .// ONE
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
    .if ( not_empty related_i_ins )
      .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
    .else
      .// Not participating.
      .assign attr_result = attr_result + ", 0"
    .end if
  .else
    .// MANY
    .// Build linked list of containers pointing to related instances.
    .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select many related_i_inss related by i_lnks->I_LIP[R2901]->I_INS[R2958]
    .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
    .assign attr_result = attr_result + s.result
    .assign attr_assset = attr_assset + s.assset
  .end if
  .//
  .// Now link the participant to the formalizer(s).
  .//
  .if ( r_form.Mult == 0 )
    .// ONE
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select one related_i_ins related by i_lnk->I_LIP[R2902]->I_INS[R2958]
    .if ( not_empty related_i_ins )
      .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
    .else
      .// Not participating.
      .assign attr_result = attr_result + ", 0"
    .end if
  .else
    .// MANY
    .// Build linked list of containers pointing to related instances.
    .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select many related_i_inss related by i_lnks->I_LIP[R2902]->I_INS[R2958]
    .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
    .assign attr_result = attr_result + s.result
    .assign attr_assset = attr_assset + s.assset
  .end if
  .//
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for an associative
.// relationship.
.// In the reflexive case, R2901 and R2902 will jive with AONE and AOTH.
.// In the non-reflexive, we compare the instance Obj_ID with the
.// AONE/AOTH Obj_ID.
.//=============================================================================
.function PEIRelInitAssociative
  .param inst_ref i_ins
  .param inst_ref o_obj
  .param inst_ref r_rel
  .param inst_ref r_assoc
  .//
  .assign attr_result = ""
  .assign attr_assset = ""
  .select one aone related by r_assoc->R_AONE[R209]
  .select one aoth related by r_assoc->R_AOTH[R210]
  .select one assr related by r_assoc->R_ASSR[R211]
  .//
  .// The other associated instance.
  .//
  .if ( o_obj.Obj_ID == aoth.Obj_ID )
    .// Optimize relationship to associator.
    .if ( ( aone.Mult == 0 ) and ( assr.Mult == 0 ) )
      .// ONE
      .select any i_lnk from instances of I_LNK where ( false )
      .if ( aone.Obj_ID == aoth.Obj_ID )
        .// reflexive
        .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
      .else
        .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
        .if ( empty i_lnk )
          .select one related_o_obj related by i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
          .if ( related_o_obj.Obj_ID == aoth.Obj_ID )
            .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
          .end if
        .end if  .// not empty
      .end if .// reflexive
      .if ( not_empty i_lnk )
        .select one related_i_ins related by i_lnk->I_LIP[R2903]->I_INS[R2958]
        .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
        .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
        .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
      .else
        .// not participating
        .assign attr_result = attr_result + ", 0"
      .end if  .// not empty
    .else
      .// MANY
      .// Build linked list of containers pointing to related instances.
      .select many i_lnks from instances of I_LNK where ( false )
      .select many related_i_inss from instances of I_INS where ( false )
      .if ( aone.Obj_ID == aoth.Obj_ID )
        .// reflexive
        .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
      .else
        .select many one_i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
        .select many two_i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
        .assign i_lnks = one_i_lnks | two_i_lnks
      .end if
      .select many related_i_inss related by i_lnks->I_LIP[R2903]->I_INS[R2958]
      .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
      .assign attr_result = attr_result + s.result
      .assign attr_assset = attr_assset + s.assset
    .end if
  .end if
  .//
  .// The one associated instance.
  .//
  .if ( o_obj.Obj_ID == aone.Obj_ID )
    .// Optimize relationship to associator.
    .if ( ( aoth.Mult == 0 ) and ( assr.Mult == 0 ) )
      .// ONE
      .select any i_lnk from instances of I_LNK where ( false )
      .if ( aone.Obj_ID == aoth.Obj_ID )
        .// reflexive
        .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
      .else
        .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
        .if ( empty i_lnk )
          .select one related_o_obj related by i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
          .if ( related_o_obj.Obj_ID == aone.Obj_ID )
            .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
          .end if
        .end if
      .end if .// reflexive
      .if ( not_empty i_lnk )
        .select one related_i_ins related by i_lnk->I_LIP[R2903]->I_INS[R2958]
        .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
        .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
        .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
      .else
        .// not participating
        .assign attr_result = attr_result + ", 0"
      .end if  .// not empty
    .else
      .// MANY
      .// Build linked list of containers pointing to related instances.
      .select many i_lnks from instances of I_LNK where ( false )
      .select many related_i_inss from instances of I_INS where ( false )
      .if ( aone.Obj_ID == aoth.Obj_ID )
        .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
      .else
        .select many one_i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
        .select many two_i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
        .assign i_lnks = one_i_lnks | two_i_lnks
      .end if
      .select many related_i_inss related by i_lnks->I_LIP[R2903]->I_INS[R2958]
      .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
      .assign attr_result = attr_result + s.result
      .assign attr_assset = attr_assset + s.assset
    .end if
  .end if
  .//
  .// The associative instance.
  .//
  .if ( o_obj.Obj_ID == assr.Obj_ID )
    .// Optimize relationship to both associates.
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2903] where ( selected.Rel_ID == r_rel.Rel_ID )
    .if ( not_empty i_lnk )
      .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .select one related2_i_ins related by i_lnk->I_LIP[R2902]->I_INS[R2958]
      .select one related2_o_obj related by related2_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related2_te_class related by related2_o_obj->TE_CLASS[R2019]
      .if ( ( aone.Obj_ID == aoth.Obj_ID ) or ( related2_o_obj.Obj_ID == aone.Obj_ID ) )
        .assign attr_result = attr_result + ", &${related2_te_class.GeneratedName}_instances[${related2_i_ins.Name}]"
        .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
      .else
        .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
        .assign attr_result = attr_result + ", &${related2_te_class.GeneratedName}_instances[${related2_i_ins.Name}]"
      .end if
    .else
      .// not participating
      .assign attr_result = attr_result + ", 0, 0"
    .end if  .// not empty
  .end if
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for a Subtype/Supertype
.// association.
.//=============================================================================
.function PEIRelInitSubSuper
  .param inst_ref i_ins
  .param inst_ref o_obj
  .param inst_ref r_rel
  .param inst_ref r_subsup
  .assign attr_result = ""
  .//
  .// Find related instance index.
  .// Traverse the instance to link to instance chain
  .// to get the instance ArrayIndex.
  .select one super related by r_subsup->R_SUPER[R212]
  .if ( o_obj.Obj_ID == super.Obj_ID )
    .// Supertype
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select one related_i_ins related by i_lnk->I_LIP[R2902]->I_INS[R2958]
    .if ( empty i_lnk )
      .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
      .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
    .end if
    .if ( not_empty i_lnk )
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .assign attr_result = ", (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], ${related_te_class.system_class_number}"
    .else
      .// not participating
      .assign attr_result = ", 0, 0"
    .end if
  .else
    .// Subtype
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .if ( not_empty i_lnk )
      .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .assign attr_result = ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
    .else
      .// not participating
      .assign attr_result = ", 0"
    .end if
  .end if
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for a composed association.
.//=============================================================================
.function PEIRelInitComposed
  .param inst_ref o_obj
  .param inst_ref r_rel
  .assign attr_result = ""
.end function
.//
.//
.//=============================================================================
.// Generate an initializer for the current state attribute if needed.
.//=============================================================================
.function PEIRenderInitializerBodyCurrentState
  .param inst_ref i_ins
  .param inst_ref o_obj
  .assign attr_result = ""
  .select one te_state related by i_ins->SM_STATE[R2915]->TE_STATE[R2037]
  .if ( not_empty te_state )
    .assign attr_result = te_state.enumerator
  .end if
.end function
.//
.//
.//=============================================================================
.// Render relationship MANY optimization.
.// This helper is used to render the code used to optimize a relationship
.// set.  The set variable is generated for inside the instance structure.
.// The linked list body pointing to related instances is also generated.
.//=============================================================================
.function PEIRenderRelationshipManyOptimization
  .param inst_ref_set i_inss
  .param inst_ref o_obj
  .//
  .assign attr_result = ""
  .assign attr_assset = ""
  .select any te_sys from instances of TE_SYS
  .// i_inss, o_obj
  .assign instance_count = cardinality i_inss
  .if ( instance_count > 0 )
    .select one te_class related by o_obj->TE_CLASS[R2019]
    .assign ContainerIndex = te_class.ContainerIndex
    .// A container index starting greater than zero means we are not the
    .// first (instance) to be adding linked lists.  Precede with comma.
    .if ( ContainerIndex > 0 )
      .assign attr_assset = ",\n"
    .end if
    .invoke rel_set_name = PEIGetRelationshipSetContainerName( te_class )
    .assign attr_result = ", { &${rel_set_name.result}[${ContainerIndex}] }"
    .for each related_i_ins in i_inss
      .assign ContainerIndex = ContainerIndex + 1
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .if ( last i_inss )
        .if ( te_sys.CollectionsFlavor == 20 )
          .assign icount = cardinality i_inss
          .if ( icount > 1 )
            .assign attr_assset = attr_assset + "  { 0, (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], &${rel_set_name.result}[${ContainerIndex} - 2] }"
          .else
            .assign attr_assset = attr_assset + "  { 0, (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], 0 }"
          .end if .// cardinality i_inss > 1
        .else
          .assign attr_assset = attr_assset + "  { 0, (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}] }"
        .end if
      .elif ( first i_inss )
        .if ( te_sys.CollectionsFlavor == 20 )
          .assign attr_assset = attr_assset + "  { &${rel_set_name.result}[${ContainerIndex}], (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], 0 },\n"
        .else
          .assign attr_assset = attr_assset + "  { &${rel_set_name.result}[${ContainerIndex}], (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}] },\n"
        .end if
      .else
        .if ( te_sys.CollectionsFlavor == 20 )
          .assign attr_assset = attr_assset + "  { &${rel_set_name.result}[${ContainerIndex}], (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], &${rel_set_name.result}[${ContainerIndex} - 2] },\n"
        .else
          .assign attr_assset = attr_assset + "  { &${rel_set_name.result}[${ContainerIndex}], (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}] },\n"
        .end if
      .end if
    .end for
    .assign te_class.ContainerIndex = ContainerIndex
  .else
    .// Empty relationship set.
    .assign attr_result = ", { 0 }"
  .end if
.end function
.//

.//============================================================================
.// $RCSfile: q.class.pei.arc,v $
.//
.// Description:
.// This archetype file contains the functions for generating
.// preexisting instances initialization code.
.//
.// Notice:
.// (C) Copyright 1998-2013 Mentor Graphics Corporation
.//     All rights reserved.
.//
.// This document contains confidential and proprietary information and
.// property of Mentor Graphics Corp.  No part of this document may be
.// reproduced without the express written permission of Mentor Graphics Corp.
.//============================================================================
.//
.//
.//============================================================================
.// Initialize the instance subsystem.
.// Update the instance and link records with array index values
.// and container counts.
.// The mapping of the instances to a particular array index is
.// arbitrary.
.//============================================================================
.function PEIInstanceSubsystemInit
  .param inst_ref_set o_objs
  .//
  .for each o_obj in o_objs
    .select many i_inss related by o_obj->CSME_CIE[R2961]->I_INS[R2962]
    .// Check for preexisting instance population requirement.
    .// The class must have instances and also be colored.
    .assign i = cardinality i_inss
    .select one te_class related by o_obj->TE_CLASS[R2019]
    .if ( ( i > 0 ) and ( te_class.PEIsDefinedInData ) )
      .assign te_class.PEIsDefinedInData = TRUE
    .else
      .assign te_class.PEIsDefinedInData = FALSE
    .end if
    .//
    .assign i = 0
    .for each i_ins in i_inss
      .assign i_ins.Name = "${i}"
      .assign i = i + 1
    .end for
  .end for
.end function
.//
.//
.//============================================================================
.// Count the preexisting instances of the given type.
.// Return the number of preexisting instances for obj.
.//============================================================================
.function PEINumberOfPreexistingInstances
  .param inst_ref o_obj
  .select many i_inss related by o_obj->CSME_CIE[R2961]->I_INS[R2962]
  .assign attr_result = cardinality i_inss
  .// .assign msg =       "PEINumberOfPreexistingInstances is ${attr_result} "
  .// .assign msg = msg + "for ${o_obj.Name} (${o_obj.Key_Lett})"
  .// .print "${msg}"
.end function
.//
.//
.//=============================================================================
.// Generate initializers for preexisting instances.
.// We generate the initializers in array index order.  C initializers
.// will assume sequential ordering.
.//=============================================================================
.function PEIRenderInitializers
  .param inst_ref o_obj
  .assign attr_assset = ""
  .select any te_set from instances of TE_SET
  .select one te_class related by o_obj->TE_CLASS[R2019]
  .if ( te_class.PEIsDefinedInData )
    .assign inst_count = 0
    .select many i_inss related by o_obj->CSME_CIE[R2961]->I_INS[R2962]
    .assign i_inss_cardinality = cardinality i_inss
    .while ( inst_count < i_inss_cardinality )
      .for each i_ins in i_inss
        .if ( i_ins.Name == "$t{inst_count}" )
          .invoke initializercode = PEIRenderInitializerBody( i_ins, o_obj )
          .assign attr_assset = attr_assset + initializercode.assset
  { ${initializercode.result} }\
          .if ( last i_inss )

          .else
,
          .end if
          .break for
        .end if
      .end for
      .assign inst_count = inst_count + 1
    .end while .// inst_count
    .// If there is a need for relationship set containers, build them up.
    .if ( attr_assset != "" )
      .invoke rel_set_name = PEIGetRelationshipSetContainerName( te_class )
      .assign attr_assset = "static ${te_set.element_type} ${rel_set_name.result}[] = {\n" + attr_assset
      .assign attr_assset = "/* PEI relationship set containers.  */\n" + attr_assset
      .assign attr_assset = attr_assset + "\n};\n"
    .end if
  .end if
.end function
.//
.//
.//=============================================================================
.// Generate body of one preexisting instance initializer.
.// First, the initial state initializer is output.
.// The class instance attribute data variable values are generated
.// in the same order in which they appear in the application analysis OIM.
.// The relationship optimization initializers are then generated.
.//=============================================================================
.function PEIRenderInitializerBody
  .param inst_ref i_ins
  .param inst_ref o_obj
  .assign attr_result = ""
  .assign attr_assset = ""
  .//
  .// Generate state machine state (if needed).
  .//
  .invoke cs_init = PEIRenderInitializerBodyCurrentState( i_ins, o_obj )
  .assign attr_result = attr_result + cs_init.result
  .if ( "" != attr_result )
    .assign attr_result = attr_result + ", "
  .end if
  .//
  .// Generate the attribute value initializers.
  .//
  .select any te_attr related by o_obj->TE_CLASS[R2019]-TE_ATTR[R2061] where ( selected.prevID == 0 )
  .if ( not_empty te_attr )
    .select one o_attr related by te_attr->O_ATTR[R2033]
    .while ( not_empty te_attr )
      .if ( te_attr.translate )
        .select any i_avl related by i_ins->I_AVL[R2909] where ( selected.Attr_ID == o_attr.Attr_ID )
        .invoke avlcode = PEIRenderInitializerBodyAttribute( o_attr, i_avl )
        .assign attr_result = attr_result + avlcode.result
      .end if
      .//
      .// Advance to the next object attribute, if any.
      .select one te_attr related by te_attr->TE_ATTR[R2087.'succeeds']
      .//
      .// Generate comma separator.
      .if ( not_empty te_attr )
        .if ( te_attr.translate )
          .assign attr_result = attr_result + ", "
        .end if
      .end if
    .end while
  .end if
  .//
  .// Generate the association linkage (if needed).
  .//
  .invoke ass_init = PEIRenderInitializerBodyAssociation( i_ins, o_obj )
  .assign attr_result = attr_result + ass_init.result
  .assign attr_assset = attr_assset + ass_init.assset
  .//
.end function
.//
.//
.//=============================================================================
.// Generate initialization for a single attribute value.
.// Return the value as a string quoted correctly (if needed).
.//=============================================================================
.function PEIRenderInitializerBodyAttribute
  .param inst_ref o_attr
  .param inst_ref i_avl
  .assign attr_result = "0"
  .// Get the attribute data type.  Strings need to be quoted.
  .invoke r = GetAttributeCodeGenType( o_attr )
  .assign te_dt = r.result
  .if ( 4 == te_dt.Core_Typ )
    .// string
    .if ( empty i_avl )
      .// In absence of a populated attribute, use the attribute default value.
      .if ( "" != o_attr.DefaultValue )
        .assign attr_result = o_attr.DefaultValue
      .else
        .assign attr_result = """"""
      .end if
    .else
      .assign attr_result = """${i_avl.Value}"""
    .end if
  .else
    .if ( empty i_avl )
      .assign attr_result = "0"
    .else
      .assign attr_result = i_avl.Value
    .end if
  .end if
.end function
.//
.//
.//=============================================================================
.// Generate the optimized association linkage for this instance.
.// Select the relationship set for this object.  Loop through each one
.// generating linkage anywhere storage is provided (for pointer refs).
.// Get the multiplicity so we know whether we need sets or simple
.// pointers.
.// Do the right thing for each flavor of association, simple, reflexive,
.// associative and sub/super.
.// Return the static initializer body material.
.//=============================================================================
.function PEIRenderInitializerBodyAssociation
  .param inst_ref i_ins
  .param inst_ref o_obj
  .//
  .assign multiplicity = 0
  .assign attr_assset = ""
  .assign attr_result = ""
  .select many te_rels related by o_obj->R_OIR[R201]->R_REL[R201]->TE_REL[R2034]
  .if ( not_empty te_rels )
    .// Pre-order the relationships ascending by their relationship number.
    .// Note:  This decouples code generation from SQL table
    .//        insertion ordering internals.
    .invoke SortSetAscendingByAttr_Numb( te_rels )
    .assign rel_count = 0
    .assign rel_cardinality = cardinality te_rels
    .//
    .while ( rel_count < rel_cardinality )
      .for each te_rel in te_rels
        .if ( te_rel.Order == rel_count )
          .select one rel related by te_rel->R_REL[R2034]
          .if ( not te_rel.storage_needed )
            .break for
          .end if
          .// Simple relationship?
          .select one simple_rel related by rel->R_SIMP[R206]
          .if ( not_empty simple_rel )
            .select one participant related by simple_rel->R_PART[R207]
            .select one formalizer related by simple_rel->R_FORM[R208]
            .if ( empty formalizer )
              .print "\n\tRelationship R${rel.Numb} is not formalized!\n"
              .exit 101
            .end if
            .// Deal with reflexives.
            .if ( participant.Obj_ID == formalizer.Obj_ID )
              .invoke s = PEIRelInitSimpleReflexive( i_ins, o_obj, rel, participant, formalizer )
              .assign attr_result = attr_result + s.result
              .assign attr_assset = attr_assset + s.assset
            .else
              .// Get multiplicity to pass to the code generator.
              .if ( o_obj.Obj_ID == participant.Obj_ID )
                .assign multiplicity = formalizer.Mult
              .else
                .assign multiplicity = participant.Mult
              .end if
              .invoke s = PEIRelInitSimple( i_ins, o_obj, rel, multiplicity )
              .assign attr_result = attr_result + s.result
              .assign attr_assset = attr_assset + s.assset
            .end if .// reflexive
          .else
            .// elif Subtype-Supertype relationship?
            .select one r_subsup related by rel->R_SUBSUP[R206]
            .if ( not_empty r_subsup )
              .invoke s = PEIRelInitSubSuper( i_ins, o_obj, rel, r_subsup )
              .assign attr_result = attr_result + s.result
          .else
            .// elif Associative relationship?
            .select one assrel related by rel->R_ASSOC[R206]
            .if ( not_empty assrel )
              .invoke s = PEIRelInitAssociative( i_ins, o_obj, rel, assrel )
              .assign attr_result = attr_result + s.result
              .assign attr_assset = attr_assset + s.assset
          .else
            .// elif Composed relationship?
            .select one composed_rel related by rel->R_COMP[R206]
            .if ( not_empty composed_rel )
              .print "\nWARNING:  R${rel.Numb} is COMPOSITION - No code generated.\n"
              .invoke s = PEIRelInitComposed( o_obj, rel )
              .assign attr_result = attr_result + s.result
          .else
            .// elif Error: New subtype of R_REL or a corrupted model SQL...
            .print "ERROR:  Unknown association type:R${rel.Numb} for class '${o_obj.Name}' (${o_obj.Key_Lett})"
            .exit 101
          .end if  .// not_empty composed_rel
          .end if  .// not_empty associative_rel
          .end if  .// not_empty subtype_supertype_rel
          .end if  .// not_empty simp_rel
          .break for
        .end if
      .end for
      .assign rel_count = rel_count + 1
    .end while .// rel_count < rel_cardinality
  .end if .// not_empty rel_set
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for a simple association.
.// of multiplicity ONE.
.//=============================================================================
.function PEIRelInitSimple
  .param inst_ref i_ins
  .param inst_ref o_obj
  .param inst_ref r_rel
  .param integer multiplicity
  .//
  .assign attr_result = ""
  .assign attr_assset = ""
  .select any related_i_ins from instances of I_INS
  .//
  .// Find related instance index.
  .// Traverse the instance to link to instance chain
  .// to get the instance ArrayIndex.
  .if ( multiplicity == 0 )
    .// ONE
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
    .if ( empty related_i_ins )
      .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
      .select one related_i_ins related by i_lnk->I_LIP[R2902]->I_INS[R2958]
    .end if
    .if ( not_empty related_i_ins )
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .assign attr_result = ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
    .else
      .// not participating
      .assign attr_result = ", 0"
    .end if  .// not empty
  .else
    .// MANY
    .// Build linked list of containers pointing to related instances.
    .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select many related1_i_ins related by i_lnks->I_LIP[R2901]->I_INS[R2958]
    .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select many related2_i_inss related by i_lnks->I_LIP[R2902]->I_INS[R2958]
    .assign related_i_inss = related1_i_ins | related2_i_inss
    .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
    .assign attr_result = attr_result + s.result
    .assign attr_assset = attr_assset + s.assset
  .end if
  .//
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for a simple reflexive
.// association.
.// In the reflexive case, the part and form are aligned with R2901 and R2902.
.//=============================================================================
.function PEIRelInitSimpleReflexive
  .param inst_ref i_ins
  .param inst_ref o_obj
  .param inst_ref r_rel
  .param inst_ref r_part
  .param inst_ref r_form
  .//
  .assign attr_result = ""
  .assign attr_assset = ""
  .select one related_te_class related by o_obj->TE_CLASS[R2019]
  .select any related_i_ins from instances of I_INS
  .//
  .// Link the formalizer to the participant.
  .//
  .if ( r_part.Mult == 0 )
    .// ONE
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
    .if ( not_empty related_i_ins )
      .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
    .else
      .// Not participating.
      .assign attr_result = attr_result + ", 0"
    .end if
  .else
    .// MANY
    .// Build linked list of containers pointing to related instances.
    .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select many related_i_inss related by i_lnks->I_LIP[R2901]->I_INS[R2958]
    .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
    .assign attr_result = attr_result + s.result
    .assign attr_assset = attr_assset + s.assset
  .end if
  .//
  .// Now link the participant to the formalizer(s).
  .//
  .if ( r_form.Mult == 0 )
    .// ONE
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select one related_i_ins related by i_lnk->I_LIP[R2902]->I_INS[R2958]
    .if ( not_empty related_i_ins )
      .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
    .else
      .// Not participating.
      .assign attr_result = attr_result + ", 0"
    .end if
  .else
    .// MANY
    .// Build linked list of containers pointing to related instances.
    .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select many related_i_inss related by i_lnks->I_LIP[R2902]->I_INS[R2958]
    .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
    .assign attr_result = attr_result + s.result
    .assign attr_assset = attr_assset + s.assset
  .end if
  .//
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for an associative
.// relationship.
.// In the reflexive case, R2901 and R2902 will jive with AONE and AOTH.
.// In the non-reflexive, we compare the instance Obj_ID with the
.// AONE/AOTH Obj_ID.
.//=============================================================================
.function PEIRelInitAssociative
  .param inst_ref i_ins
  .param inst_ref o_obj
  .param inst_ref r_rel
  .param inst_ref r_assoc
  .//
  .assign attr_result = ""
  .assign attr_assset = ""
  .select one aone related by r_assoc->R_AONE[R209]
  .select one aoth related by r_assoc->R_AOTH[R210]
  .select one assr related by r_assoc->R_ASSR[R211]
  .//
  .// The other associated instance.
  .//
  .if ( o_obj.Obj_ID == aoth.Obj_ID )
    .// Optimize relationship to associator.
    .if ( ( aone.Mult == 0 ) and ( assr.Mult == 0 ) )
      .// ONE
      .select any i_lnk from instances of I_LNK where ( false )
      .if ( aone.Obj_ID == aoth.Obj_ID )
        .// reflexive
        .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
      .else
        .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
        .if ( empty i_lnk )
          .select one related_o_obj related by i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
          .if ( related_o_obj.Obj_ID == aoth.Obj_ID )
            .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
          .end if
        .end if  .// not empty
      .end if .// reflexive
      .if ( not_empty i_lnk )
        .select one related_i_ins related by i_lnk->I_LIP[R2903]->I_INS[R2958]
        .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
        .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
        .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
      .else
        .// not participating
        .assign attr_result = attr_result + ", 0"
      .end if  .// not empty
    .else
      .// MANY
      .// Build linked list of containers pointing to related instances.
      .select many i_lnks from instances of I_LNK where ( false )
      .select many related_i_inss from instances of I_INS where ( false )
      .if ( aone.Obj_ID == aoth.Obj_ID )
        .// reflexive
        .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
      .else
        .select many one_i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
        .select many two_i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
        .assign i_lnks = one_i_lnks | two_i_lnks
      .end if
      .select many related_i_inss related by i_lnks->I_LIP[R2903]->I_INS[R2958]
      .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
      .assign attr_result = attr_result + s.result
      .assign attr_assset = attr_assset + s.assset
    .end if
  .end if
  .//
  .// The one associated instance.
  .//
  .if ( o_obj.Obj_ID == aone.Obj_ID )
    .// Optimize relationship to associator.
    .if ( ( aoth.Mult == 0 ) and ( assr.Mult == 0 ) )
      .// ONE
      .select any i_lnk from instances of I_LNK where ( false )
      .if ( aone.Obj_ID == aoth.Obj_ID )
        .// reflexive
        .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
      .else
        .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
        .if ( empty i_lnk )
          .select one related_o_obj related by i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
          .if ( related_o_obj.Obj_ID == aone.Obj_ID )
            .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
          .end if
        .end if
      .end if .// reflexive
      .if ( not_empty i_lnk )
        .select one related_i_ins related by i_lnk->I_LIP[R2903]->I_INS[R2958]
        .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
        .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
        .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
      .else
        .// not participating
        .assign attr_result = attr_result + ", 0"
      .end if  .// not empty
    .else
      .// MANY
      .// Build linked list of containers pointing to related instances.
      .select many i_lnks from instances of I_LNK where ( false )
      .select many related_i_inss from instances of I_INS where ( false )
      .if ( aone.Obj_ID == aoth.Obj_ID )
        .select many i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
      .else
        .select many one_i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
        .select many two_i_lnks related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
        .assign i_lnks = one_i_lnks | two_i_lnks
      .end if
      .select many related_i_inss related by i_lnks->I_LIP[R2903]->I_INS[R2958]
      .invoke s = PEIRenderRelationshipManyOptimization( related_i_inss, o_obj )
      .assign attr_result = attr_result + s.result
      .assign attr_assset = attr_assset + s.assset
    .end if
  .end if
  .//
  .// The associative instance.
  .//
  .if ( o_obj.Obj_ID == assr.Obj_ID )
    .// Optimize relationship to both associates.
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2903] where ( selected.Rel_ID == r_rel.Rel_ID )
    .if ( not_empty i_lnk )
      .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .select one related2_i_ins related by i_lnk->I_LIP[R2902]->I_INS[R2958]
      .select one related2_o_obj related by related2_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related2_te_class related by related2_o_obj->TE_CLASS[R2019]
      .if ( ( aone.Obj_ID == aoth.Obj_ID ) or ( related2_o_obj.Obj_ID == aone.Obj_ID ) )
        .assign attr_result = attr_result + ", &${related2_te_class.GeneratedName}_instances[${related2_i_ins.Name}]"
        .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
      .else
        .assign attr_result = attr_result + ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
        .assign attr_result = attr_result + ", &${related2_te_class.GeneratedName}_instances[${related2_i_ins.Name}]"
      .end if
    .else
      .// not participating
      .assign attr_result = attr_result + ", 0, 0"
    .end if  .// not empty
  .end if
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for a Subtype/Supertype
.// association.
.//=============================================================================
.function PEIRelInitSubSuper
  .param inst_ref i_ins
  .param inst_ref o_obj
  .param inst_ref r_rel
  .param inst_ref r_subsup
  .assign attr_result = ""
  .//
  .// Find related instance index.
  .// Traverse the instance to link to instance chain
  .// to get the instance ArrayIndex.
  .select one super related by r_subsup->R_SUPER[R212]
  .if ( o_obj.Obj_ID == super.Obj_ID )
    .// Supertype
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2901] where ( selected.Rel_ID == r_rel.Rel_ID )
    .select one related_i_ins related by i_lnk->I_LIP[R2902]->I_INS[R2958]
    .if ( empty i_lnk )
      .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
      .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
    .end if
    .if ( not_empty i_lnk )
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .assign attr_result = ", (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], ${related_te_class.system_class_number}"
    .else
      .// not participating
      .assign attr_result = ", 0, 0"
    .end if
  .else
    .// Subtype
    .select any i_lnk related by i_ins->I_LIP[R2958]->I_LNK[R2902] where ( selected.Rel_ID == r_rel.Rel_ID )
    .if ( not_empty i_lnk )
      .select one related_i_ins related by i_lnk->I_LIP[R2901]->I_INS[R2958]
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .assign attr_result = ", &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}]"
    .else
      .// not participating
      .assign attr_result = ", 0"
    .end if
  .end if
.end function
.//
.//
.//=============================================================================
.// Generate the optimized relationship linkage for a composed association.
.//=============================================================================
.function PEIRelInitComposed
  .param inst_ref o_obj
  .param inst_ref r_rel
  .assign attr_result = ""
.end function
.//
.//
.//=============================================================================
.// Generate an initializer for the current state attribute if needed.
.//=============================================================================
.function PEIRenderInitializerBodyCurrentState
  .param inst_ref i_ins
  .param inst_ref o_obj
  .assign attr_result = ""
  .select one te_state related by i_ins->SM_STATE[R2915]->TE_STATE[R2037]
  .if ( not_empty te_state )
    .assign attr_result = te_state.enumerator
  .end if
.end function
.//
.//
.//=============================================================================
.// Render relationship MANY optimization.
.// This helper is used to render the code used to optimize a relationship
.// set.  The set variable is generated for inside the instance structure.
.// The linked list body pointing to related instances is also generated.
.//=============================================================================
.function PEIRenderRelationshipManyOptimization
  .param inst_ref_set i_inss
  .param inst_ref o_obj
  .//
  .assign attr_result = ""
  .assign attr_assset = ""
  .select any te_sys from instances of TE_SYS
  .// i_inss, o_obj
  .assign instance_count = cardinality i_inss
  .if ( instance_count > 0 )
    .select one te_class related by o_obj->TE_CLASS[R2019]
    .assign ContainerIndex = te_class.ContainerIndex
    .// A container index starting greater than zero means we are not the
    .// first (instance) to be adding linked lists.  Precede with comma.
    .if ( ContainerIndex > 0 )
      .assign attr_assset = ",\n"
    .end if
    .invoke rel_set_name = PEIGetRelationshipSetContainerName( te_class )
    .assign attr_result = ", { &${rel_set_name.result}[${ContainerIndex}] }"
    .for each related_i_ins in i_inss
      .assign ContainerIndex = ContainerIndex + 1
      .select one related_o_obj related by related_i_ins->CSME_CIE[R2962]->O_OBJ[R2961]
      .select one related_te_class related by related_o_obj->TE_CLASS[R2019]
      .if ( last i_inss )
        .if ( te_sys.CollectionsFlavor == 20 )
          .assign icount = cardinality i_inss
          .if ( icount > 1 )
            .assign attr_assset = attr_assset + "  { 0, (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], &${rel_set_name.result}[${ContainerIndex} - 2] }"
          .else
            .assign attr_assset = attr_assset + "  { 0, (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], 0 }"
          .end if .// cardinality i_inss > 1
        .else
          .assign attr_assset = attr_assset + "  { 0, (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}] }"
        .end if
      .elif ( first i_inss )
        .if ( te_sys.CollectionsFlavor == 20 )
          .assign attr_assset = attr_assset + "  { &${rel_set_name.result}[${ContainerIndex}], (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], 0 },\n"
        .else
          .assign attr_assset = attr_assset + "  { &${rel_set_name.result}[${ContainerIndex}], (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}] },\n"
        .end if
      .else
        .if ( te_sys.CollectionsFlavor == 20 )
          .assign attr_assset = attr_assset + "  { &${rel_set_name.result}[${ContainerIndex}], (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}], &${rel_set_name.result}[${ContainerIndex} - 2] },\n"
        .else
          .assign attr_assset = attr_assset + "  { &${rel_set_name.result}[${ContainerIndex}], (void *) &${related_te_class.GeneratedName}_instances[${related_i_ins.Name}] },\n"
        .end if
      .end if
    .end for
    .assign te_class.ContainerIndex = ContainerIndex
  .else
    .// Empty relationship set.
    .assign attr_result = ", { 0 }"
  .end if
.end function
.//


add ret by skenney26

add ret by skenney26

; lib/util.arc: A collection of useful miscellanea

; Contributors:
; - Michael Arntzenius <daekharel@gmail.com>

; Persons we've shamelessly ripped off:
; - Conan Dalton <conan@conandalton.net>
; - absz (http://arclanguage.org/user?id=absz)
; - fallintothis (http://arclanguage.org/user?id=fallintothis)

; License: Do what you want, but it's not my fault!
; This license applies to all code in this file UNLESS OTHERWISE NOTED.

; Feel free to make additions to this file and push them to anarki. Keep it to
; stuff that is widely applicable. Don't remove or change the semantics of stuff
; other people added. Add yourself to the contributors list above if you want.

; If you wish to use a different license, make a comment around the code you've
; contributed noting the license. No licenses that don't permit modification
; (duh) and redistribution (double duh).

; Try and keep track of what is whose in sections with unknown licenses
; ("ripoffs").

; miscellaneous

(def fst (a . _) " Returns its first argument. See also [[snd]] " a)
(def snd (a b . _) " Returns its second argument. See also [[fst]] " b)

(def bool (x)
  " Returns `t' if x is not nil, and `nil' otherwise. "
  (if x t))

(def uniqs (lst)
  " Returns a list of gensyms, one for each element of `lst'. Elements
    of `lst' that are symbols are used as the base names for their
    corresponding gensyms.
    See also [[uniq]] "
  (map1 (iff asym uniq [uniq]) lst))

; type checkers
(def asym (x) " `t' iff `x' is a symbol. " (isa x 'sym))
(def astring (x) " `t' iff `x' is a string. " (isa x 'string))
(def atable (x) " `t' iff `x' is a table. " (isa x 'table))
(def aint (x) " `t' iff `x' is an int. " (isa x 'int))
(def anum (x) " `t' iff `x' is a num. Note that ints are not nums. "
  (isa x 'num))

; list manipulation

; 'reduce and 'rreduce have somewhat quirky behavior, well-suited to arithmetic
; functions, but otherwise hard to reason about. I usually prefer 'foldl and
; 'foldr.
(def foldl (f v l)
  (if l (foldl f (f v car.l) cdr.l) v))

(def foldr (f v l)
  (foldl flip.f v rev.l))

(def foot (l)
  " Gets the last cons in a proper list. (Fails on dotted lists.) "
  (aif cdr.l foot.it l))

(def join/d ls
  " Destructive join.
    See also [[join]]"
  (foldr (afn (a b) (if b (aif foot.a (do (scdr it b) a) b) a)) nil ls))

(def partition (test seq)
  " Equivalent to but more efficient than
   `(list (keep test seq) (rem test seq))'. See also [[keep]] [[rem]] "
  (let (passed failed) nil
    (each e seq
      (if test.e
        (push e passed)
        (push e failed)))
    (list rev.passed rev.failed)))

(def zip ls
  " Returns a list of lists; the n-th element of the result is a list of the
    n-th elements of the lists in `ls'. The length of the result is the length
    of the shortest list in `ls'; extra elements in other lists are discarded. "
  (apply map list ls))

(def unzip (xs)
  (let ret '()
    (each i (range 0 (- (len (car xs)) 1))
      (push (map [_ i] xs) ret))
    (rev ret)))

(def mklist (x)
  " Wraps atoms in a list; does nothing if `x' is already a list."
  (check x alist list.x))

; combinators

(def applied (f)
  " Returns a fn that calls `f' on the list of its arguments.
    For example, 'max is equivalent to `(applied [best > _])'. "
  (fn a (f a)))

(def flip (f)
  " Flips the order of the first two arguments of `f'.
    For example: ((flip cons) 1 2) => (2 . 1) "
  (fn (x y . zs) (apply f y x zs)))

(def curry (f . xs)
  " Partially applies (\"curries\") `f' to `xs'. "
  (fn ys (apply f (join xs ys))))

(def const (x)
  " Creates a fn that takes any number of arguments and returns `x'. "
  (fn _ x))

(def tfn _ " Ignores its arguments and returns t. " t)
(def nilfn _ " Ignores its arguments and returns nil. " nil)

(def norf fns
  " Creates a function which returns `t' iff none of `fns' return `t'
    on its arguments.
    See also [[orf]] [[andf]] [[nor]] "
  (complement (apply orf fns)))

(def iff funs
  " Put simply: iff is to if as andf is to and. Specifically:

    (iff) => idfn
    (iff fun) => fun
    (iff test fun rest ...) => a fn that applies `fun' to its arguments if they
    pass `test', otherwise applies `(iff rest...)' to them.

    Examples:

      arc> ((iff alist car) '(x))
      x
      arc> ((iff alist car) 2)
      2
      arc> ((iff < (fn (x y) x) (fn (x y) y)) 1 2)
      1

    See also [[andf]] [[orf]] [[check]] [[idfn]] "
  (case len.funs
    0 idfn
    1 funs.0
      (withs ((test fun . rest) funs
              restfun (apply iff rest))
        (fn a (if (apply test a) (apply fun a)
                  (apply restfun a))))))

; macros

(mac mapeach (var lst . body)
  " Maps `(fn (,var) ,@body)' over `lst'.
    See also [[each]] [[map]] [[mappendeach]] "
  `(map (fn (,var) ,@body) ,lst))

(mac mappendeach (var lst . body)
  " As 'mapeach, but using 'mappend instead of 'map.
    See also [[mapeach]] [[mappend]] [[each]] "
  `(mappend (fn (,var) ,@body) ,lst))

(mac ado body
  " Anaphoric do.
    See also [[aif]] [[awhen]] [[aand]] "
  (aif cdr.body `(let it ,car.body (ado ,@it))
       car.body))

; now that pg has renamed 'assert to 'set, we're free to use it in its more
; conventional sense
(mac assert (exp (o msg (+ "Assertion failed: "
                           (tostring:ppr exp (len "Assertion failed: ") t))))
  " Errors with `msg' if `exp' evaluates to nil. "
  `(unless ,exp (err ,msg)))

(mac asserts args
  " Asserts each expr in `args', with the default error message. "
  `(do ,@(map [list 'assert _] args)))

(mac switchlet (var expr . cases)
  " Like 'caselet, except it (lazily) evals the expressions compared against.
    See also [[switch]] [[caselet]] [[case]]"
  `(let ,var ,expr
     ,((afn (args)
         (if (no cdr.args) car.args
           `(if (is ,var ,car.args) ,cadr.args
              ,(self cddr.args)))) cases)))

(mac switch (expr . cases)
  " 'switch is to 'switchlet as 'case is to 'caselet.
    See also [[switchlet]] [[case]] [[caselet]]"
  `(switchlet ,(uniq) ,exp ,@cases))

(mac dol (parms (test result) . body)
  " Like the standard lisp/scheme do loop, but with redundant inner parens
    removed."
  (w/uniq loop-name
    (let parms (tuples parms 3)
      `((rfn ,loop-name ,(map1 [_ 0] parms)
          (if ,test ,result
            (do ,@body (,loop-name ,@(map1 [_ 2] parms)))))
         ,@(map1 [_ 1] parms)))))

(mac w/stdoutfile (name . body)
  " Redirects stdout to the file `name' within `body'.
    See also [[w/stdinfile]] [[w/outfile]] [[w/stdout]] "
  (w/uniq str `(w/outfile ,str ,name (w/stdout ,str ,@body))))

(mac w/stdinfile (name . body)
  " Redirects standard input from the file `name' within `body'.
    See also [[w/stdoutfile]] [[w/infile]] [[w/stdin]] "
  (w/uniq str `(w/infile ,str ,name (w/stdin ,str ,@body))))

; binding forms

(mac with/p (vars-vals . body)
  " Scheme/Common Lisp's `let' - ie: 'with with the parens added back.
    Easier to use in macro expansions than 'with.
    See also [[with]] [[withs/p]] "
  `(with ,(apply join vars-vals) ,@body))

(mac withs/p (vars-vals . body)
  " Like Scheme/Common Lisp's `let*' - ie: 'withs with the parens added back.
    Easier to use in macro expansions than 'withs.
    See also [[withs]] [[with/p]] "
  `(withs ,(apply join vars-vals) ,@body))

; a 'with that works for defining recursive fns
(mac withr/p (bindings . body)
  " Scheme's 'letrec.
    See also [[withr]] "
  `(let ,(map1 car bindings) nil
     ,@(map [cons 'assign _] bindings)
     ,@body))

(mac withr (bindings . body)
  " Scheme's 'letrec, with the redundant inner parens removed.
    See also [[withf]] [[letf]] [[withr/p]] "
  `(withr/p ,pair.bindings ,@body))

; mutually recursive local fns
(mac withf/p (fns . body)
  " Like 'withf, only with extra parens, as in 'with/p compared to 'with.
    See also [[withf]] [[with/p]] [[withr]] [[withr/p]] "
  `(withr/p ,(mapeach (name . rest) fns `(,name (fn ,@rest)))
     ,@body))

(mac withf (fns . body)
  " Defines a set `fns' of mutually recursive local fns within `body'. Each
    three elements of `fn' correspond to a fn name, argument list, and body,
    so you'll need to use 'do if you want a multi-expression fn body.
    Example:

      arc> (withf (is-even (x) (case x 0 t (is-odd (- x 1)))
                   is-odd (x) (case x 0 nil (is-even (- x 1))))
             (keep is-odd (range 0 5)))
      (1 3 5)

    See also [[letf]] [[withr]] "
  `(withf/p ,(tuples fns 3) ,@body))

(mac letf (name args expr . body)
  " Defines a (possibly recursive) local fn `(fn ,args ,expr)' named `name'
    within `body'. Example:

      arc> (letf last (x) (aif cdr.x last.it car.x)
             (last '(x y z)))
      z

    See also [[withf]] [[withr]] "
  `(withf (,name ,args ,expr) ,@body))

; ripoffs - licenses unknown

; once-only by fallintothis
; http://arclanguage.org/item?id=9939
; CHANGED 2009-08-20:
;   + take advantage of 'uniqs, 'with/p, 'zip
;   + wrap 'names in a list if it's an atom
;   + alter indentation slightly
;  - Michael Arntzenius

(mac once-only (names . body)
  (withs (names (check names alist list.names)
          gensyms (uniqs names))
    `(w/uniq ,gensyms
       `(with ,(list ,@(mappend list gensyms names))
          ,(with/p ,(zip names gensyms)
             ,@body)))))

; afnwith by Conan Dalton
; http://arclanguage.org/item?id=10055
; CHANGED 2009-08-15: added docstrings - Michael Arntzenius
(mac rfnwith (name withses . body)
  " Convenient wrapper for applying an rfn using with-like syntax.
    `withses' is a list of argument names and their initial values.
    Best explained by example:

      arc> (rfnwith sum (x (range 1 3))
             (iflet (a . r) x (+ a (sum r)) 0))
      6

    The above example macroexpands to:

      ((rfn sum (x) (iflet (a . r) x (+ a (sum r)) 0))
       (range 1 3))

    See also [[afnwith]] [[w/rfn]] [[rfn]] "
  (let w (pair withses)
    `((rfn ,name ,(map car w) ,@body) ,@(map cadr w))))

(mac afnwith (withses . body)
  " Convenient wrapper for applying an afn using with-like syntax.
    `withses' is a list of argument names and their initial values.
    Best explained by example:

      arc> (afnwith (x (range 1 3))
             (iflet (a . r) x (+ a (self r)) 0))
      6

    See also [[rfnwith]] [[w/afn]] [[afn]] "
  `(rfnwith self ,withses ,@body))

; ripoff: w/afn, by absz
; http://arclanguage.org/item?id=10125
; CHANGED 2009-08-15: added docstrings - Michael Arntzenius

(mac w/rfn (name withses . body)
  " Convenient wrapper for applying an rfn using preexisting variables
    in `withses' as arguments. Best explained by example:

      arc> (let x (range 1 3)
             (w/rfn sum (x)
               (iflet (a . r) x (+ a (sum r)) 0)))
      6

    The above example (w/rfn sum ...) macroexpands to:

      ((rfn sum (x) (iflet (a . r) x (+ a (sum r)) 0))
       x)

    See also [[w/afn]] [[rfnwith]] [[rfn]] "
  `(rfnwith ,name ,(mappend [list _ _] mklist.withses) ,@body))

(mac w/afn (withses . body)
  " Convenient wrapper for applying an afn using the preexisting variables
    in `withses' as arguments. Best explained by example:

      arc> (let x (range 1 3)
             (w/afn (x)
               (iflet (a . r) x (+ a (self r)) 0)))
      6

    The above example (w/afn (x) ...) macroexpands to:

      ((afn (x) (iflet (a . r) x (+ a (sum r)) 0))
       x)

    See also [[w/rfn]] [[afnwith]] [[afn]] "
  `(w/rfn self ,withses ,@body))

; end ripoffs

; list utils

(def butlast (x)
  (cut x 0 (- (len x) 1)))

(def many (lst)
  (if (and (acons lst) (len> lst 0))))

(def len= (num lst)
  (is num (len lst)))

(def len- (lst n)
  (- (len lst) n))

(def car< (x y)
  (< (car x) (car y)))

(def cadar (lst)
  (car (cdr (car lst))))

(def mapcar (lst)
  (map [car _] lst))

(def mapcdr (lst)
  (map [cdr _] lst))

(def rand-pos (lst)
  (if lst
      (rand-elt (range 0 (- (len lst) 1)))))

(mac pushend (elem lst)
  `(= ,lst (+ ,lst (list ,elem))))

(mac popfind (f lst)
  (w/uniq g1
    `(let ,g1 (pos ,f ,lst)
       (if ,g1 (popnth ,lst ,g1)))))

(mac popnth (lst n)
  (w/uniq g1
    `(let ,g1 (,lst ,n)
       (= ,lst (+ (cut ,lst 0 ,n) (cut ,lst (+ 1 ,n))))
       ,g1)))

(mac poprand (lst)
  (w/uniq g1
    `(if ,lst
	 (let ,g1 (rand-pos ,lst)
	   (popnth ,lst ,g1)))))

; utils for lists of hashes

(def keepkey (key lst)
  (keep [_ key] lst))

(def mapkey (key lst)
  (map [_ key] lst))

; misc

(def gc ()
  (($ collect-garbage)))

; stolen from skenney26 (http://github.com/skenney26/kwizwiz/blob/master/kwizwiz.arc)
(mac ret (var val . body)
  `(let ,var ,val ,@body ,var))

; everything below pulled from Andrew Wilcox's site
(mac between (var expr within . body)
  (w/uniq first
    `(let ,first t
       (each ,var ,expr
         (unless ,first ,within)
         (wipe ,first)
         ,@body))))

; lib/util.arc: A collection of useful miscellanea

; Contributors:
; - Michael Arntzenius <daekharel@gmail.com>

; Persons we've shamelessly ripped off:
; - Conan Dalton <conan@conandalton.net>
; - absz (http://arclanguage.org/user?id=absz)
; - fallintothis (http://arclanguage.org/user?id=fallintothis)

; License: Do what you want, but it's not my fault!
; This license applies to all code in this file UNLESS OTHERWISE NOTED.

; Feel free to make additions to this file and push them to anarki. Keep it to
; stuff that is widely applicable. Don't remove or change the semantics of stuff
; other people added. Add yourself to the contributors list above if you want.

; If you wish to use a different license, make a comment around the code you've
; contributed noting the license. No licenses that don't permit modification
; (duh) and redistribution (double duh).

; Try and keep track of what is whose in sections with unknown licenses
; ("ripoffs").

; miscellaneous

(def fst (a . _) " Returns its first argument. See also [[snd]] " a)
(def snd (a b . _) " Returns its second argument. See also [[fst]] " b)

(def bool (x)
  " Returns `t' if x is not nil, and `nil' otherwise. "
  (if x t))

(def uniqs (lst)
  " Returns a list of gensyms, one for each element of `lst'. Elements
    of `lst' that are symbols are used as the base names for their
    corresponding gensyms.
    See also [[uniq]] "
  (map1 (iff asym uniq [uniq]) lst))

; type checkers
(def asym (x) " `t' iff `x' is a symbol. " (isa x 'sym))
(def astring (x) " `t' iff `x' is a string. " (isa x 'string))
(def atable (x) " `t' iff `x' is a table. " (isa x 'table))
(def aint (x) " `t' iff `x' is an int. " (isa x 'int))
(def anum (x) " `t' iff `x' is a num. Note that ints are not nums. "
  (isa x 'num))

; list manipulation

; 'reduce and 'rreduce have somewhat quirky behavior, well-suited to arithmetic
; functions, but otherwise hard to reason about. I usually prefer 'foldl and
; 'foldr.
(def foldl (f v l)
  (if l (foldl f (f v car.l) cdr.l) v))

(def foldr (f v l)
  (foldl flip.f v rev.l))

(def foot (l)
  " Gets the last cons in a proper list. (Fails on dotted lists.) "
  (aif cdr.l foot.it l))

(def join/d ls
  " Destructive join.
    See also [[join]]"
  (foldr (afn (a b) (if b (aif foot.a (do (scdr it b) a) b) a)) nil ls))

(def partition (test seq)
  " Equivalent to but more efficient than
   `(list (keep test seq) (rem test seq))'. See also [[keep]] [[rem]] "
  (let (passed failed) nil
    (each e seq
      (if test.e
        (push e passed)
        (push e failed)))
    (list rev.passed rev.failed)))

(def zip ls
  " Returns a list of lists; the n-th element of the result is a list of the
    n-th elements of the lists in `ls'. The length of the result is the length
    of the shortest list in `ls'; extra elements in other lists are discarded. "
  (apply map list ls))

(def unzip (xs)
  (let ret '()
    (each i (range 0 (- (len (car xs)) 1))
      (push (map [_ i] xs) ret))
    (rev ret)))

(def mklist (x)
  " Wraps atoms in a list; does nothing if `x' is already a list."
  (check x alist list.x))

; combinators

(def applied (f)
  " Returns a fn that calls `f' on the list of its arguments.
    For example, 'max is equivalent to `(applied [best > _])'. "
  (fn a (f a)))

(def flip (f)
  " Flips the order of the first two arguments of `f'.
    For example: ((flip cons) 1 2) => (2 . 1) "
  (fn (x y . zs) (apply f y x zs)))

(def curry (f . xs)
  " Partially applies (\"curries\") `f' to `xs'. "
  (fn ys (apply f (join xs ys))))

(def const (x)
  " Creates a fn that takes any number of arguments and returns `x'. "
  (fn _ x))

(def tfn _ " Ignores its arguments and returns t. " t)
(def nilfn _ " Ignores its arguments and returns nil. " nil)

(def norf fns
  " Creates a function which returns `t' iff none of `fns' return `t'
    on its arguments.
    See also [[orf]] [[andf]] [[nor]] "
  (complement (apply orf fns)))

(def iff funs
  " Put simply: iff is to if as andf is to and. Specifically:

    (iff) => idfn
    (iff fun) => fun
    (iff test fun rest ...) => a fn that applies `fun' to its arguments if they
    pass `test', otherwise applies `(iff rest...)' to them.

    Examples:

      arc> ((iff alist car) '(x))
      x
      arc> ((iff alist car) 2)
      2
      arc> ((iff < (fn (x y) x) (fn (x y) y)) 1 2)
      1

    See also [[andf]] [[orf]] [[check]] [[idfn]] "
  (case len.funs
    0 idfn
    1 funs.0
      (withs ((test fun . rest) funs
              restfun (apply iff rest))
        (fn a (if (apply test a) (apply fun a)
                  (apply restfun a))))))

; macros

(mac mapeach (var lst . body)
  " Maps `(fn (,var) ,@body)' over `lst'.
    See also [[each]] [[map]] [[mappendeach]] "
  `(map (fn (,var) ,@body) ,lst))

(mac mappendeach (var lst . body)
  " As 'mapeach, but using 'mappend instead of 'map.
    See also [[mapeach]] [[mappend]] [[each]] "
  `(mappend (fn (,var) ,@body) ,lst))

(mac ado body
  " Anaphoric do.
    See also [[aif]] [[awhen]] [[aand]] "
  (aif cdr.body `(let it ,car.body (ado ,@it))
       car.body))

; now that pg has renamed 'assert to 'set, we're free to use it in its more
; conventional sense
(mac assert (exp (o msg (+ "Assertion failed: "
                           (tostring:ppr exp (len "Assertion failed: ") t))))
  " Errors with `msg' if `exp' evaluates to nil. "
  `(unless ,exp (err ,msg)))

(mac asserts args
  " Asserts each expr in `args', with the default error message. "
  `(do ,@(map [list 'assert _] args)))

(mac switchlet (var expr . cases)
  " Like 'caselet, except it (lazily) evals the expressions compared against.
    See also [[switch]] [[caselet]] [[case]]"
  `(let ,var ,expr
     ,((afn (args)
         (if (no cdr.args) car.args
           `(if (is ,var ,car.args) ,cadr.args
              ,(self cddr.args)))) cases)))

(mac switch (expr . cases)
  " 'switch is to 'switchlet as 'case is to 'caselet.
    See also [[switchlet]] [[case]] [[caselet]]"
  `(switchlet ,(uniq) ,exp ,@cases))

(mac dol (parms (test result) . body)
  " Like the standard lisp/scheme do loop, but with redundant inner parens
    removed."
  (w/uniq loop-name
    (let parms (tuples parms 3)
      `((rfn ,loop-name ,(map1 [_ 0] parms)
          (if ,test ,result
            (do ,@body (,loop-name ,@(map1 [_ 2] parms)))))
         ,@(map1 [_ 1] parms)))))

(mac w/stdoutfile (name . body)
  " Redirects stdout to the file `name' within `body'.
    See also [[w/stdinfile]] [[w/outfile]] [[w/stdout]] "
  (w/uniq str `(w/outfile ,str ,name (w/stdout ,str ,@body))))

(mac w/stdinfile (name . body)
  " Redirects standard input from the file `name' within `body'.
    See also [[w/stdoutfile]] [[w/infile]] [[w/stdin]] "
  (w/uniq str `(w/infile ,str ,name (w/stdin ,str ,@body))))

; binding forms

(mac with/p (vars-vals . body)
  " Scheme/Common Lisp's `let' - ie: 'with with the parens added back.
    Easier to use in macro expansions than 'with.
    See also [[with]] [[withs/p]] "
  `(with ,(apply join vars-vals) ,@body))

(mac withs/p (vars-vals . body)
  " Like Scheme/Common Lisp's `let*' - ie: 'withs with the parens added back.
    Easier to use in macro expansions than 'withs.
    See also [[withs]] [[with/p]] "
  `(withs ,(apply join vars-vals) ,@body))

; a 'with that works for defining recursive fns
(mac withr/p (bindings . body)
  " Scheme's 'letrec.
    See also [[withr]] "
  `(let ,(map1 car bindings) nil
     ,@(map [cons 'assign _] bindings)
     ,@body))

(mac withr (bindings . body)
  " Scheme's 'letrec, with the redundant inner parens removed.
    See also [[withf]] [[letf]] [[withr/p]] "
  `(withr/p ,pair.bindings ,@body))

; mutually recursive local fns
(mac withf/p (fns . body)
  " Like 'withf, only with extra parens, as in 'with/p compared to 'with.
    See also [[withf]] [[with/p]] [[withr]] [[withr/p]] "
  `(withr/p ,(mapeach (name . rest) fns `(,name (fn ,@rest)))
     ,@body))

(mac withf (fns . body)
  " Defines a set `fns' of mutually recursive local fns within `body'. Each
    three elements of `fn' correspond to a fn name, argument list, and body,
    so you'll need to use 'do if you want a multi-expression fn body.
    Example:

      arc> (withf (is-even (x) (case x 0 t (is-odd (- x 1)))
                   is-odd (x) (case x 0 nil (is-even (- x 1))))
             (keep is-odd (range 0 5)))
      (1 3 5)

    See also [[letf]] [[withr]] "
  `(withf/p ,(tuples fns 3) ,@body))

(mac letf (name args expr . body)
  " Defines a (possibly recursive) local fn `(fn ,args ,expr)' named `name'
    within `body'. Example:

      arc> (letf last (x) (aif cdr.x last.it car.x)
             (last '(x y z)))
      z

    See also [[withf]] [[withr]] "
  `(withf (,name ,args ,expr) ,@body))

; ripoffs - licenses unknown

; once-only by fallintothis
; http://arclanguage.org/item?id=9939
; CHANGED 2009-08-20:
;   + take advantage of 'uniqs, 'with/p, 'zip
;   + wrap 'names in a list if it's an atom
;   + alter indentation slightly
;  - Michael Arntzenius

(mac once-only (names . body)
  (withs (names (check names alist list.names)
          gensyms (uniqs names))
    `(w/uniq ,gensyms
       `(with ,(list ,@(mappend list gensyms names))
          ,(with/p ,(zip names gensyms)
             ,@body)))))

; afnwith by Conan Dalton
; http://arclanguage.org/item?id=10055
; CHANGED 2009-08-15: added docstrings - Michael Arntzenius
(mac rfnwith (name withses . body)
  " Convenient wrapper for applying an rfn using with-like syntax.
    `withses' is a list of argument names and their initial values.
    Best explained by example:

      arc> (rfnwith sum (x (range 1 3))
             (iflet (a . r) x (+ a (sum r)) 0))
      6

    The above example macroexpands to:

      ((rfn sum (x) (iflet (a . r) x (+ a (sum r)) 0))
       (range 1 3))

    See also [[afnwith]] [[w/rfn]] [[rfn]] "
  (let w (pair withses)
    `((rfn ,name ,(map car w) ,@body) ,@(map cadr w))))

(mac afnwith (withses . body)
  " Convenient wrapper for applying an afn using with-like syntax.
    `withses' is a list of argument names and their initial values.
    Best explained by example:

      arc> (afnwith (x (range 1 3))
             (iflet (a . r) x (+ a (self r)) 0))
      6

    See also [[rfnwith]] [[w/afn]] [[afn]] "
  `(rfnwith self ,withses ,@body))

; ripoff: w/afn, by absz
; http://arclanguage.org/item?id=10125
; CHANGED 2009-08-15: added docstrings - Michael Arntzenius

(mac w/rfn (name withses . body)
  " Convenient wrapper for applying an rfn using preexisting variables
    in `withses' as arguments. Best explained by example:

      arc> (let x (range 1 3)
             (w/rfn sum (x)
               (iflet (a . r) x (+ a (sum r)) 0)))
      6

    The above example (w/rfn sum ...) macroexpands to:

      ((rfn sum (x) (iflet (a . r) x (+ a (sum r)) 0))
       x)

    See also [[w/afn]] [[rfnwith]] [[rfn]] "
  `(rfnwith ,name ,(mappend [list _ _] mklist.withses) ,@body))

(mac w/afn (withses . body)
  " Convenient wrapper for applying an afn using the preexisting variables
    in `withses' as arguments. Best explained by example:

      arc> (let x (range 1 3)
             (w/afn (x)
               (iflet (a . r) x (+ a (self r)) 0)))
      6

    The above example (w/afn (x) ...) macroexpands to:

      ((afn (x) (iflet (a . r) x (+ a (sum r)) 0))
       x)

    See also [[w/rfn]] [[afnwith]] [[afn]] "
  `(w/rfn self ,withses ,@body))

; end ripoffs

; list utils

(def butlast (x)
  (cut x 0 (- (len x) 1)))

(def many (lst)
  (if (and (acons lst) (len> lst 0))))

(def len= (num lst)
  (is num (len lst)))

(def len- (lst n)
  (- (len lst) n))

(def car< (x y)
  (< (car x) (car y)))

(def cadar (lst)
  (car (cdr (car lst))))

(def mapcar (lst)
  (map [car _] lst))

(def mapcdr (lst)
  (map [cdr _] lst))

(def rand-pos (lst)
  (if lst
      (rand-elt (range 0 (- (len lst) 1)))))

(mac pushend (elem lst)
  `(= ,lst (+ ,lst (list ,elem))))

(mac popfind (f lst)
  (w/uniq g1
    `(let ,g1 (pos ,f ,lst)
       (if ,g1 (popnth ,lst ,g1)))))

(mac popnth (lst n)
  (w/uniq g1
    `(let ,g1 (,lst ,n)
       (= ,lst (+ (cut ,lst 0 ,n) (cut ,lst (+ 1 ,n))))
       ,g1)))

(mac poprand (lst)
  (w/uniq g1
    `(if ,lst
	 (let ,g1 (rand-pos ,lst)
	   (popnth ,lst ,g1)))))

; utils for lists of hashes

(def keepkey (key lst)
  (keep [_ key] lst))

(def mapkey (key lst)
  (map [_ key] lst))

; misc

(def gc ()
  (($ collect-garbage)))

; everything below pulled from Andrew Wilcox's site
(mac between (var expr within . body)
  (w/uniq first
    `(let ,first t
       (each ,var ,expr
         (unless ,first ,within)
         (wipe ,first)
         ,@body))))


Simplify make-br-fn and permit 0-arg br-fns

(require "load/declare.arc")

; avoid redefinition warning
($ (namespace-undefine-variable! (ac-global-name 'make-br-fn)))

(def -mbf-argsym (e)
  (and (begins string.e "_")
       (~find e decl!brfn-ignore)))

(def -mbf-argsyms (e)
  (case type.e
    sym (if ssyntax.e (-mbf-argsyms ssexpand.e)
            (-mbf-argsym e) list.e)
    cons (case car.e
           quote nil
           ; TODO: quasiquote & unquote
           (mappend -mbf-argsyms e))))

(declaration 'brfn-ignore
             (fn (old flag (sym))
               (consif (when flag sym)
                       (rem sym old))))

; better make-br-fn
(mac make-br-fn (body)
  (withs (astab (counts:-mbf-argsyms body)
          args  (awhen astab!__ (wipe astab!__) '__))
    (each s (sort > keys.astab)
      (push s args))
    `(fn ,args ,body)))

(require "load/declare.arc")

; avoid redefinition warning
($ (namespace-undefine-variable! (ac-global-name 'make-br-fn)))

(def -mbf-argsym (e)
  (and (begins string.e "_")
       (~find e decl!brfn-ignore)))

(def -mbf-argsyms (e)
  (case type.e
    sym (if ssyntax.e (-mbf-argsyms ssexpand.e)
            (-mbf-argsym e) list.e)
    cons (case car.e
           quote nil
           ; TODO: quasiquote & unquote
           (mappend -mbf-argsyms e))))

(declaration 'brfn-ignore
             (fn (old flag (sym))
               (consif (when flag sym)
                       (rem sym old))))

; better make-br-fn
(mac make-br-fn (body)
  (withs (astab (counts:-mbf-argsyms body)
          args  (awhen astab!__ (wipe astab!__) '__))
    (each s (sort > (if (or args keys.astab) keys.astab '(_)))
      (push s args))
    `(fn ,args ,body)))