home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / orx8.zip / is_util.cmd < prev    next >
OS/2 REXX Batch file  |  1997-07-21  |  13KB  |  302 lines
  1. /*
  2.    Module for supplying basic Is*-routines
  3.  
  4. program:   Is_Util.cmd
  5. type:      Object REXX, REXXSAA 6.0
  6. purpose:   implements routines and methods for testing, e.g. IsClassObject, IsDescendedFrom,
  7.            IsA. IsInstanceOf, IsA2 (cf. comments in code)
  8. version:   1.0.1
  9. date:      1997-04-15
  10. changed:   1997-06-27, ---rgf, removed pp() which should not have been in here anyway
  11.  
  12. author:    Rony G. Flatscher
  13.            Rony.Flatscher@wu-wien.ac.at
  14.            (Wirtschaftsuniversitaet Wien, University of Economics and Business
  15.            Administration, Vienna/Austria/Europe)
  16.  
  17. needs:     ---
  18.  
  19. usage:     call or require this module
  20.  
  21. comments:  prepared for the "8th International Rexx Symposium 1997,
  22.            sponsored by the Rexx Language Association"
  23.  
  24. All rights reserved and copyrighted 1997 by the author,
  25. no guarantee that it works without errors, etc. etc.
  26.  
  27. 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
  28. it in the first place) or modules directly derived from this module, that you document the original author (to give appropriate
  29. credit) with the original name of the module and that you make the unaltered, original source-code of this module available on
  30. demand.  If that holds, you may even bundle this module (either in source or compiled form) with commercial software.
  31.  
  32. If you find an error, please send me the description (preferably a *very* short example);
  33. I'll try to fix it and re-release it to the net.
  34. */
  35.  
  36.  
  37.  
  38. :: ROUTINE get_methods_FROM_is_util PUBLIC  /* return the method-directory  */
  39.    RETURN .methods
  40.  
  41.  
  42. /* ANSI-Vorschlag von rgf, 96-11 */
  43.  
  44.  
  45. /* <----------          -----------> */
  46. /* floating method for determining whether self is a class object */
  47. :: METHOD IsClassObject
  48.    RETURN IsClassObject( self )
  49.  
  50.  
  51. /******************************************************************************/
  52. /*                                                                            */
  53. /* name:    IsClassObject( object )                                           */
  54. /*                                                                            */
  55. /* purpose: determines whether argument is a class object                     */
  56. /*                                                                            */
  57. /*                                                                            */
  58. /* returns: .true if argument is a class object, .false else                  */
  59. /*                                                                            */
  60. /* remarks: ---                                                               */
  61. /*                                                                            */
  62. /*          rgf, 96-11-15                                                     */
  63.  
  64. /* determine whether an object is a class object, PUBLIC ROUTINE      */
  65. :: ROUTINE IsClassObject      PUBLIC
  66.    USE ARG instance
  67.  
  68.    RETURN DetIsClassObject( instance ~ class )
  69.  
  70. /* determine class-object property:
  71.    a class object is one which belongs to a (sub)class which
  72.    is defined on its own terms, i.e. its metaclass is the class itself;
  73.  
  74.    returns .true if instance is a class object, .false else
  75. */
  76. DetIsClassObject : PROCEDURE          /* recursively check    */
  77.    USE ARG class
  78.  
  79.    IF class = .object THEN RETURN .false
  80.    IF class = class ~ metaclass THEN RETURN .true
  81.    RETURN DetIsClassObject( class ~ SUPERCLASSES[ 1 ] )
  82. /******************************************************************************/
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89. /* <----------          -----------> */
  90. /* floating method for determining whether self is a class object */
  91. :: METHOD IsDescendedFrom
  92.    USE ARG SuperClass
  93.  
  94.    RETURN IsDescendedFrom( self, SuperClass )
  95.  
  96.  
  97. /******************************************************************************/
  98. /*                                                                            */
  99. /* name:    IsDescendedFrom( ClassObject1, ClassObject2 )                     */
  100. /*                                                                            */
  101. /* purpose: generic test, whether first argument is either of the same class  */
  102. /*          or a subclass of the second argument's class                      */
  103. /*                                                                            */
  104. /* returns: .true if first argument (a class object) is the same as the       */
  105. /*          second argument (a class object) or one of its subclasses         */
  106. /*                                                                            */
  107. /* remarks: modelled after "somDescendedFrom"                                 */
  108. /*                                                                            */
  109. /* needs:   ROUTINE IsDescendedFrom                                           */
  110. /*          rgf, 96-11-16                                                     */
  111.  
  112. :: ROUTINE IsDescendedFrom                   PUBLIC
  113.    USE ARG ClassO1, ClassO2
  114.  
  115.    IF \ IsClassObject( ClassO1 ) THEN   /* 1st argument not a class object !  */
  116.    DO
  117.       SIGNAL ON SYNTAX
  118.       RAISE SYNTAX 93.914 ARRAY ( "# 1", "the class objects", ClassO1 ~ string )
  119.    END
  120.  
  121.    IF \ IsClassObject( ClassO2 ) THEN   /* 2nd argument not a class object !  */
  122.    DO
  123.       SIGNAL ON SYNTAX
  124.       RAISE SYNTAX 93.914 ARRAY ( "# 2", "the class objects", ClassO2 ~ string )
  125.    END
  126.  
  127.    RETURN DetIsDescendedFrom( ClassO1, ClassO2 )
  128.  
  129. SYNTAX :
  130.    RAISE PROPAGATE              /* show caller's error position */
  131.  
  132. DetIsDescendedFrom : PROCEDURE
  133.    USE ARG ClassO1, ClassO2
  134.  
  135.    IF ClassO1 = ClassO2 THEN RETURN .true
  136.  
  137.    SCArray = ClassO1 ~ SUPERCLASSES        /* get superclasses     */
  138.    DO tmpClass OVER SCArray             /* test immediate superclasses  */
  139.       IF tmpClass = ClassO2 THEN RETURN .true
  140.    END
  141.  
  142.    /* not found, maybe one of the superClasses preceding the immediate ones ? */
  143.    DO tmpClass OVER SCArray             /* test immediate superclasses  */
  144.       IF DetIsDescendedFrom( tmpClass, ClassO2 ) THEN RETURN .true
  145.    END
  146.  
  147.    RETURN .false
  148. /******************************************************************************/
  149.  
  150.  
  151.  
  152.  
  153. /* <----------          -----------> */
  154. /* floating method for determining whether self is an instance of class object*/
  155. :: METHOD IsA
  156.    USE ARG SuperClass
  157.  
  158.    RETURN IsA( self, SuperClass )
  159.  
  160.  
  161. /******************************************************************************/
  162. /*                                                                            */
  163. /* name:    IsA( object, class object )                                       */
  164. /*                                                                            */
  165. /* purpose: generic test, whether first argument is either of the same class  */
  166. /*          or a subclass of the second argument's class                      */
  167. /*                                                                            */
  168. /* returns: .true if first argument is either of the same class or a subclass */
  169. /*          of the second argument's class, .false else                       */
  170. /*                                                                            */
  171. /* remarks: first argument's class object is tested against the second        */
  172. /*          argument, which must be a class object;                           */
  173. /*          modelled after "somIsA"                                           */
  174. /*                                                                            */
  175. /* needs:   ROUTINE IsClassObject                                             */
  176. /*          rgf, 96-11-15                                                     */
  177.  
  178. :: ROUTINE IsA                   PUBLIC
  179.    USE ARG Object1, ClassObject2
  180.  
  181.  
  182.    IF \ IsClassObject( ClassObject2 ) THEN
  183.    DO
  184.       SIGNAL ON SYNTAX
  185.       RAISE SYNTAX 93.914 ARRAY( "# 2", "[the class objects]",,
  186.                                  ClassObject2 ~ string )
  187.    END
  188.  
  189.    RETURN DetIsA( Object1 ~ class, ClassObject2 )
  190.  
  191. SYNTAX :
  192.    RAISE PROPAGATE              /* show caller's error position */
  193.  
  194. DetIsA : PROCEDURE
  195.    USE ARG ClassObject1, SuperClass
  196.  
  197.    IF ClassObject1 = SuperClass THEN RETURN .true
  198.  
  199.    SCArray = ClassObject1 ~ SUPERCLASSES       /* get superclasses      */
  200.    DO tmpClass OVER SCArray             /* test immediate superclasses  */
  201.       IF tmpClass = SuperClass THEN RETURN .true
  202.    END
  203.  
  204.    /* not found, maybe one of the superclasses preceding the immediate ones ? */
  205.    DO tmpClass OVER SCArray             /* test immediate superclasses  */
  206.       IF DetIsA( tmpClass, SuperClass ) THEN RETURN .true
  207.    END
  208.  
  209.    RETURN .false
  210. /******************************************************************************/
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217. /* <----------          -----------> */
  218. /* floating method for determining whether self is an instance of class object*/
  219. :: METHOD IsInstanceOf
  220.    USE ARG Class
  221.  
  222.    RETURN IsInstanceOf( self, Class )
  223.  
  224.  
  225. /******************************************************************************/
  226. /*                                                                            */
  227. /* name:    IsInstanceOf( object, class object )                              */
  228. /*                                                                            */
  229. /* purpose: generic test, whether first argument is an instance of second     */
  230. /*          argument which is a class object                                  */
  231. /*                                                                            */
  232. /* returns: .true if first argument is instance of second argument (a         */
  233. /*          class object)                                                     */
  234. /*                                                                            */
  235. /* remarks: modelled after "somInstanceOf"                                    */
  236. /*                                                                            */
  237. /*          rgf, 96-11-16                                                     */
  238.  
  239. :: ROUTINE IsInstanceOf                   PUBLIC
  240.    USE ARG Object, Class
  241.  
  242.    RETURN ( Object ~ class = Class )
  243. /******************************************************************************/
  244.  
  245.  
  246.  
  247.  
  248.  
  249. /* <----------          -----------> */
  250. /* floating method for determining whether self is a class object */
  251. :: METHOD IsA2
  252.    USE ARG SuperClass
  253.  
  254.    RETURN IsA2( self, SuperClass )
  255.  
  256.  
  257. /******************************************************************************/
  258. /*                                                                            */
  259. /* name:    IsA2( object, class object )                                      */
  260. /*                                                                            */
  261. /* purpose: generic test, whether first argument is either of the same class  */
  262. /*          or a subclass of the second argument                              */
  263. /*                                                                            */
  264. /* returns: .true if first argument is either of the same class or a subclass */
  265. /*          of the second argument's class, .false else                       */
  266. /*                                                                            */
  267. /* remarks: this is a "relaxed" version, folding e.g. "somIsA" and            */
  268. /*          "somDescendedFrom" into one function;                             */
  269. /*          each argument is tested whether it is a class object, if not      */
  270. /*          its class object is used in the test                              */
  271. /*                                                                            */
  272. /* needs:   ROUTINE IsClassObject                                             */
  273. /*          rgf, 96-11-15                                                     */
  274.  
  275. :: ROUTINE IsA2                   PUBLIC
  276.    USE ARG ClassObject1, ClassObject2
  277.  
  278.    IF \ IsClassObject( ClassObject1 ) THEN ClassObject1 = ClassObject1 ~ class
  279.    IF \ IsClassObject( ClassObject2 ) THEN ClassObject2 = ClassObject2 ~ class
  280.  
  281.    RETURN DetIsA2( ClassObject1, ClassObject2 )
  282.  
  283.  
  284. DetIsA2 : PROCEDURE
  285.    USE ARG ClassObject1, SuperClass
  286.  
  287.    IF ClassObject1 = SuperClass THEN RETURN .true
  288.  
  289.    SCArray = ClassObject1 ~ SUPERCLASSES       /* get superclasses      */
  290.    DO tmpClass OVER SCArray             /* test immediate superclasses  */
  291.       IF tmpClass = SuperClass THEN RETURN .true
  292.    END
  293.  
  294.    /* not found, maybe one of the superclasses preceding the immediate ones ? */
  295.    DO tmpClass OVER SCArray             /* test immediate superclasses  */
  296.       IF DetIsA2( tmpClass, SuperClass ) THEN RETURN .true
  297.    END
  298.  
  299.    RETURN .false
  300. /******************************************************************************/
  301.  
  302.