Animorphic ST (Strongtalk) released!

Ian Piumarta ian.piumarta at inria.fr
Sat Jul 20 15:21:30 UTC 2002


On Sat, 20 Jul 2002, Andreas Raab wrote:

> type annotations. For the remaining 10% you _might_ want to use type
> annotations but I would hope that some better syntax can be found than
> is currently in both StrongTalk and SmallScript.

Why not use message syntax?  We already have it, everyone understands it
and it can be made backward compatible with old images/Compilers that
don't have type annotations (that either ignore it, or implement the
annotations as runtime type checks -- useful for debugging, then turn off
the checks before deploying).

cheesy*displacement.activity: on

How could I possibly resist?  ;)

Here's a stupid dumb example.  File it in, then execute each of the
expressions below in a workspace.

Of course, in a real system you'd send #type: to an identifier and then
expect some kind of consistent implicit constraining of its content.  (In
the stupid example Object>>type: could easily check for a global
TypeCheck set to false and immediately return self.  Wouldn't cost any
more than the current #flag: hack.)

cheesy*displacement.activity: off

Ian

42 type: SmallInteger.
42 type: String.
#(1 2 3) type: (Array of: SmallInteger).
#(1 2 3) type: (ArrayedCollection of: Magnitude).
#(1 2 3) type: (ArrayedCollection of: Point).
(1 to: 10) type: SequenceableCollection.
(1 to: 10) type: (SequenceableCollection of: Integer).
'boo!' type: (SequenceableCollection of: Character).
'boo!' type: (SequenceableCollection of: Magnitude).
'boo!' type: (SequenceableCollection of: Integer).
'boo!' asByteArray type: (SequenceableCollection of: Character).
Smalltalk type: IdentityDictionary.
Smalltalk type: (Collection of: Object).
Smalltalk type: (Collection of: Behavior).
Date today type: Magnitude.
#((1) ($b) (3)) type: (SequenceableCollection of: (Array of: Object)).
#((1) ($b) (3)) type: (SequenceableCollection of: Collection).
#((1) ($b) (3)) type: (SequenceableCollection of: (Collection of: Object)).
#((1) $b (3)) type: (SequenceableCollection of: (Collection of: Object)).
#((1) ($b) (3)) type: (Array of: (Array of: Magnitude)).
#((1) ($b) (3)) type: (Array of: (Array of: Number)).
TextConstants type: (Dictionary of: { Form. Character. Array. Color. TextStyle. String. PopUpMenu. SmallInteger. }).
TextConstants type: (Dictionary of: { Form. Character. Array. Color. TextStyle. String. PopUpMenu. }).
TextConstants type: (Dictionary of: { Form. Magnitude. ArrayedCollection. Color. TextStyle. PopUpMenu. }).

Smalltalk type: (Dictionary of:
	{ Behavior. Morph. Stream. ProcessorScheduler. ControlManager.
	  EventSensor. Dictionary. KeyboardEvent.
	  StandardScriptingSystem. SystemOrganizer.
	  StandardSourceFileArray. DisplayMedium}).
-------------- next part --------------
'From Squeak3.2gamma of 15 January 2002 [latest update: #4881] on 20 July 2002 at 4:58:37 pm'!
Object subclass: #ContainerType
	instanceVariableNames: 'containerType elementType '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Types'!

!Object methodsFor: 'types' stamp: 'ikp 7/20/2002 16:20'!
type: aClass

	(aClass hasInstance: self) ifFalse: [self error: self printString, ' is not of type ', aClass printString].
! !


!Array methodsFor: 'types' stamp: 'ikp 7/20/2002 16:56'!
hasInstance: anObject

	^(self detect: [ :aClass | aClass hasInstance: anObject] ifNone: [nil]) notNil! !


!Behavior methodsFor: 'types' stamp: 'ikp 7/20/2002 16:20'!
hasInstance: anObject

	^anObject isKindOf: self! !


!Collection class methodsFor: 'types' stamp: 'ikp 7/20/2002 16:24'!
of: aClass

	^ContainerType new
		containerType: self
		elementType: aClass! !


!ContainerType methodsFor: 'accessing' stamp: 'ikp 7/20/2002 16:24'!
containerType: ct elementType: et

	containerType _ ct.
	elementType _ et.! !

!ContainerType methodsFor: 'testing' stamp: 'ikp 7/20/2002 16:27'!
hasInstance: anObject

	^(anObject isKindOf: containerType)
		and: [anObject do: [ :elt | (elementType hasInstance: elt) ifFalse: [^false]].
			 true]! !

!ContainerType methodsFor: 'printing' stamp: 'ikp 7/20/2002 16:29'!
printOn: aStream

	aStream nextPut: $(.
	containerType printOn: aStream.
	aStream nextPutAll: ' of: '.
	elementType printOn: aStream.
	aStream nextPut: $)! !


!ContainerType reorganize!
('accessing' containerType:elementType:)
('testing' hasInstance:)
('printing' printOn:)
!



More information about the Squeak-dev mailing list