Return to objexamp.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/objexamp.fs, revision 1.1

1.1     ! anton       1: \ examples and tests for objects.fs
        !             2: 
        !             3: \ written by Anton Ertl 1996, 1997
        !             4: \ public domain
        !             5: 
        !             6: cr object heap-new print
        !             7: 
        !             8: object class
        !             9: 
        !            10: :noname ( object -- )
        !            11:     drop ." undefined" ;
        !            12: overrides print
        !            13: end-class nothing
        !            14: 
        !            15: nothing heap-new constant undefined
        !            16: 
        !            17: cr undefined print
        !            18: 
        !            19: \ instance variables and this
        !            20: object class
        !            21:     cell% inst-var n
        !            22: m: ( object -- )
        !            23:    0 n ! ;m
        !            24: overrides construct
        !            25: m: ( object -- )
        !            26:     n @ . ;m
        !            27: overrides print
        !            28: m: ( object -- )
        !            29:     1 n +! ;m
        !            30: method inc
        !            31: end-class counter
        !            32: 
        !            33: counter heap-new constant counter1
        !            34: 
        !            35: cr
        !            36: counter1 print
        !            37: counter1 inc
        !            38: counter1 print
        !            39: counter1 inc
        !            40: counter1 inc
        !            41: counter1 inc
        !            42: counter1 print
        !            43: counter1 print
        !            44: 
        !            45: \ examples of static binding
        !            46: 
        !            47: cr undefined bind object print
        !            48: : object-print ( object -- )
        !            49:     [bind] object print ;
        !            50: 
        !            51: cr undefined object-print
        !            52: 
        !            53: \ interface
        !            54: 
        !            55: \ sorry, a meaningful example would be too long
        !            56: 
        !            57: interface
        !            58: selector add ( n object -- )
        !            59: selector val ( object -- n )
        !            60: end-interface foobar
        !            61: 
        !            62: counter class
        !            63:     foobar implementation
        !            64: 
        !            65: m: ( object -- )
        !            66:     this [parent] inc
        !            67:     n @ 10 mod 0=
        !            68:     if
        !            69:        ." xcounter " this object-print ." made another ten" cr
        !            70:     then
        !            71: ;m overrides inc
        !            72:     
        !            73: m: ( n object -- )
        !            74:     0 do
        !            75:        this inc
        !            76:     loop
        !            77: ;m overrides add
        !            78: 
        !            79: m: ( object -- n )
        !            80:     n @
        !            81: ;m overrides val
        !            82: 
        !            83: end-class xcounter
        !            84: 
        !            85: object class
        !            86:     foobar implementation
        !            87: 
        !            88:     cell% inst-var n
        !            89: 
        !            90: m: ( n object -- )
        !            91:     n !
        !            92: ;m overrides construct
        !            93: 
        !            94: m: ( object -- )
        !            95:     n @ .
        !            96: ;m overrides print
        !            97: 
        !            98: m: ( n object -- )
        !            99:     n +!
        !           100: ;m overrides add
        !           101: 
        !           102: protected
        !           103: 
        !           104: create protected1
        !           105: 
        !           106: protected
        !           107: 
        !           108: create protected2
        !           109: 
        !           110: cr order
        !           111: 
        !           112: public
        !           113: 
        !           114: create public1
        !           115: 
        !           116: cr order
        !           117: 
        !           118: \ we leave val undefined
        !           119: end-class int
        !           120: 
        !           121: \ a perhaps more sensible class structure would be to have int as
        !           122: \ superclass of counter, but that would not exercise interfaces
        !           123: 
        !           124: xcounter dict-new constant x
        !           125: create y 3 int dict-new drop \ same as "3 int dict-new constant y"
        !           126: 
        !           127: cr
        !           128: y print cr
        !           129: 20 x add
        !           130: 20 y add
        !           131: x val .
        !           132: \ y val . \ undefined
        !           133: y print
        !           134: cr
        !           135: int push-order
        !           136: order cr
        !           137: words cr
        !           138: int drop-order
        !           139: order
        !           140: cr
        !           141: 
        !           142: object class
        !           143:     foobar implementation
        !           144: 
        !           145:     inst-value N
        !           146: 
        !           147:     m: ( n object -- )
        !           148:         this [parent] construct \ currently does nothing, but who knows
        !           149:         [to-inst] N
        !           150:     ;m overrides construct
        !           151: 
        !           152:     m: ( object -- )
        !           153:         N .
        !           154:     ;m overrides print
        !           155: 
        !           156:     m: ( object -- n )
        !           157:         N
        !           158:     ;m overrides val
        !           159: end-class const-int
        !           160: 
        !           161: 5 const-int heap-new constant five
        !           162: five print
        !           163: five val 1+ . cr
        !           164: .s cr
        !           165: