home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / orx8.zip / class_rel.cmd < prev    next >
OS/2 REXX Batch file  |  1997-07-21  |  8KB  |  205 lines
  1. /* 
  2. program:   class_rel.cmd
  3. type:      Object REXX, REXXSAA 6.0
  4. purpose:   defines specialized classes of .relation, including a tandem "anchor/ref" 
  5.            (allowing for forward-referencing)
  6. version:   1.0
  7. date:      1997-04-15
  8. changed:   ---
  9.  
  10. author:    Rony G. Flatscher
  11.            Rony.Flatscher@wu-wien.ac.at
  12.            (Wirtschaftsuniversitaet Wien, University of Economics and Business
  13.            Administration, Vienna/Austria/Europe)
  14. needs:     ---
  15.  
  16. usage:     call or require & see code
  17.  
  18. comments:  prepared for the "8th International Rexx Symposium 1997", April 1997, Heidelberg/Germany
  19.  
  20.  
  21. All rights reserved and copyrighted 1995-1997 by the author, no guarantee that
  22. it works without errors, etc.  etc.
  23.  
  24. You are granted the right to use this module under the condition that you don't charge money for this module (as you didn't write
  25. it in the first place) or modules directly derived from this module, that you document the original author (to give appropriate
  26. credit) with the original name of the module and that you make the unaltered, original source-code of this module available on
  27. demand.  If that holds, you may even bundle this module (either in source or compiled form) with commercial software.
  28.  
  29. If you find an error, please send me the description (preferably a *very* short example);
  30. I'll try to fix it and re-release it to the net.
  31. */
  32.  
  33.  
  34.  
  35. /********************************************************************************/
  36. /* table-like (one entry per index only), but enhanced with .relation's methods */
  37. /* injektiv, S1 -> S2                                                           */
  38.  
  39. :: CLASS RelTable       SUBCLASS Relation       PUBLIC
  40. /* ----------------------------------------------- */
  41. :: METHOD "[]="                 /* override             */
  42.  
  43.    FORWARD MESSAGE ( "PUT" )    /* let PUT do the work  */
  44.  
  45. /* ----------------------------------------------- */
  46. :: METHOD "PUT"                 /* override             */
  47.    USE ARG item , index
  48.  
  49.    self ~ remove( index )       /* remove index & associated item       */
  50.  
  51.    FORWARD CLASS (super)        /* now do the PUT !     */
  52. /********************************************************************************/
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61. /********************************************************************************/
  62. /* one item may be associated with one index only,
  63.    and one index is associated with one item only */
  64. /*
  65.     bijectiv, S1 -> S2  <==> S2 -> S1
  66. */
  67. :: CLASS RelBijective   SUBCLASS Relation       PUBLIC
  68. /* ----------------------------------------------- */
  69. :: METHOD "[]="                 /* override             */
  70.    FORWARD MESSAGE ( "PUT" )    /* let PUT do the work  */
  71.  
  72. /* ----------------------------------------------- */
  73. :: METHOD  PUT                  /* override */
  74.    USE ARG item , index
  75.  
  76.    self ~ remove( index )       /* remove index         */
  77.  
  78.                                 /* remove item (with another index) */
  79.    self ~ removeitem( item , self ~ index( item  ) )   
  80.  
  81.    FORWARD CLASS (super)        /* let super do the PUT ! */
  82. /* -----------------------------------------------------------------------------*/
  83. /********************************************************************************/
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91. /********************************************************************************/
  92. /* item and index may be exchanged, i.e. a item  for an index or item may just exist *once* either
  93.    as an item or as an index ! */
  94. /*
  95.     bijektiv, S1 -> S2  == S2 -> S1; S1 geschnitten S2 = {}
  96. */
  97.  
  98. :: CLASS RelBijectiveSet   SUBCLASS Relation       PUBLIC
  99. /* ----------------------------------------------- */
  100. :: METHOD "[]="                 /* override             */
  101.    FORWARD MESSAGE ( "PUT" )    /* let PUT do the work  */
  102.  
  103. /* ----------------------------------------------- */
  104. :: METHOD PUT                   /* override             */
  105.    USE ARG item , index
  106.  
  107.    IF item = index THEN         /* don't allow one element to be in both sets */
  108.       RETURN
  109.                                 /* remove existing entries for item/index     */
  110.    FORWARD MESSAGE ( "removeitem" ) CONTINUE    
  111.    FORWARD CLASS (super)        /* now do the PUT !     */
  112.  
  113. /* ----------------------------------------------- */
  114. :: METHOD REMOVEITEM            /* override */
  115.    USE ARG item , index
  116.  
  117.    indexItem1 = self ~ remove( index )  /* remove index & associated item             */
  118.  
  119.                         /* remove index, if one of item  of new item exists   */
  120.    indexItem2 = self ~ remove( item  )  
  121.  
  122.    /* now the other way around */
  123.                         /* remove item, if one exists of the same item  of an index */
  124.    itemItem1 = self ~ removeitem : super( index, self ~ index( index ) )
  125.                         /* remove index based on item                               */
  126.    itemItem2 = self ~ removeitem : super( item,  self ~ index( item  ) )
  127.  
  128.    tmpSet = .set ~ new
  129.    IF indexItem1 <> .nil THEN tmpSet ~ put( indexItem1 )
  130.    IF indexItem2 <> .nil THEN tmpSet ~ put( indexItem2 )
  131.    IF itemItem1  <> .nil THEN tmpSet ~ put( itemItem1 )
  132.    IF itemItem2  <> .nil THEN tmpSet ~ put( itemItem2 )
  133.  
  134.    RETURN tmpSet                        /* returns the set of removed items */
  135.  
  136.  
  137.  
  138. /* ----------------------------------------------- */
  139. :: METHOD HASITEM               /* override */
  140.    USE ARG item , index
  141.  
  142.    IF self ~ hasitem : super( item, index ) THEN RETURN .true
  143.                                 /* now the other way round      */
  144.    RETURN self ~ hasitem : super( index, item )   
  145.  
  146.  
  147. /* -----------------------------------------------------------------------------*/
  148. /********************************************************************************/
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156. /********************************************************************************/
  157. /* .directory-like, because of enhancing with SETENTRY, ENTRY, HASENTRY */
  158.  
  159. :: CLASS RelDir         MIXINCLASS Relation     PUBLIC
  160. /* ----------------------------------------------- */
  161. :: METHOD  ENTRY
  162.    USE ARG name
  163.                                 /* return an item associated with name */
  164.    RETURN self ~ at( TRANSLATE( name ))
  165.  
  166. /* ----------------------------------------------- */
  167. :: METHOD  HASENTRY
  168.    USE ARG name
  169.                                 /* return an item associated with name */
  170.    RETURN self ~ hasindex( TRANSLATE( name ))
  171.  
  172.  
  173. /* ----------------------------------------------- */
  174. :: METHOD  SETENTRY
  175.    USE ARG name, value          /* index == name                        */
  176.  
  177.                                 /* use the uppercase version of the string      */
  178.    self ~ PUT( value, TRANSLATE( name ))
  179.  
  180. /* ----------------------------------------------- */
  181. :: METHOD  UNKNOWN                      /* define an unknown method     */
  182.    USE ARG messageName, messageArgs
  183.  
  184.                                 /* setentry method ?                    */
  185.    IF RIGHT( messageName, 1 ) = "=" THEN
  186.    DO
  187.                                 /* remove trailing "="                  */
  188.       index = LEFT( messageName, LENGTH( messageName ) - 1 )    
  189.       FORWARD MESSAGE ( "SETENTRY" ) ARRAY ( index, messageArgs[ 1 ] )  
  190.    END
  191.    ELSE
  192.       FORWARD MESSAGE ( "ENTRY" )    ARRAY ( messageName )
  193.  
  194. /* -----------------------------------------------------------------------------*/
  195. /********************************************************************************/
  196.  
  197.  
  198.  
  199. /* --->
  200. /* using multiple inheritance to add relDir's methods to testRel in addition to .Relation */
  201. :: class testRel subclass RelBijectiveSet PUBLIC INHERIT relDir
  202. <--- */
  203.  
  204.  
  205.