IntermediatesForSqueak.ns

Newspeak3
'Mirrors'
class IntermediatesForSqueak usingPlatform: p = (
(* The output of the compiler and the mutable internals of a mirror builder.

Synthetics: slot accessors, nested class slots, nested class accessor, instance initializers, factories


* The LowLevelMirrors module defines a mirror library at the level of abstraction of the virtual machine - in this case, Squeak.  Ideally, the high level mirror library will depend on the low level mirror API, and be largely isolated from the details of Squeak.


   Copyright 2008 Cadence Design Systems, Inc.
   Copyright 2011 Ryan Macnak

   Licensed under the Apache License, Version 2.0 (the ''License''); you may not use this file except in compliance with the License.  You may obtain a copy of the License at  http://www.apache.org/licenses/LICENSE-2.0
 *)
|
private List = p collections List.
private Map = p collections Map.

private CompiledMethod = p squeak CompiledMethod.
private CompiledMethodTrailer = p squeak CompiledMethodTrailer.
private AdditionalMethodState = p squeak AdditionalMethodState.
private EncoderForNewsqueakV4 = p squeak EncoderForNewsqueakV4.
|) (
public class IntermediateClassDeclaration = (|
simpleNameX
public headerSource
public factoryName
public comment
public category
public instanceSide = IntermediateMixin for: self isMeta: false.
public classSide = IntermediateMixin for: self isMeta: true.
public enclosingClass <IntermediateMixin>
public builder <ClassDeclarationBuilder>
public existingMixin
public accessor <IntermediateMethod>
public factory <IntermediateMethod>
public initializers <List[IntermediateMethod]>
|) (
public accessModifier ^<Symbol> = (
	isTopLevel ifTrue: [^#public].
	^accessor accessModifier
)
public addSyntheticSlotsTo: slots = (
	| slot = IntermediateSlotDeclaration new. |
	slot name: (simpleName, '`slot') asSymbol.
	slot isMutable: true.
	slot accessModifier: #private.
	slots add: slot.
)
public isTopLevel = (
	nil = enclosingClass ifFalse: [^false].
	(* No enclosing class computed yet, but might be just be deferred. *)
	nil = existingMixin ifTrue: [^true (* New class declarations are eagerly computed. *)].
	^nil = existingMixin enclosingMixin
)
public name = (
	^simpleName
)
public printOn: stream = (
	stream nextPutAll: 'IntermediateClassDeclaration:'; nextPutAll: qualifiedName.
)
public simpleName= (
	^simpleNameX
)
public simpleName: n = (
	(n includes: "`") ifTrue: [halt].
	simpleNameX: n
)
) : (
)
public class IntermediateMethod = (|
public method <CompiledMethod>
public debugInfo
public maxStack <Integer>
public maxLocals <Integer>
public argCount <Integer>
public literals <List[Object]>
public bytes <List[Byte]> ::= List new.
public selector <Symbol>
public methodMixin <AbstractMixin>
public source <String>
public pragmas
public psPrimitive
public accessModifier <Symbol>

public metadata = Map new.

public category
public isSynthetic ::= false.
|) (
public bci ^<Integer> = (
	^bytes size + 1
)
public byte: b <Integer> = (
	assert: [0 <= b and: [b <= 255]] message: 'Bytecode out of range'.
	bytes add: b
)
public byteAt: index <Integer> ^<Integer> = (
	^bytes at: index
)
public byteAt: index <Integer> put: datum <Integer> = (
	bytes at: index put: datum
)
cleanup = (
	literals:: nil.
	bytes:: nil
)
public compiledMethod ^<CompiledMethod> = (
	| properties <MethodProperties> offset <Integer> |
	method isNil ifFalse: [^method].

	assert: [argCount <= maxLocals] message: ''.

	method:: instantiateMethodV4.

	(1 to: literals size)
		with: literals asOrderedCollection
		do: [:i :lit | method literalAt: i put: lit].

	method selector: selector.
	method methodClass: methodMixin.

	(pragmas isNil or: [pragmas isEmpty]) ifFalse:
		[properties:: AdditionalMethodState forMethod: method selector: selector.
		pragmas do: [:p | properties:: properties copyWith: p].
		method properties: properties].

	offset:: method initialPC - 1.
	1 to: bytes size do:
		[:i | method basicAt: i + offset put: (bytes at: i)].

	setSourceAndCategory.
	cleanup.

	^method
)
instantiateMethodV4 ^<CompiledMethod> = (
	| header cmethod |
	header:: EncoderForNewsqueakV4 basicNew
		computeMethodHeaderForNumArgs: argCount
		numTemps: maxLocals
		numLits: literals size + 2
		primitive: 0
		accessModifier: accessModifier.

	cmethod:: CompiledMethodTrailer empty
		createMethod: bytes size
		class: CompiledMethod
		header: header.

	cmethod needsFrameSize:
		(maxStack min: CompiledMethod fullFrameSize - maxLocals). (*Suppress warning about frame too big, which apparently is not checked in the constructor used by instantiateMethodV3 and is actually exceeded in some Newspeak code.*)

	^cmethod
)
public isSubinitializer: b <Boolean> = (
	pragmas add: #isSubinitializer -> true
)
public name = (
	^selector
)
public printOn: stream = (
	stream nextPutAll: 'IntermediateMethod:'; nextPutAll: name.
)
setSourceAndCategory = (
	(* This is horrible, but in Squeak access to source is via the compiled method, which stores the information in itself. To make matters worse, the class and category are required. *)
	| cat <String> |
	assert: [methodMixin isNil not] message: 'Missing methodMixin'.
	assert: [category isNil == isSynthetic] message: 'Category should be missing IFF synthetic'.
	isSynthetic ifTrue: [^self (* No source to save *)].
	assert: [category isNil not] message: 'Missing category'.
	method putSource: source fromParseNode: nil class: methodMixin category: category inFile: 2 priorMethod: nil.
)
public simpleName = (
	^selector
)
) : (
)
public class IntermediateMixin for: d isMeta: m = (|
public declaration <IntermediateClassDeclaration> = d.
public isMeta <Boolean> = m.
public slots <List[IntermediateSlotDeclaration]> ::= List new.
public methods <List[IntermediateMethod]> = List new.
public nestedClasses <List[IntermediateClassDeclaration]> = List new.
public transientSlots <List[IntermediateTransientSlot]> = List new.
public builder <MixinBuilder>
|) (
public assembleMethods = (
	| assembledMethods = List new. |
	assembledMethods addAll: methods.
	transientSlots do: [:ts | ts addMethodsInto: assembledMethods ].
	assembleSlots do: [:slot | slot addSyntheticMethodsTo: assembledMethods].
	nestedClasses do: [:nestedClass | assembledMethods add: nestedClass accessor].
	isMeta
		ifTrue: [assembledMethods add: declaration factory]
		ifFalse: [assembledMethods addAll: declaration initializers].
	^assembledMethods
)
public assembleSlots = (
	| assembledSlots = List new. |
	assembledSlots addAll: slots.
	transientSlots do: [:ts | ts addSlotsInto: assembledSlots ].
	nestedClasses do: [:nestedClass | nestedClass addSyntheticSlotsTo: assembledSlots].
	^assembledSlots
)
public checkNameConflictsForFactory: selector <Symbol> = (
	assert: [isMeta] message: ''.
	methods do:
		[:method |
		method selector = selector ifTrue:
			[^Error signal: 'Class already has method named ', selector]].
)
public checkNameConflictsForMethod: selector <Symbol> = (
	nestedClasses do:
		[:nestedClass |
		nestedClass name = selector ifTrue:
			[^Error signal: 'Class already has nested class named ', selector]].
	slots do:
		[:slot |
		slot name = selector ifTrue:
			[^Error signal: 'Class already has slot named ', selector].
		(slot isMutable and: [(slot name, ':') = selector]) ifTrue:
			[^Error signal: 'Class already has mutable slot named ', selector]].
	isMeta ifTrue:
		[declaration factoryName = selector ifTrue:
			[^Error signal: 'Class already has primary factory named ', selector]].
)
public checkNameConflictsForNestedClass: klassName <Symbol> = (
	methods do:
		[:method |
		method isSynthetic ifFalse:
			[method selector = klassName ifTrue:
				[^Error signal: 'Class already has method named ', klassName]]].
	slots do:
		[:slot |
		slot name = klassName ifTrue:
			[^Error signal: 'Class already has slot named ', klassName]].
)
public checkNameConflictsForSlot: slotName <Symbol> mutable: isMutable <Boolean> = (
	nestedClasses do:
		[:nestedClass |
		nestedClass name = slotName ifTrue:
			[^Error signal: 'Class already has nested class named ', slotName]].
	methods do:
		[:method |
		method selector = slotName ifTrue:
			[^Error signal: 'Class already has method named ', slotName]].
	isMutable ifFalse: [^self].
	methods do:
		[:method |
		method selector = (slotName, ':') ifTrue:
			[^Error signal: 'Class already has method named ', method selector]].
)
public printOn: stream = (
	stream nextPutAll: 'IntermediateMixin:'; nextPutAll: declaration qualifiedName.
	isMeta ifTrue: [stream nextPutAll: ' class'].
)
) : (
)
public class IntermediateSlotDeclaration = (|
public name
public isMutable
public accessModifier
|) (
public addSyntheticMethodsTo: methods = (
	| index = 1. |
	methods add: (generateInitializerForSlot: index).
	methods add: (generateGetterForSlot: index).
		isMutable ifTrue: [methods add: (generateSetterForSlot: index)].
)
public generateGetterForSlot: n <Integer> ^<IntermediateMethod> = (
	| method = IntermediateMethod new. |
	method selector: name asSymbol.
	method accessModifier: accessModifier.
	method method: (CompiledMethod newGetterForSlot: n accessModifier: accessModifier).
	method method selector: method selector.
	method isSynthetic: true.
	^method
)
public generateInitializerForSlot: n <Integer> ^<IntermediateMethod> = (
	| method = IntermediateMethod new. |
	method selector: initializerName.
	method accessModifier: #private.
	method method: (CompiledMethod newSetterForSlot: n accessModifier: #private).
	method method selector: method selector.
	method isSynthetic: true.
	^method
)
public generateSetterForSlot: n <Integer> ^<IntermediateMethod> = (
	| method = IntermediateMethod new. |
	method selector: setterName.
	method accessModifier: accessModifier.
	method method: (CompiledMethod newSetterForSlot: n accessModifier: accessModifier).
	method method selector: method selector.
	method isSynthetic: true.
	^method
)
initializerName ^<Symbol> = (
	^('init`', name, ':') asSymbol
)
public printOn: stream = (
	stream nextPutAll: 'IntermediateSlotDeclaration:'; nextPutAll: simpleName.
)
setterName ^<Symbol> = (
	(* Yuck! This is a copy of Compiler#setterSelectorFor: *)
	^((isMutable ifTrue: [ '' ] ifFalse: [ 'setOnce`' ]), name, ':') asSymbol
)
public simpleName = (
	^name
)
) : (
)
public class IntermediateTransientSlot = (
|
	public	intermediateInitMethod
	public	intermediateMainMethod
	public	intermediateSetterMethod
|
) (
public addMethodsInto: aCollection = (
	aCollection add: intermediateInitMethod.
	aCollection add: intermediateMainMethod.
	isMutable ifTrue: [ aCollection add: intermediateSetterMethod ]
)
public addSlotsInto: aCollection = (
	aCollection add: intermediateSlotDeclaration.
)
public intermediateSlotDeclaration = (
	|slot|
	slot:: IntermediateSlotDeclaration new.
	slot name: (class slotNameForTransientSlotNamed: name).
	slot isMutable: true.
	slot accessModifier: #private.
	^slot.
)
public isMutable = (
	^intermediateSetterMethod isNil not.
)
public name = (
	^intermediateMainMethod selector.
)
public simpleName = (
	^name
)
public source = (
	^intermediateMainMethod source
)
) : (
public initMethodNameForTransientSlotNamed: selector = (
	^(selector, '`method') asSymbol
)
public slotNameForTransientSlotNamed: selector = (
	^(selector, '`cacheSlot') asSymbol
)
)
) : (
)