# core/implementation/Object.tcl

    @implementation Object {

      + new {} {
          return [[$self alloc] init]
        }

      + alloc {} {
          return [@newInstanceFromClass $self]
        }

      - init {} {
          set refCount 1
        }

      - copy {} {
          set _newInstance [[$self class] new]
          upvar #0 @[$self class] _Class
          upvar #0 @${_newInstance} _NewInstance
          foreach _var $_Class(instance,variables) {
            if [regexp {^@} $_var] {
              global @${_newInstance}@{_$var}
              array set @${_newInstance}@{_$var} [array get $_var]
            } else {
              set _NewInstance($_var) [set $_var]
            }
          }
          return $_newInstance
        }

      - refCount {} {
          return $refCount
        }

      - retain {} {
          incr refCount
        }

      - release {} {
          incr refCount -1
          if {$refCount <= 0} {
            return [$self dealloc]
          }
        }

      - autorelease {} {
          if [string length [set _level [@getCallerLevel]]] {
            if {![uplevel #${_level} info exists AutoReleasePool]} {
              return -code error "must first create an AutoReleasePool object \
                before to invoke autorelease msg!"
            }
            set _cmd "\$AutoReleasePool add: $self"
            uplevel #${_level} $_cmd
          } else {
            return -code error "couldn't find caller level ([info level 0])"
          }
        }

      + self {} {
          return $self
        }

      - self {} {
          return $self
        }

      + class {} {
          return $self
        }

      - class {} {
          upvar #0 @$self _SELF
          return $_SELF(class)
        }

      + superclass {} {
          upvar #0 @$self _CLASS
          return $_CLASS(superclass)
        }

      - superclass {} {
          return [[$self class] superclass]
        }

      + isMemberOfClass: aClass {
          if {![string compare $aClass [$self class]]} {
            return 1
          } else {
            return 0
          }
        }

      - isMemberOfClass: aClass {
          return [[$self class] isMemberOfClass: $aClass]
        }

      + isKindOfClass: aClass {
          set _superclass [$self superclass]
          while [string length $_superclass] {
            if {![string compare $_superclass $aClass]} {
              return 1
            } else {
              set _superclass [$_superclass superclass]
              if {![string length $_superclass]} { return 0 }
            }
          }
          return 0
        }

      - isKindOfClass: aClass {
          return [[$self class] isKindOfClass: $aClass]
        }

      + respondsTo: aSelector {
          upvar #0 @$self _SELF
          if [_SELF(class,selectors) contains: $aSelector] {
            return 1
          } else {
            return 0
          }
        }

      - respondsTo: aSelector {
          upvar #0 @[$self class] _CLASS
          if [_CLASS(instance,selectors) contains: $aSelector] {
            return 1
          } else {
            return 0
          }
        }

      + conformsTo: aProtocol {
          upvar #0 @$self _SELF
          if [_SELF(protocols) contains: $aProtocol] {
            return 1
          } else {
            return 0
          }
        }

      - conformsTo: aProtocol {
          return [[$self class] conformsTo: $aProtocol]
        }

      + forwardInvocation: aMessage {
          return [$self doesNotRecognize: [@selector $aMessage]]
        }

      - forwardInvocation: aMessage {
          return [$self doesNotRecognize: [@selector $aMessage]]
        }

      + doesNotRecognize: aSelector {
          return [$self error: \
            "$self cannot respond to \"$aSelector\" selector !"]
        }

      - doesNotRecognize: aSelector {
          return [$self error: \
            "$self cannot respond to \"$aSelector\" selector !"]
        }

      + error: aString {
          return -code error $aString
        }

      - error: aString {
          return -code error $aString
        }

      + notImplemented: aSelector {
          return [$self error: \
            "\"$aSelector\" selector is not yet implemented !"]
        }

      - notImplemented: aSelector {
          return [$self error: \
            "\"$aSelector\" selector is not yet implemented !"]
        }

      - dealloc {} {
          upvar #0 @${self} _SELF
          unset _SELF
          rename $self ""
          return
        }

    }