Newspeak2SqueakCompilation.ns

Newspeak3
'Root'
class Newspeak2SqueakCompilation usingPlatform: platform
 asts: asts
 newspeakParser: ns3Parser
 intermediates: i = NewspeakCompilation
 usingPlatform: platform
 asts: asts (
(* The Newspeak compilation module for Squeak and PrimordialSoup. For a detailed overview of compilation, see Compiler.

Relation to parsing:

Note that this module does not include a parser or AST classes.  These have utility independent of compilation, and so are available as a separate parsing module. This module requires such a parsing module as parameter. It uses this parameter to create a parser for compilation, and to subclass certain AST classes and tools for its own purposes.

The parser is instantiated upon module creation and stored in a module slot. We expect a Newspeak parser to be purely functional; hence we may share it among all compiler instances. It's not clear if this is a valid assumption in the long term.

Separating the parsing module makes it easy to change parsing strategies (though one could also define parsing here and override it in a subclass).

Copyright 2008 Cadence Design Systems, Inc.
Copyright 2010 Gilad Bracha, Felix Geller and Ryan Macnak
Copyright 2011 Matthias Kleine, Ryan Macnak and Cadence Design Systems
Copyright 2012-2013 Gilad Bracha, Ryan Macnak and Cadence Design Systems

   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 Map = platform collections Map.
	private List = platform collections List.
	private Set = platform collections Set.

	private ASTTool = asts ASTTool.

	private AST = asts AST.
	private BlockAST = asts BlockAST.
	private CascadedSendAST = asts CascadedSendAST.
	private CodeBodyAST = asts CodeBodyAST.
	private MessageAST = asts MessageAST.
	private MessagePatternAST = asts MessagePatternAST.
	private MethodAST = asts MethodAST.
	private MutableSlotDefAST = asts MutableSlotDefAST.
	private UnresolvedSendAST = asts UnresolvedSendAST.
	private NumberAST = asts NumberAST.
	private ReturnStatAST = asts ReturnStatAST.
	private SendAST = asts SendAST.
	private SetterSendAST = asts SetterSendAST.
	private StringAST = asts StringAST.
	private SymbolAST = asts SymbolAST.
	private TupleAST = asts TupleAST.
	private VarDeclAST = asts VarDeclAST.
	private VariableAST = asts VariableAST.

	private Pragma = [platform squeak Pragma] on: Error do: [:ex | nil].
	private ProcessorAssociation = [platform squeak Smalltalk associationAt: #Processor] on: Error do: [:ex | nil].

	private IntermediateClassDeclaration = i IntermediateClassDeclaration.
	private IntermediateSlotDeclaration = i IntermediateSlotDeclaration.
	private IntermediateMethod = i IntermediateMethod.
	private IntermediateMixin = i IntermediateMixin.
	private IntermediateTransientSlot = i IntermediateTransientSlot.
	protected parser <CommonParser> = ns3Parser CommonParser new.
|) (
public class Compiler = super Compiler (
(* The compiler has three main entry points: compileClassSource:Within:, compileClassHeader: within: and compileMethodSource:within:. These compile an entire class declaration, a class header, and a method, respectively.

The compiler returns low level (e.g., VM level) objects representing the results of compilation.
These results are described in some detail in the individual methods. The results are never installed by the compiler. The compiler does not know or care whether it is running in the service of a live system. If the compiler is invoked from such a system, the caller may choose to install the results. This should be done as an atomic modification, since the results may be interdependent (e.g., a nested class and its enclosing class).

Compilation begins with parsing to produce an AST. As that tree is walked, each class side creates a scope with its immediate members, before compiling those members within the scope.

When compiling an individual method, we also rewrite its AST into a lower level AST, and submit that to the AST2ByteCodeCompiler, which produces byte code.  If we are compiling a class declaration or a class header, we compute the overall structure of the resulting mixin, including any required synthetic members.

The NS3 implementation involves a considerable amount of synthetic code, dealing with accessors, nested classes, slot initialization, superclass initialization and the primary constructor.

Nested classes are distinct for every instance of an outer class. Hence, every outer class has synthetic fields that hold the class objects for its nested classes. These fields are always accessed by a getter method which lazily initializes the field. The name of the getter method is the simple name of the inner class. The field, in contrast, is named X`slot, where X is the fully qualified name of the inner class' mixin. This is necessary to prevent it from clashing with nested classes with the same simple name elsewhere in the hierarchy. See createNestedClassAccessorFrom:.

The creation of classes is based on producing an IntermediateClassDeclaration for the class.

Nested classes also have an enclosing object slot pointing at the object that created them. See Behavior>>enclosingObjectSlot.

The primary constructor induces a synthetic class method of the same name, which calls a synthetic instance method prefixed with initializer` me on a freshly created instance. Within that instance method is the code for all the slot initializers, as well as the superclass constructor call. See astForPrimaryFactory: and astForClassDeclarationInitializer:. *)
|
currentSource <String>
currentScope <Scope>
currentDepth <Integer> (* The nesting level of the current class; top level classes are at level 0. *)

literalTable <IdentityMap[Symbol, Integer]>
rewriter = Rewriter new.
methodCompiler = AST2ByteCodeCompiler new.

(* We do not use the quick send bytecode for #== or #class because they hardwire the definitions appropriate for Object, but we expect Values and proxies to override #== and #class respectively. *)
specialSelectors =
	{#+. #-. #<. #>. #<=. #>=. #=. #~=. #*. #/. #\\. #@.
	#bitShift:. #//. #bitAnd:. #bitOr:.
	#at:. #at:put:. #size. #next. #nextPut:. #atEnd.
	nil. (* #==. *)
	nil. (* #class. *)
	#blockCopy:. #value. #value:. #do:. #new. #new:. #x. #y}.
|) (
class AST2ByteCodeCompiler = ASTTool (
(* The compiler is a visitor on an AST that has been processed by the rewriter.
It is a subtype of  ASTTool[Self] - that is, its methods do not return individual results, but instead
side effect state within the compiler.

The compiler decides what instructions to generate at a somewhat abstract level, and asks
a code generator object to actually produce the instruction stream.

The code generator deals with issues like whether to use regular or wide instructions,
what the actual instruction codes are, what the actual offsets for branches are etc.,
so the compiler can abstract from these details. One can almost think of this as producing
assembly.

Closure code appears inline (regardless of whether execution is inlined!). Code in a non-inlined closure starts executing with an empty operand stack, but the depth of the method must be sufficient for the block.

To complicate matters further, the actual size of the activation is simply the sum of the number of parameters, number of locals and maximal operand stack size.

We must ensure sufficient space for any given closure defined in the method. The space required for a closure is the sum of its arity, the number of values copied into it, and its maximal operand stack size. Because the closure must explicitly initialize its locals to nil on startup, its operand stack will include sufficient space for its temporaries.

Ideally, we'd track the operand stack depth for the method and for each closure within it separately. Though it seems that the actual required depth would be the maximum of all these, that is simplistic.

We really need to compute the required context size which is the maximum of:

#method formals + #method locals + method operand stack size

#closure formals + #closure copy downs + closure operand stack size

assuming that the locals of the closure are accounted for in the stack size.

Then, the actual operand stack size we specify for the method is

context size - #method formals - #method locals

We don't do this yet.  What we do instead is often suboptimal, but sometimes insufficient. We compute the cumulative maximum operand stack size for all code in the method, including closures. The idea was that this would be conservative and simple, but in fact it may fail if a closure has a large number of arguments and copy-downs, and the actual operand stack usage is small. *)
|
	cgen <CodeGenerator>
	debugInfo <DebugInfo>

	valueExpected <Boolean>

	maxClosureContextSize <Integer>
|) (
class CodeGenerator = (|
public code = IntermediateMethod new.

public numTemps ::= 1. (* temp0 always allocated *) (*why?*)
public maxStackDepth ::= 0.
public currentStackDepth ::= 0.
|) (
public accessModifier: am <Symbol> = (
	code accessModifier: am.
)
public argCount: n <Integer> = (
	code argCount: n
)
public bci ^<Integer> = (
	(* Answers the current bytecode index. Used for calculating jump lengths. Note this is NOT the pc. *)
	^code bci
)
public close ^<LowLevelMethodMirror> = (
	(* To be called at the end of code generation. *)
	| methodContextSize = maxStackDepth + code argCount + code maxLocals. |
	code maxStack: (methodContextSize max: maxClosureContextSize).
	^code
)
public decrementStackDepthBy: n = (
	(* Reduce the current height of the operand stack *)
	currentStackDepth:: currentStackDepth - n.
	assert: [currentStackDepth >= 0]
		message: 'Stack depth must not be negative'.
)
public incrementStackDepthBy: n = (
	(* Increase the current height of the operand stack. Keep track of the maximum operand stack height seen in this method (that's the whole point of tracking the stack height - we need this to create a CompiledMethod. *)
	currentStackDepth:: currentStackDepth + n.
	maxStackDepth:: maxStackDepth max: currentStackDepth.
)
public literals: ls = (
	code literals: ls.
)
public maxLocals ^<Integer> = (
	^code maxLocals
)
public maxLocals: n <Integer> = (
	code maxLocals: n
)
public methodName: n <Symbol> = (
	code selector: n
)
public pushMixin = (
	(* The mixin will be stored in the final literal -added after the end of the literal array *)
	pushLiteralWithIndex: literalTable size + 1
)
) : (
)
class CodeGeneratorV4 = CodeGenerator (
) (
public createClosureOfArity: numArgs copying: numCopied length: jumpSize = (
	| numExtensions numCopiedMod8 numArgsMod8 extA |

	decrementStackDepthBy: numCopied.
	incrementStackDepthBy: 1.

	assert: [jumpSize between: 0 and: 65535]
		message: 'Closure jump out of range'.
	assert: [numCopied between: 0 and: 127]
		message: 'Too many copied values in closure'.
	assert: [numArgs between: 0 and: 127]
		message: 'Too many args in closure'.

	extA:: numExtensions:: 0.
	(numArgsMod8:: numArgs) > 7 ifTrue:
		[extA:: numArgs // 8.
		 numArgsMod8:: numArgsMod8 \\ 8].
	(numCopiedMod8:: numCopied) > 7 ifTrue:
		[extA:: extA + (numCopied // 8 * 16).
		 numCopiedMod8:: numCopiedMod8 \\ 8].
	0 = extA ifFalse:
		[self unsignedSingleExtendA: extA.
		 numExtensions:: 1].
	(*jumpSize > 255 ifTrue: *)
		numExtensions:: numExtensions + 1.
		 unsignedSingleExtendB: jumpSize // 256.
	code
		byte: 253;
		byte: (numExtensions << 6) + (numCopiedMod8 << 3) + numArgsMod8;
		byte: (jumpSize bitAnd: 16rFF)
)
public createEmptyArray: size = (
	(* 231 11100111 jkkkkkkk	Push (Array new: kkkkkkk) (j = 0) *)
	assert: [size between: 0 and: 127] message: 'Array size must be < 128'.
	incrementStackDepthBy: 1.
	code byte: 231; byte: size.
)
public createFullArray: size = (
	assert: [size between: 0 and: 127] message: 'Array size must be < 128'.
	decrementStackDepthBy: size.
	incrementStackDepthBy: 1.
	code byte: 231; byte: 128 + size.
)
public dup = (
	code byte: 219.
	incrementStackDepthBy: 1.
)
public implicitReceiverSend: selector numArgs: numArgs = (
	|
	selectorIndex = indexForLiteral: selector.
	extendedIndex extendedNArgs
	|
	decrementStackDepthBy: numArgs.
	incrementStackDepthBy: 1.

	assert: [selectorIndex between: 0 and: 32767]
		message: 'Selector index out of range'.
	assert: [numArgs between: 0 and: 31]
		message: 'Message arity out of range'.

	(selectorIndex < 16 and: [numArgs = 0]) ifTrue:
	 	[code byte: 160 + selectorIndex. ^self].

	(extendedIndex:: selectorIndex) > 31 ifTrue:
		[self unsignedSingleExtendA: extendedIndex // 32.
		 extendedIndex:: extendedIndex \\ 32].
	(extendedNArgs:: numArgs) > 7 ifTrue:
		[self unsignedSingleExtendB: extendedNArgs // 8.
		 extendedNArgs:: extendedNArgs \\ 8].
	code
		byte: 240;
		byte: extendedNArgs + (extendedIndex * 8)
)
public indexForLiteral: literal = (
	^literalTable at: literal
)
public jumpBy: distance <Integer> = (
	distance < 0 ifTrue:
		[assert: [distance between: -32768 and: -1]
			message: 'Unconditional backjump out of range'.

		signedSingleExtendB: (distance >> 8).
		code byte: 242; byte: (distance bitAnd: 255).
		^self].

	assert: [distance between: 0 and: 32767]
		message: 'Unconditional jump out of range'.

	signedSingleExtendB: (distance >> 8).
	code byte: 242; byte: (distance bitAnd: 255).
)
public jumpIf: bool <Boolean> by: distance <Integer> = (
	(* Always generates unextended jumps *)

	assert: [distance between: 0 and: 32767]
		message: 'Conditional jump out of range'.

	decrementStackDepthBy: 1.

	unsignedSingleExtendB: (distance >> 8).
	code
		byte: (bool ifTrue: [243] ifFalse: [244]);
		byte: (distance bitAnd: 255).
)
public nop = (
	code byte: 221
)
public normalSend: selector numArgs: numArgs = (
	|
	selectorIndex
	extendedIndex extendedNArgs
	|

	decrementStackDepthBy: numArgs + 1 (* the receiver *).
	incrementStackDepthBy: 1.

	(specialSelectors includes: selector) ifTrue:
		[code byte: 79 + (specialSelectors indexOf: selector).
		^self].

	selectorIndex:: indexForLiteral: selector.

	assert: [selectorIndex between: 0 and: 32767]
		message: 'Selector index out of range'.
	assert: [numArgs between: 0 and: 31]
		message: 'Message arity out of range'.

	(selectorIndex < 16 and: [numArgs < 3]) ifTrue:
	 	[code byte: 112 + (numArgs * 16) + selectorIndex.
		 ^self].

	(extendedIndex:: selectorIndex) > 31 ifTrue:
		[self unsignedSingleExtendA: extendedIndex // 32.
		 extendedIndex:: extendedIndex \\ 32].
	(extendedNArgs:: numArgs) > 7 ifTrue:
		[self unsignedSingleExtendB: extendedNArgs // 8.
		 extendedNArgs:: extendedNArgs \\ 8].
	code
		byte: 238;
		byte: extendedNArgs + (extendedIndex * 8)
)
public outerSend: selector numArgs: numArgs depth: depth = (
	|
	selectorIndex = indexForLiteral: selector.
	extendedIndex extendedNArgs
	|
	assert: [selectorIndex between: 0 and: 32767]
		message: 'Selector index out of range'.
	assert: [numArgs between: 0 and: 31]
		message: 'Message arity out of range'.
	assert: [depth between: 0 and: 255]
		message: 'Lexical depth out of range'.

	decrementStackDepthBy: numArgs.
	incrementStackDepthBy: 1.

	(extendedIndex:: selectorIndex) > 31 ifTrue:
		[unsignedSingleExtendA: extendedIndex // 32.
		 extendedIndex:: extendedIndex \\ 32].
	(extendedNArgs:: numArgs) > 7 ifTrue:
		[self unsignedSingleExtendB: extendedNArgs // 8.
		 extendedNArgs:: extendedNArgs \\ 8].
	code
		byte: 254;
		byte: extendedNArgs + (extendedIndex * 8);
		byte: depth
)
public patchClosureJumpAt: blockBci <Integer> with: distance <Integer> = (
	assert: [distance between: 0 and: 65535] message: 'Closure jump out of range'.
	assert: [(code byteAt: blockBci - 5) = 225] message: 'Not really a closure/extb?'.
	code byteAt: blockBci - 4 put: (distance >> 8).
	assert: [(code byteAt: blockBci - 3) = 253] message: 'Not really a closure?'.
	code byteAt: blockBci - 1 put: (distance bitAnd: 255)
)
public patchJumpAt: jumpBci <Integer> with: distance <Integer> = (
	| extendedIndex |

	assert: [distance between: 0 and: 32767]
		message: 'Unconditional jump out of range'.

	assert: [(code byteAt: jumpBci - 4) = 225] message: 'Not really a jump/extb?'.

	extendedIndex:: distance >> 8.
	code byteAt: jumpBci - 3 put: (extendedIndex >= 0
			ifTrue: [extendedIndex]
			ifFalse: [extendedIndex + 256]). (*patch the extend b*)

	assert: [(code byteAt: jumpBci - 2) = 242] message: 'Not really a jump?'.

	code byteAt: jumpBci - 1 put: (distance bitAnd: 255).
)
public patchJumpIfAt: jumpBci <Integer> with: distance <Integer> = (
	assert: [distance between: 0 and: 32767]
		message: 'Conditional jump out of range'.

	assert: [(code byteAt: jumpBci - 4) = 225] message: 'Not really a branch/extb?'.
	code byteAt: jumpBci - 3 put: (distance >> 8).
	assert: [(code byteAt: jumpBci - 2) between: 243 and: 244] message: 'Not really a branch?'.
	code byteAt: jumpBci - 1 put: (distance bitAnd: 255)
)
public pop = (
	code byte: 220.
	decrementStackDepthBy: 1.
)
public popIntoRemoteTemporary: index inVector: vectorIndex = (
	assert: [index between: 0 and: 255]
		message: 'Temp index out of range'.
	assert: [vectorIndex between: 0 and: 255]
		message: 'Temp vector index out of range'.

	code byte: 252; byte: index; byte: vectorIndex.
	decrementStackDepthBy: 1.
)
public popIntoTemporary: index = (
	assert: [index between: 0 and: 63] message: 'Temp index out of range'.

	(* 184-191	10111 i i i	Pop and Store Temporary Variable #iii *)
	index < 8 ifTrue:
		[code byte: 184 + index.
		decrementStackDepthBy: 1.
		^self].

	(* 237  11101101	i i i i i i i i  Pop and Store Temporary Variable #iiiiiiii *)
	code byte: 237; byte: index.
	decrementStackDepthBy: 1.
)
public pushEnclosingObject: depth = (
	assert: [depth between: 0 and: 127]
		message: 'Enclosing object depth out of range'.

	depth = 0 ifTrue: [^pushSelf].

	incrementStackDepthBy: 1.

	signedSingleExtendB: depth negated.
	code byte: 77
)
public pushFalse = (
	code byte: 77.
	incrementStackDepthBy: 1.
)
public pushInteger: n <Integer> = (
	incrementStackDepthBy: 1.
	n = 0 ifTrue: [code byte: 78. ^self].
	n = 1 ifTrue: [code byte: 79. ^self].
	assert: [n between: -32768 and: 32767]
		message: 'Quick integer out of range'.
	(n < 0 or: [n > 255]) ifTrue: [signedSingleExtendB: (n >> 8)].
	code byte: 229.
	code byte: (n bitAnd: 255).
)
public pushLiteral: value = (
	true = value ifTrue: [^pushTrue].
	false = value ifTrue: [^pushFalse].
	nil = value ifTrue: [^pushNil].
	(value isKindOfInteger and: [value between: -32768 and: 32767])
		ifTrue: [^pushInteger: value].
	^pushLiteralWithIndex: (indexForLiteral: value).
)
public pushLiteralVariable: association = (
	| index = indexForLiteral: association. extendedIndex |

	assert: [index between: 0 and: 32767]
		message: 'Literal index out of range'.

	incrementStackDepthBy: 1.

	index < 16 ifTrue: [code byte: 16 + index. ^self].

	(extendedIndex:: index) > 255 ifTrue:
		[unsignedSingleExtendA: extendedIndex // 256.
		extendedIndex:: extendedIndex \\ 256].
	code byte: 227; byte: extendedIndex.
)
public pushLiteralWithIndex: index = (
	| extendedIndex |

	assert: [index between: 0 and: 32767]
		message: 'Literal index out of range'.

	incrementStackDepthBy: 1.

	index < 32 ifTrue: [code byte: 32 + index. ^self].

	(extendedIndex:: index) > 255 ifTrue:
		[unsignedSingleExtendA: extendedIndex // 256.
		extendedIndex:: extendedIndex \\ 256].
	code byte: 228; byte: extendedIndex.
)
public pushNil = (
	unsignedSingleExtendB: 2.
	code byte: 77.
	incrementStackDepthBy: 1.
)
public pushRemoteTemporary: index inVector: vectorIndex = (
	assert: [index between: 0 and: 255]
		message: 'Temp index out of range'.
	assert: [vectorIndex between: 0 and: 255]
		message: 'Temp vector index out of range'.

	code byte: 250; byte: index; byte: vectorIndex.
	incrementStackDepthBy: 1.
)
public pushSelf = (
	code byte: 76.
	incrementStackDepthBy: 1.
)
public pushTemporary: index = (
	assert: [index between: 0 and: 63] message: 'Temp index out of range'.

	(* 64-71		01000 i i i		Push Temporary Variable #iii *)
	(* 72-75		010010 i i		Push Temporary Variable #ii + 8 *)
	index < 12 ifTrue:
		[incrementStackDepthBy: 1.
		code byte: 64 + index.
		^self].

	(* 230		11100110	i i i i i i i i	Push Temporary Variable #iiiiiiii *)
	incrementStackDepthBy: 1.
	code byte: 230; byte: index.
)
public pushTrue = (
	unsignedSingleExtendB: 1.
	code byte: 77.
	incrementStackDepthBy: 1.
)
public returnFromBlock = (
	code byte: 218.
	decrementStackDepthBy: 1.
)
public returnFromMethod = (
	code byte: 217.
	decrementStackDepthBy: 1.
)
public returnSelfFromMethod = (
	code byte: 216
)
public selfSend: selector numArgs: numArgs = (
	|
	selectorIndex = indexForLiteral: selector.
	extendedIndex extendedNArgs
	|
	assert: [selectorIndex between: 0 and: 32767]
		message: 'Selector index out of range'.
	assert: [numArgs between: 0 and: 31]
		message: 'Message arity out of range'.

	decrementStackDepthBy: numArgs.
	incrementStackDepthBy: 1.

	(extendedIndex:: selectorIndex) > 31 ifTrue:
		[unsignedSingleExtendA: extendedIndex // 32.
		 extendedIndex:: extendedIndex \\ 32].
	(extendedNArgs:: numArgs) > 7 ifTrue:
		[self unsignedSingleExtendB: extendedNArgs // 8.
		 extendedNArgs:: extendedNArgs \\ 8].
	code
		byte: 245;
		byte: extendedNArgs + (extendedIndex * 8)
)
signedSingleExtendB: extendedIndex = (
	assert: [extendedIndex between: -128 and: 127]
		message: 'Single extend B out of range'.

	code
		byte: 225;
		byte: (extendedIndex >= 0
			ifTrue: [extendedIndex]
			ifFalse: [extendedIndex + 256])
)
public sizeOfBackJump = (
	^4
)
public storeIntoRemoteTemporary: index inVector: vectorIndex = (
	assert: [index between: 0 and: 255]
		message: 'Temp index out of range'.
	assert: [vectorIndex between: 0 and: 255]
		message: 'Temp vector index out of range'.

	code byte: 251; byte: index; byte: vectorIndex.
)
public storeIntoTemporary: index = (
	assert: [index between: 0 and: 63] message: 'Temp index out of range'.

	code byte: 234; byte: index.
)
public superSend: selector numArgs: numArgs = (
	|
	selectorIndex = indexForLiteral: selector.
	extendedIndex extendedNArgs
	|
	assert: [selectorIndex between: 0 and: 32767]
		message: 'Selector index out of range'.
	assert: [numArgs between: 0 and: 31]
		message: 'Message arity out of range'.

	decrementStackDepthBy: numArgs.
	incrementStackDepthBy: 1.

	(extendedIndex:: selectorIndex) > 31 ifTrue:
		[unsignedSingleExtendA: extendedIndex // 32.
		 extendedIndex:: extendedIndex \\ 32].
	(extendedNArgs:: numArgs) > 7 ifTrue:
		[self unsignedSingleExtendB: extendedNArgs // 8.
		 extendedNArgs:: extendedNArgs \\ 8].
	code
		byte: 241;
		byte: extendedNArgs + (extendedIndex * 8)
)
unsignedSingleExtendA: extendedIndex = (
	assert: [extendedIndex between: 0 and: 255]
		message: 'Single extend A out of range'.
	code byte: 224; byte: extendedIndex
)
unsignedSingleExtendB: extendedIndex = (
	assert: [extendedIndex between: 0 and: 255]
		message: 'Single extend B out of range'.
	code byte: 225; byte: extendedIndex
)
) : (
)
class DebugInfo = (
(* Debugger information. *)
|
	public bciSourceMapping <MutableMap[Integer, Interval]> = Map new.
	public localVariables <MutableList[LocalVariableDebugInfo]> = List new.
	public source <String>
|) (
public addInfoForLocal: var <AllocatedLocal> = (
	| info |
	info: LocalVariableDebugInfo new.
	info name: var original name.
	info zeroOriginOffset: var offset.
	info remoteVector: nil.
	info contextDepth: var closureDepth.
	^localVariables addLast: info.
)
public addInfoForRemote: varInfo <AllocatedLocal> in: remoteVarInfo <SemanticVarDecl> = (
	| info |
	info: LocalVariableDebugInfo new.
	info name: varInfo original name.
	info zeroOriginOffset: varInfo original remoteOffset.
	info remoteVector: remoteVarInfo original name.
	info contextDepth: varInfo closureDepth.
	^localVariables addLast: info.
)
public isKindOfDebugInfo ^<Boolean> = (
	^true
)
public mapBCI: bci <Integer> to: src <interval> = (
	bciSourceMapping at: bci put: src
)
public mapperForContext: ctxt = (
	^DebugMapper forContext: ctxt usingDebugInfo: self.
)
) : (
)
class DebugMapper forContext: ctxt usingDebugInfo: dbgInfo = (|
	context <MethodContext> = ctxt.
	debugInfo <DebugInfo> = dbgInfo.
	myDepth <Integer> = self depthOfContext: ctxt.
|) (
astForContextAtDepth: targetDepth <Integer> ^<AST> = (
	|
	returnContext
	|
	myDepth >= targetDepth ifFalse: [deny].

	returnContext:: UnresolvedSendAST new
		receiver: hereNode;
		message: (MessageAST new
			selector: namer doitContextArgumentName;
			arguments: {}).

	(myDepth - targetDepth) timesRepeat: [
		returnContext:: (UnresolvedSendAST new
			receiver: returnContext;
			message: (MessageAST new
				selector: #outerContext;
				arguments: {}))].

	^returnContext
)
bci = (
	isSqueak ifTrue: [^context pc - context method initialPC + 1].
	^context bci
)
contextAtDepth: targetDepth <Integer> ^<MethodContext> = (
	|
	returnContext
	|
	myDepth >= targetDepth ifFalse: [deny].

	returnContext: context.
	(myDepth - targetDepth)
		timesRepeat: [returnContext: returnContext outerContext].
	^returnContext
)
depthOfContext: ctxt <MethodContext> ^<Integer> = (
	^ctxt closure isNil
		ifTrue: [0 (* method *)]
		ifFalse: [1 + (depthOfContext: ctxt outerContext)]
)
getLeastLocalValueOf: varName <Symbol> ^<Object> = (
	| info ctxt vector |
	info:: leastLocalInfoFor: varName.
	(* defensive programming, but should be unnecessary now that
	 DebugMapper>localNames filters out variables in deeper contexts. *)
	myDepth >= info contextDepth ifFalse:
		[^nil].
	info remoteVector isNil ifTrue:
		[ctxt:: contextAtDepth: info contextDepth.
		 ctxt size = 0 ifTrue: [^nil].
		 ^ctxt tempAt: info zeroOriginOffset + 1].
	vector:: getValueOf: info remoteVector.
	vector isNil ifFalse:
		[^vector at: info zeroOriginOffset + 1].
	^nil
)
public getValueOf: varName <Symbol> ^<Object> = (
	| info ctxt vector |
	info:: mostLocalInfoFor: varName.
	(* defensive programming, but should be unnecessary now that
	 DebugMapper>localNames filters out variables in deeper contexts. *)
	myDepth >= info contextDepth ifFalse:
		[^nil].
	info remoteVector isNil ifTrue:
		[ctxt:: contextAtDepth: info contextDepth.
		 ctxt size = 0 ifTrue: [^nil].
		 ^ctxt tempAt: info zeroOriginOffset + 1].
	vector:: (getLeastLocalValueOf: info remoteVector).
	vector isNil ifFalse:
		[^vector at: info zeroOriginOffset + 1].
	^nil
)
public getterAstFor: varName <Symbol> ^<SendAST> = (
	| info |
	info:: mostLocalInfoFor: varName.

	^info remoteVector isNil
		ifTrue: [UnresolvedSendAST new
			receiver: (astForContextAtDepth: info contextDepth);
			message: (MessageAST new
				selector: #tempAt:;
				arguments: {NumberAST new value: info zeroOriginOffset + 1})]
		ifFalse: [UnresolvedSendAST new
			receiver: (leastLocalGetterAstFor: info remoteVector);
			message: (MessageAST new
				selector: #at:;
				arguments: {NumberAST new value: info zeroOriginOffset + 1})]
)
leastLocalGetterAstFor: varName <Symbol> ^<SendAST> = (
	| info |
	info:: leastLocalInfoFor: varName.
	assert: [info remoteVector isNil].
	^UnresolvedSendAST new
		receiver: (astForContextAtDepth: info contextDepth);
		message: (MessageAST new
				selector: #tempAt:;
				arguments: {NumberAST new value: info zeroOriginOffset + 1})
)
leastLocalInfoFor: varName <Symbol> ^<LocalVarDebugInfo> = (
	| bestInfo |
	debugInfo localVariables do: [:info |
		(info name = varName and: [info validBCIRange includes: bci]) ifTrue: [
			(bestInfo isNil or: [info contextDepth < bestInfo contextDepth]) ifTrue: [
				bestInfo:: info]]].
	nil = bestInfo ifTrue: [deny].
	^bestInfo
)
public localNames = (
	| names |
	#BOGUS. (* The pc needs to be adjusted the same way we do for the source range. *)

	names: List new.

	debugInfo localVariables do: [:info |
		((info validBCIRange includes: bci)
		and: [info isSynthetic not
		and: [myDepth >= info contextDepth]]) ifTrue: [
			names include: info name ]].
	^names
)
mostLocalInfoFor: varName <Symbol> ^<LocalVarDebugInfo> = (
	| bestInfo |
	debugInfo localVariables do: [:info |
		(info name = varName and: [info validBCIRange includes: bci]) ifTrue: [
			(bestInfo isNil or: [info contextDepth > bestInfo contextDepth]) ifTrue: [
				bestInfo:: info]]].
	nil = bestInfo ifTrue: [deny].
	^bestInfo
)
public setterAstFor: varName <Symbol> putting: newVal <AST> ^<SendAST> = (
	| info |
	info:: mostLocalInfoFor: varName.

	^info remoteVector isNil
		ifTrue: [UnresolvedSendAST new
			receiver: (astForContextAtDepth: info contextDepth);
			message: (MessageAST new
				selector: #tempAt:put:;
				arguments: {
					NumberAST new value: info zeroOriginOffset + 1.
					newVal})]
		ifFalse: [UnresolvedSendAST new
			receiver: (leastLocalGetterAstFor: info remoteVector);
			message: (MessageAST new
				selector: #at:put:;
				arguments: {NumberAST new value: info zeroOriginOffset + 1.
					newVal})]
)
) : (
)
class Interval from: start_ to: stop_ = (
|
public start = start_.
public stop = stop_.
|
) (
public first ^<E> = (
	^self start
)
public includes: element <E> ^<Boolean> = (
	^start <= element and: [element <= stop]
)
public last ^<E> = (
	^self stop
)
) : (
)
class LocalVariableDebugInfo = (
(* Debugger information for a local. *)
|
	public name <Symbol>
	public validBCIRange <Interval>
	public zeroOriginOffset <Integer> (* in remoteVector if not nil, otherwise in context *)
	public remoteVector <Symbol | nil>
	public contextDepth <Integer> (* 0 = method, 1 = closure, 2 = nested closure, ... *)
|) (
public isSynthetic ^<Boolean> = (
	(* remoteVector or setter temp: debugger will not want to report these *)
	^(name indexOf: "@") > 0
)
) : (
)
addDebugInfo: node <AST> = (
	(* Byte to map is first byte of e.g. send, which is the next, i.e. pc.
	Hence this must be sent immediately before generating the send or store bytecode.
	Can't send after generating the bytecode because there may be multiple bytes and mapping the last byte is wrong. *)
	debugInfo mapBCI: cgen bci to: (Interval from: node start to: node end).
)
addLocalVar: var <AllocatedLocal> = (
	var remote ifFalse:
		[cgen maxLocals: (cgen maxLocals max: var offset + 1)].

	^debugInfo addInfoForLocal: var
)
applyForEffectTo: node <Node> = (
	| original startDepth result |
	original:: valueExpected.
	startDepth:: cgen currentStackDepth.
	valueExpected:: false.
	result:: node apply: self.
	valueExpected:: original.
	cgen currentStackDepth = startDepth ifFalse: [unbalancedStack].
	^result
)
applyForValueTo: node <Node> = (
	| original startDepth result |
	original:: valueExpected.
	startDepth:: cgen currentStackDepth.
	valueExpected:: true.
	result:: node apply: self.
	valueExpected:: original.
	cgen currentStackDepth = (startDepth + 1) ifFalse: [unbalancedStack].
	^result
)
public arrayNode: node <ArrayAST> = (
	nil = node elements
		ifTrue:
			[addDebugInfo: node.
			 cgen createEmptyArray: node size]
		ifFalse:
			[node elements do: [:ea | self applyForValueTo: ea].
			 addDebugInfo: node.
			 cgen createFullArray: node size].

	valueExpected ifFalse: [^cgen pop].
)
public blockLocalReturnNode: node <BlockLocalReturnAST> = (
	valueExpected ifTrue: [returnUsedForValue].
	self applyForValueTo: node expression.
	addDebugInfo: node.
	cgen returnFromBlock.
)
public boolNode: node <BoolAST> = (
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	cgen pushLiteral: node value
)
cascadeNormal: node <SendAST> = (
	node isKindOfCascadedSendNode
		ifTrue: [cascadeNormal: node previousSend]
		ifFalse: [self applyForValueTo: node receiver].

	cgen dup.
	node message arguments do: [:argument | self applyForValueTo: argument].
	addDebugInfo: node message.
	cgen normalSend: node message selector numArgs: node message arguments size.
	cgen pop.
)
public cascadedSendNode: node <CascadedSendAST> = (
	| baseSend ::= node. |
	[baseSend isKindOfCascadedSendNode]
		whileTrue: [baseSend: baseSend previousSend].

	baseSend receiver isKindOfExplicitRcvrNode ifTrue:
		[outerCascadeNotSupported.
		^self].

	baseSend isKindOfSuperSendNode ifTrue:
		[superCascadeNotSupported.
		^self].

	assert: [baseSend isKindOfOrdinarySendNode or: [baseSend isKindOfSelfSendNode]]
		message: 'Unknown type of cascade'.

	cascadeNormal: node previousSend.
	node message arguments do: [:argument | self applyForValueTo: argument].
	addDebugInfo: node message.
	cgen normalSend: node message selector numArgs: node message arguments size.
	valueExpected ifFalse: [cgen pop].
)
public characterNode: node <CharacterAST> = (
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	cgen pushLiteral: node value
)
cleanup = (
	cgen: nil.
  	debugInfo: nil.

	valueExpected: nil.
	maxClosureContextSize: nil.
)
public closureNode: node <ClosureAST> = (
	| blockPos <Integer> savedStackDepth <Integer> savedStackMax <Integer> |

	valueExpected ifFalse: [^self].

	node copiedOuter size = node copiedInner size ifFalse: [error].
	node copiedOuter do:
		[:each | cgen pushTemporary: each offset].

	addDebugInfo: node.
	cgen
		createClosureOfArity: node parameters size
		copying: node copiedOuter size
		length: 0 (* needs patching *).

	blockPos: cgen bci.
	savedStackDepth:: cgen currentStackDepth.
	savedStackMax:: cgen maxStackDepth.
	cgen maxStackDepth: 0.

	(* node copiedInner do: [:var | addLocalVar: var]. --- todo for debugger *)
	(node pushNilCount) timesRepeat: [cgen pushNil].
	(* These nils establish the temp frame for temps other than params and copied values. They contribute to the operand stack size, obviating the need to directly include the number of local variables in the context size *)
	self applyForEffectTo: node body.

	maxClosureContextSize::
		maxClosureContextSize max: (node parameters size + node copiedOuter size + cgen maxStackDepth).
	cgen currentStackDepth: savedStackDepth.
	cgen maxStackDepth: savedStackMax.

	cgen patchClosureJumpAt: blockPos with: cgen bci - blockPos. (* patch jump over block body *)
)
public codeBodyNode: node <CodeBodyAST> = (
	(* This could be a method body, a closure body, part of an inlined block, or a setter send.  Each method body and closure body needs to have separate indexing for temps because their activations will be separate MethodContexts.  Inlined blocks and setter sends should continue to use the same indexing as their enclosing method or closure.  To accomplish this, we use a stack of counters. *)

	|
	statements
	localVariableDebugInfos
	startBCI
	validBCIRange
	|

	localVariableDebugInfos:: List new.
	startBCI:: cgen bci.

	localVariableDebugInfos addAll:
		(node parameters collect: [:param | addLocalVar: param]).

	(* Copied values are included at the beginning of temporaries thanks to the Rewriter. *)
	node temporaries do:
		[:temp |
		temp remote
			ifFalse: [localVariableDebugInfos add: (addLocalVar: temp)]
			ifTrue:
				[localVariableDebugInfos add:
					(debugInfo addInfoForRemote: temp in: temp remoteVector)]].

	statements:: node statements.
	1 to: statements size do:
		[:index | | statement = node statements at: index. |
		index = statements size
			ifTrue: [statement apply: self]
			ifFalse: [self applyForEffectTo: statement]].

	validBCIRange:: Interval from: startBCI to: cgen bci - 1.
	localVariableDebugInfos do: [:each | each validBCIRange: validBCIRange].

	^localVariableDebugInfos
)
public conditionalNode: node <IfAST> = (
	| ifPos <Integer> endThen <Integer> depth <Integer> |

	(* cond. branch(L1). then. jump(L2). L1: else. L2: *)
	(* cond. branch(L1). then. L1: *)

	self applyForValueTo: node condition.
	cgen jumpIf: node ifTrue not by: 0. (* jump to else (but needs patching) *)
	ifPos: cgen bci. (* remember patch address *)

	depth: cgen currentStackDepth.
	node then apply: self.

	nil = node else
		ifTrue:
			[valueExpected ifTrue: [cgen pushNil].
			 endThen: cgen bci]
		ifFalse:
			[cgen currentStackDepth: depth.
			 cgen jumpBy: 0. (* jump to end (but needs patching) *)
			 endThen:: cgen bci. (* remember patch address *)
			 node else apply: self.
			 cgen patchJumpAt: endThen with: cgen bci - endThen].

	cgen patchJumpIfAt: ifPos with: endThen - ifPos.
)
public enclosingObjectNode: node <EnclosingObjectAST> = (
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	cgen pushEnclosingObject: node depth.
)
public globalNode: node <GlobalAST> = (
	valueExpected ifFalse: [^self].
	cgen pushLiteralVariable: node association.
)
public implicitReceiverSendNode: node <ImplicitReceiverSendAST> = (
	node message arguments do: [:argument | self applyForValueTo: argument].
	addDebugInfo: node message.
	cgen implicitReceiverSend: node message selector numArgs: node message arguments size.
	valueExpected ifFalse: [cgen pop].
)
literalArray ^<Array[Character | Number | String | Symbol]> = (
	| literals <Array[Character | Number | String | Symbol]> |
	literals:: Array new: literalTable size.
	literalTable keysAndValuesDo: [:k :v | literals at: v + 1 put: k].
	^literals
)
public localReadNode: node <LocalReadAST> = (
	| var <AllocatedLocal> = node variable. |
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	var remote
		ifFalse: [cgen pushTemporary: var offset]
		ifTrue:
			[cgen
				pushRemoteTemporary: var original remoteOffset
				inVector: var remoteVector offset].
)
public localWriteNode: node <LocalWriteAST> = (
	self applyForValueTo: node value.
	addDebugInfo: node.
	valueExpected
		ifTrue: [storeInto: node variable]
		ifFalse: [popAndStoreInto: node variable].
)
public loopNode: node <LoopAST> = (
	(* prologue. L1: cond. branch(L2). body. jump(L1). L2: *)

	|
	topOfLoop <Integer>
	whilePos <Integer>
	localVariableDebugInfos = List new.
	|

	nil = node prologue ifFalse:
		[localVariableDebugInfos addAll: (self applyForEffectTo: node prologue)].

	topOfLoop:: cgen bci.

	localVariableDebugInfos addAll: (self applyForValueTo: node condition).

	cgen jumpIf: node isWhileTrue not by: 0.
	whilePos:: cgen bci. (* remember patch address *)

	nil = node body ifFalse:
		[self applyForEffectTo: node body].

	cgen jumpBy: topOfLoop - cgen bci - (cgen sizeOfBackJump). (* jump to top of loop *)

	cgen patchJumpIfAt: whilePos with: cgen bci - whilePos.
 	(* patch the jump after the test so it comes to end of the then block *)

	valueExpected ifTrue: [cgen pushNil]. (* Result of loop message. Technically wrong, but Squeak makes the same mistake, and loops are almost never evaluated for value. *)

	localVariableDebugInfos do: [:each | each validBCIRange: (Interval from: each validBCIRange first to: cgen bci - 1)].
)
public methodLocalReturnNode: node <MethodLocalReturnAST> = (
	^self returnStatNode: node
)
public methodNode: node <MethodAST> = (
	(* Create a compiled method, whose body is the result of compiling the node's body. *)
	| result <IntermediateMethod> |
	setup.

	cgen
		maxLocals: 0;
		accessModifier: node accessModifier;
		methodName: node pattern selector;
		argCount: node pattern parameters size;
		literals: literalArray.

	self applyForEffectTo: node body.
	cgen code debugInfo: debugInfo. (* set debug info *)
	processLiteralMessagesOf: node.

	result:: cgen close.
	cleanup.
	^result
)
public mixinNode: node = (
	valueExpected ifFalse: [^self].
	cgen pushMixin.
)
public nilNode: node = (
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	cgen pushNil.
)
public nonLocalReturnNode: node <NonlocalReturnAST> = (
	^self returnStatNode: node
)
public numberNode: node <NumberAST> = (
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	cgen pushLiteral: node value.
)
public ordinarySendNode: node <NormalSendAST> = (
	self applyForValueTo: node receiver.
	node message arguments do: [:argument | self applyForValueTo: argument].
	addDebugInfo: node message.
	cgen normalSend: node message selector numArgs: node message arguments size.
	valueExpected ifFalse: [cgen pop].
)
public outerSendNode: node <OuterSendAST> = (
	node message arguments do: [:argument | self applyForValueTo: argument].
	addDebugInfo: node message.
	cgen outerSend: node message selector numArgs: node message arguments size depth: node depth.
	valueExpected ifFalse: [cgen pop].
)
popAndStoreInto: var <AllocatedLocal> = (
	var remote
		ifFalse: [cgen popIntoTemporary: var offset]
		ifTrue:
			[cgen
				popIntoRemoteTemporary: var original remoteOffset
				inVector: var remoteVector offset]
)
processLiteralMessagesOf: node <MethodAST> = (
	| pragmas bodyLitMessages |
	pragmas:: List new.
	bodyLitMessages:: node body literalMessages.
	nil = bodyLitMessages ifFalse:
		[bodyLitMessages do: [:messageAST |
			(messageAST selector = #primitive:) ifTrue:
				[cgen code psPrimitive: messageAST arguments first value].
			nil = Pragma ifFalse:
				[pragmas add: (Pragma
					keyword: messageAST selector
					arguments: (messageAST arguments collect: [:symbolAST | symbolAST value]) asArray)]]].

	cgen code pragmas: pragmas.
)
public receiverNode: node = (
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	cgen pushSelf.
)
public returnStatNode: node <MethodLocalReturnAST | NonLocalReturnAST> = (
	(* if expr is self, true, false or nil do something special *)
	(node expression isKindOfReceiverNode) ifTrue:
		[(* implicit return selfs at end of method have no source range *)
		nil = node expression start ifFalse:
			[addDebugInfo: node].
		^cgen returnSelfFromMethod].

	self applyForValueTo: node expression.
	addDebugInfo: node.
	cgen returnFromMethod.

	(* Simplify depth tracking for branches like x:: y ifTrue: [z] ifFalse: [^w] *)
	valueExpected ifTrue: [cgen incrementStackDepthBy: 1].
)
public selfSendNode: node <SendAST> = (
	node message arguments do: [:argument | self applyForValueTo: argument].
	addDebugInfo: node message.
	cgen selfSend: node message selector numArgs: node message arguments size.
	valueExpected ifFalse: [cgen pop].
)
setup = (
	cgen:: CodeGeneratorV4 new.
  	debugInfo: DebugInfo new.

	valueExpected: nil.
	maxClosureContextSize: 0.
)
storeInto: var <AllocatedLocal> = (
	var remote
		ifFalse: [cgen storeIntoTemporary: var offset]
		ifTrue:
			[cgen
				storeIntoRemoteTemporary: var original remoteOffset
				inVector: var remoteVector offset]
)
public stringNode: node <StringAST> = (
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	cgen pushLiteral: node value.
)
public superSendNode: node <SuperSendNode> = (
	node message arguments do: [:argument | self applyForValueTo: argument].
	addDebugInfo: node message.
	cgen superSend: node message selector numArgs: node message arguments size.
	valueExpected ifFalse: [cgen pop].
)
public symbolNode: node <SymbolAST> = (
	valueExpected ifFalse: [^self].
	addDebugInfo: node.
	cgen pushLiteral: node value.
)
) : (
)
class ASTTraverser = ASTTool () (
public blockLocalReturnNode: node <BlockLocalReturnAST> = (
	node expression apply: self.
)
public blockNode: node <BlockAST> = (
	node body apply: self.
)
public boolNode: node <BooleanAST> = (
	(* Leaf *)
)
public cascadedSendNode: node <CascadedSendAST> = (
	node previousSend apply: self.
	node message apply: self.
)
public characterNode: node <CharacterAST> = (
	(* Leaf *)
)
public conditionalNode: node <ConditionalAST> = (
	node condition apply: self.

	node then apply: self.
	nil = node else ifFalse:
		[node else apply: self].
)
public enclosingObjectNode: node <EnclosingObjectAST> = (
	(* Leaf *)
)
public globalNode: node <GlobalAST> = (
	(* Leaf *)
)
public implicitReceiverSendNode: node <ImplicitReceiverSendAST> = (
	node message apply: self.
)
public loopNode: node <LoopAST> = (
	nil = node prologue ifFalse:
		[node prologue apply: self].
	node condition apply: self.
	nil = node body ifFalse:
		[node body apply: self].
)
public messageNode: node <MessageAST> = (
	node arguments do: [:each | each apply: self].
)
public messagePatternNode: node <MessagePatternAST> = (
	(* Leaf *)
)
public methodLocalReturnNode: node <MethodLocalReturnAST> = (
	node expression apply: self.
)
public methodNode: node <MethodAST> = (
	node pattern apply: self.
	node body apply: self.
)
public mixinNode: node <MixinClassNode> = (
	(* Leaf *)
)
public nilNode: node <NilAST> = (
	(* Leaf *)
)
public nonLocalReturnNode: node <NonlocalReturnAST> = (
	node expression apply: self.
)
public numberNode: node <NumberAST> = (
	(* Leaf *)
)
public ordinarySendNode: node <OrdinarySendAST> = (
	node receiver apply: self.
	node message apply: self.
)
public outerSendNode: node <OuterSendAST> = (
	node message apply: self.
)
public receiverNode: node <ReceiverAST> = (
	(* Leaf *)
)
public selfSendNode: node <SelfSendAST> = (
	node message apply: self.
)
public stringNode: node <StringAST> = (
	(* Leaf *)
)
public superSendNode: node <SuperSendAST> = (
	node message apply: self.
)
public symbolNode: node <SymbolAST> = (
	(* Leaf *)
)
public tupleNode: node <TupleAST> = (
	node elements do: [:element | element apply: self]
)
) : (
)
class AllocatedLocal = (
|
	public remote <Boolean>
	public offset <Integer>
	public remoteVector <AllocatedLocal>
	public closureDepth <Integer>
	public original <LocalEntry>
|
) (
) : (
)
class ArrayAST = AST (
(* To use pushFullArray/pushEmptyArray *)
|
	public elements <List[AST] | nil>
	public size <Integer>
|) (
public apply: tool <ASTTool[T]> ^<T> = (
	^tool arrayNode: self.
)
) : (
)
class ClosureRewriter1 = ASTTraverser (
(* Phase 1 of closure rewrite.

Determines which local variables need to be made indirect/remote:
 - a variable written by a closure nested in its defining scope, OR
 - a variable written in its defining scope after being read in a nested closure
(- and is not an inlined induction variable; must behave as if each iteration has its own copy)

Determines which local variables are copied into each closure:
 - non-indirect free variables
 - the indirection vector of indirect free variables

Adds literals and selectors to the literal table.
Adds indirection vectors to code bodies. *)
|
	closureDepth
	captured ::= List new.

	capturedMap = Map new.
|
) (
addLiteral: value <Character | Number | String | Symbol> = (
	literalTable at: value ifAbsentPut: [literalTable size].
)
addRemoteVectorForCodeBodyNode: node <CodeBodyAST> = (
	|
	indirectionCount
	indirectionVectorAST
	indirectionVectorEntry
	rewrittenParameters
	rewrittenTemporaries
	rewrittenStatements
	remoteOffset
	|

	indirectionCount:: 0.
	node parameters do:
		[:parameter | parameter remote ifTrue: [error]].
	node temporaries do:
		[:temporary | temporary remote ifTrue: [indirectionCount:: indirectionCount + 1]].

	0 = indirectionCount ifFalse:
		[indirectionVectorAST:: rewriter TemporaryAST
			name: #'@indirectionVector'
			type: nil.
		 indirectionVectorEntry:: LocalEntry
			forDeclaration: indirectionVectorAST
			atDepth: nil.
		 indirectionVectorEntry closureDepth: closureDepth.
		 indirectionVectorEntry remote: false.
		 node temporaries addFirst: indirectionVectorEntry.
		 node statements addFirst: (rewriter LocalWriteAST
			to: indirectionVectorEntry
			assign: (ArrayAST new size: indirectionCount))].

	remoteOffset:: 0.
	node temporaries do:
		[:temporary |
		 temporary remote ifTrue:
			[temporary remoteVector2: indirectionVectorEntry.
			 temporary remoteOffset: remoteOffset.
			 remoteOffset:: remoteOffset + 1]].
)
public blockNode: node <BlockAST> = (
	| parentCaptured |
	closureDepth:: closureDepth + 1.
	parentCaptured:: captured.
	captured:: List new.

	node body apply: self.
	capturedMap at: node put: captured.

	closureDepth:: closureDepth - 1.
	captured do: [:each | each closureDepth < closureDepth ifTrue: [parentCaptured add: each]].
	captured:: parentCaptured.
)
public cascadedSendNode: node <CascadedSendAST> = (
	| selector = node message selector. |
	(specialSelectors includes: selector)
		ifFalse: [addLiteral: selector].
	^super cascadedSendNode: node
)
public characterNode: node <CharacterAST> = (
	addLiteral: node value.
	^node
)
public codeBodyNode: node <CodeBodyAST> = (
	node parameters do:
		[:parameter |
		 parameter closureDepth: closureDepth.
		 parameter remote: false].
	node temporaries do:
		[:temporary |
		 temporary closureDepth: closureDepth.
		 temporary remote: false].

	node statements do: [:statement | statement apply: self].

	addRemoteVectorForCodeBodyNode: node.
)
public globalNode: node <GlobalAST> = (
	addLiteral: node association.
	^node
)
public implicitReceiverSendNode: node <ImplicitReceiverSendAST> = (
	addLiteral: node message selector.
	^super implicitReceiverSendNode: node
)
public localReadNode: node <LocalReadAST> = (
	| var = node variable. |
	closureDepth > var closureDepth ifTrue:
		[var captured: true.
		 captured add: var].
)
public localWriteNode: node <WriteReadAST> = (
	| var = node variable. |
	node value apply: self.

	(* Nested write or write after nested read *)
	closureDepth > var closureDepth
		ifTrue:
			[var captured: true; remote: true.
			 var induction ifTrue: [error].
			 captured add: var]
		ifFalse:
			[var captured ifTrue: [var induction ifFalse: [var remote: true]]].
)
public loopNode: node <LoopAST> = (
	super loopNode: node.

	(* Work around bad scoping of induction variables. *)
	nil = node prologue ifFalse:
		[addRemoteVectorForCodeBodyNode: node prologue].
)
public methodNode: node <MethodAST> = (
	| pattern body result |
	literalTable:: Map new.
	closureDepth:: 0.

	node body apply: self.

	^capturedMap
)
public numberNode: node <NumberAST> = (
	| value = node value. |
	(value isKindOfInteger and: [value between: -32768 and: 32767])
		ifFalse: [addLiteral: node value].
	^node
)
public ordinarySendNode: node <OrdinarySendAST> = (
	| selector = node message selector. |
	(specialSelectors includes: selector)
		ifFalse: [addLiteral: selector].
	^super ordinarySendNode: node
)
public outerSendNode: node <OuterSendAST> = (
	addLiteral: node message selector.
	^super outerSendNode: node
)
public selfSendNode: node <SelfSendAST> = (
	addLiteral: node message selector.
	^super selfSendNode: node.
)
public stringNode: node <StringAST> = (
	(* Note we treat it as a symbol. *)
	addLiteral: node value asSymbol.
	^node
)
public superSendNode: node <SuperSendAST> = (
	addLiteral: node message selector.
	^super superSendNode: node
)
public symbolNode: node <SymbolAST> = (
	addLiteral: node value.
	^node
)
) : (
)
class ClosureRewriter2 with: cm = (
(* Phase 2 of closure rewrite.

Adds copied versions of captured variables.
Assigns locals to context/activation slots. *)
|
	capturedSets <Map[BlockAST, List[LocalEntry]]> = cm.

	closureDepth ::= 0.
	remapping ::= Map new.

	nextOffset ::= 0.
|
) (
allocateLocal: var <LocalEntry> = (
	^remapping at: var ifAbsentPut:
		[ | allocated = AllocatedLocal new. |
		 allocated closureDepth: closureDepth.
		 allocated remote: var remote.
		 var remote
			ifTrue:
				[allocated remoteVector: (remapping at: var remoteVector2)]
			ifFalse:
				[allocated offset: nextOffset.
				 nextOffset: nextOffset + 1].
		 allocated original: var.
		 allocated].
)
public arrayNode: node <ArrayAST> = (
	(* Only remote vector initialization (empty array) should appear here. *)
	node elements = nil ifFalse: [error].

	^ArrayAST new
		size: node size
)
public blockLocalReturnNode: node <BlockLocalReturnAST> = (
	^(rewriter BlockLocalReturnAST expression: (node expression apply: self))
		copyPositionFrom: node
)
public blockNode: node <BlockAST> = (
	|
	copied = List new.
	copiedOuter = List new.
	copiedInner = List new.
	parentRemapping
	parentNextOffset
	lastImplicitOffset
	rewrittenBody
	result
	|
	closureDepth:: closureDepth + 1.
	parentNextOffset:: nextOffset.
	nextOffset:: 0.
	parentRemapping:: remapping.
	remapping:: Map new.

	(* 1. Parameters *)
	node parameters do: [:parameter | allocateLocal: parameter].

	(* 2. Copy downs *)
	(capturedSets at: node) do:
		[:captured |
		 captured remote
			ifTrue: [copied include: captured remoteVector2]
			ifFalse: [copied include: captured]].
	copied do:
		[:copiedVar |
		 copiedOuter add: (parentRemapping at: copiedVar).
		 copiedInner add: (allocateLocal: copiedVar)].

	lastImplicitOffset:: nextOffset.

	(* 3. Indirected *)
	(capturedSets at: node) do:
		[:captured | captured remote ifTrue: [allocateLocal: captured]].

	rewrittenBody:: node body apply: self.

	result:: CogClosureAST new
		body: rewrittenBody;
		copiedOuter: copiedOuter;
		copiedInner: copiedInner;
		pushNilCount: nextOffset - lastImplicitOffset;
		copyPositionFrom: node.

	remapping:: parentRemapping.
	nextOffset:: parentNextOffset.
	closureDepth:: closureDepth - 1.

	^result
)
public boolNode: node <BooleanAST> = (
	^node
)
public cascadedSendNode: node <CascadedSendAST> = (
	^(CascadedSendAST new
		to: (node previousSend apply: self)
		cascade: (node message apply: self))
		copyPositionFrom: node
)
public characterNode: node <CharacterAST> = (
	^node
)
public codeBodyNode: node <CodeBodyAST> = (
	^CodeBodyAST new
	  parameters: (node parameters collect: [:parameter | allocateLocal: parameter])
	  temporaries: (node temporaries collect: [:temporary | allocateLocal: temporary])
	  statements: (node statements collect: [:statement | statement apply: self]);
		literalMessages: node literalMessages;
	  copyPositionFrom: node
)
public conditionalNode: node <ConditionalAST> = (
	^(rewriter ConditionalAST
		if: (node condition apply: self)
		is: node ifTrue
		then: (nullableCodeBodyNode: node then)
		else: (nullableCodeBodyNode: node else))
		copyPositionFrom: node
)
public enclosingObjectNode: node <EnclosingObjectAST> = (
	^node
)
public globalNode: node <GlobalAST> = (
	^node
)
public implicitReceiverSendNode: node <ImplicitReceiverSendAST> = (
	^(rewriter ImplicitReceiverSendAST new
		message: (node message apply: self);
		depth: node depth)
		copyPositionFrom: node
)
public localReadNode: node <LocalReadAST> = (
	^(rewriter LocalReadAST
		of: (remapping at: node variable))
		copyPositionFrom: node
)
public localWriteNode: node <LocalWriteAST> = (
	^(rewriter LocalWriteAST
		to: (remapping at: node variable)
		assign: (node value apply: self))
		copyPositionFrom: node
)
public loopNode: node <LoopAST> = (
	^rewriter LoopAST new
		prologue: (nullableCodeBodyNode: node prologue);
		condition: (nullableCodeBodyNode: node condition);
		isWhileTrue: node isWhileTrue;
		body: (nullableCodeBodyNode: node body)
)
public messageNode: node <MessageAST> = (
	^(MessageAST new
		send: node selector
		with: (node arguments collect: [:argument | argument apply: self]))
		copyPositionFrom: node
)
public methodLocalReturnNode: node <MethodLocalReturnAST> = (
	^(rewriter MethodLocalReturnAST expression: (node expression apply: self))
		copyPositionFrom: node
)
public methodNode: node <MethodAST> = (
	| body result |

	body:: node body apply: self.
	^(MethodAST new
		pattern: node pattern
		body: body
		accessModifier: node accessModifier)
		copyPositionFrom: node
)
public mixinNode: node <MixinClassNode> = (
	^node
)
public nilNode: node <NilAST> = (
	^node
)
public nonLocalReturnNode: node <NonlocalReturnAST> = (
	^(rewriter NonlocalReturnAST expression: (node expression apply: self))
		copyPositionFrom: node
)
nullableCodeBodyNode: node = (
	nil = node ifTrue: [^nil].
	^codeBodyNode: node
)
public numberNode: node <NumberAST> = (
	^node
)
public ordinarySendNode: node <OrdinarySendAST> = (
	^(rewriter OrdinarySendAST
		to: (node receiver apply: self)
		send: (node message apply: self))
		copyPositionFrom: node
)
public outerSendNode: node <OuterSendAST> = (
	^(rewriter OuterSendAST new
		message: (node message apply: self);
		depth: node depth)
		copyPositionFrom: node
)
public receiverNode: node <ReceiverAST> = (
	^node
)
public selfSendNode: node <SelfSendAST> = (
	^(rewriter SelfSendAST new
		message: (node message apply: self))
		copyPositionFrom: node
)
public stringNode: node <StringAST> = (
	^node
)
public superSendNode: node <SuperSendAST> = (
	^(rewriter SuperSendAST new
		message: (node message apply: self))
		copyPositionFrom: node
)
public symbolNode: node <SymbolAST> = (
	^node
)
public tupleNode: node <TupleAST> = (
	^ArrayAST new
		elements: (node elements collect: [:element | element apply: self]);
		size: node elements size;
		copyPositionFrom: node
)
) : (
)
class CogClosureAST = BlockAST (|
	public copiedInner <List[LocalEntry]>
	public copiedOuter <List[LocalEntry]>
	public pushNilCount <Integer>
|) (
public apply: tool <ASTTool[T]> ^<T> = (
	^tool closureNode: self
)
) : (
)
class GlobalAST association: a = (|
public association <Association[Symbol, Object]> = a.
|) (
public apply: tool <ASTTool[T]> ^<T> = (
	^tool globalNode: self
)
) : (
)
class MixinAST = AST (
(* A special AST node to represent access to the defining mixin of a method.

Recall that outer classes have accessors for their nested classes; these lazily manufacture the class, cache it, and later access the cached value. To do this, the accessor must apply the mixin of the nested class to the superclass. Said mixin is nested within the mixin that defined the accessor (the mixin of the outer class declaration).

The issue then is how to get the outer mixin. In Squeak, for example, the outer mixin is stored in the last literal of every one of its methods (what Squeak calls the ''methodClass''). To reach it, we must push the last literal of the method on to the operand stack.

However, the accessor method is not specified at the byte code level; that would be tedious, and also tied to a specific implementation (the Squeak byte codes). It is much better to specify the method via an AST that is compiled (we could use source code, but the use of synthetic names makes that problematic).

In order to specify access to the mixin in the accessor method, we need to provide an AST that corresponds to the idea of ''accessing my mixin''. This is what this class does.

The rewriter leaves this node untouched, while the lower layers of the compiler that deal with code generation produce suitable code for it - e.g., Squeak byte codes. *)
) (
public apply: tool <ASTTool[T]> ^<T> = (
	^tool mixinNode: self
)
) : (
)
class Rewriter = super Rewriter (
(* In addition to the common rewrites, this class

 - Rewrites eventual sends as immediate sends to the ProcessorScheduler or MessageLoop globals on Squeak or Primordial Soup respectively.
 - Rewrites large tuples expressions to (Array new: n) at: 1 put: e1;...; yourself to avoid operand stack size limits. *)
) (
largeTupleNode: aNode <TupleAST> = (
	(* (Array new: n) at: 1 put: e1; ...; at: n put: en; yourself *)
	| result <AST> index <Integer> |
	(* Array *)
	result:: (UnresolvedSendAST new
		to: implicitReceiverNode
		send: (MessageAST new
			selector: #Array;
			arguments: {};
			copyPositionFrom: aNode)).

	(* Array new: n *)
	result:: UnresolvedSendAST new
		to: result
		send: (MessageAST new
			selector: #new:;
			arguments: {
				NumberAST new value: aNode elements size};
			copyPositionFrom: aNode).
	result copyPositionFrom: aNode.

	(* (;)at: index put: element *)
	index:: 0.
	aNode elements do:
		[:element <AST> | | message <MessageAST> |
		index:: index + 1.
		message:: MessageAST new
			selector: #at:put:;
			arguments: {
				NumberAST new value: index.
				element}.
		index = 1
			ifTrue: [result:: UnresolvedSendAST new to: result send: message]
			ifFalse: [result:: CascadedSendAST new to: result cascade: message]].

	aNode elements size > 0 ifTrue: [
		(* yourself *)
		result:: CascadedSendAST new
			to: result
			cascade: (MessageAST new
				selector: #yourself;
				arguments: {};
				copyPositionFrom: aNode).
		result copyPositionFrom: aNode].

	^result apply: self
)
public mixinNode: node <MixinClassNode> = (
	^node
)
processEventualSend: node <NormalSendAST> = (
	| Processor receiver selector arguments |
	Processor:: GlobalAST association: ProcessorAssociation.

	receiver:: node receiver apply: self.
	selector:: (SymbolAST new value: node message selector) apply: self.
	arguments:: (TupleAST new elements: node message arguments) apply: self.

	^(OrdinarySendAST
		to: Processor
		send: ((MessageAST new
			send: #eventualSendTo:selector:arguments:
			with: {receiver. selector. arguments})
				copyPositionFrom: node message))
		copyPositionFrom: node
)
processMappedVariable: msg decl: binding = (
	^((msg selector endsWith: ':')
		ifTrue: [binding setterAst: msg arguments first]
		ifFalse: [binding getterAst])
			apply: self
)
public tupleNode: node <TupleAST> = (
	(* We can only use pushConsArray for tuples small enough to fit all elements on the operand stack. The optimial limit is the large frame size minus the current stack depth. We don't track the current depth here, so an arbitrary conservative limit is used. *)
	node elements size > 7 ifTrue: [^self largeTupleNode: node].
	^super tupleNode: node
)
) : (
)
private accessorASTForNestedClassNamed: simpleName <String> classTree: classTree <NormalSendAST> accessModifier: am <Symbol> ^<MethodAST> = (
(* Build an AST for a method that would lazily create a nested class via mixin application, and cache it. The generated code has the form

simpleName = (
	self simpleName`slot isNil ifTrue:
		[self simpleName`slot: (<classTree>)].
	^self simpleName`slot
)

where <classTree> is the AST that computes the class.
*)

	| nilNode nestedClassSlot mixinApplication assignSlot nilCheck block if return |

	nilNode:: UnresolvedSendAST new
		to: hereNode
		send: #nil
		with: {}.
	nestedClassSlot:: UnresolvedSendAST new
		to: selfNode
		send: (namer mixinSlotNameFor: simpleName) asSymbol with: {}.
	nilCheck:: UnresolvedSendAST new
		to: nilNode
		send: #=
		with: {nestedClassSlot}.

	mixinApplication:: classTree.
	assignSlot:: UnresolvedSendAST new
		to: selfNode
		send: ((namer mixinSlotNameFor: simpleName), ':') asSymbol
		with: {mixinApplication}.
	block:: BlockAST new
		body: (CodeBodyAST new
			parameters: {}
			temporaries: {}
			statements: {assignSlot}).
	if:: UnresolvedSendAST new
		to: nilCheck
		send: #ifTrue:
		with: {block}.
	return:: ReturnStatAST new expression: nestedClassSlot.

	^MethodAST new
		pattern: (MessagePatternAST new
			selector: simpleName asSymbol
			parameters: {};
			accessModifier: am);
		body: (CodeBodyAST new
			parameters: {}
			temporaries: {}
			statements: {if. return});
		start: 1; end: 1
)
addInitializersToMixinApplication: mixinApp <NormalSendAST> nestedMixin: nestedMixin factoryName: facName <Symbol> = (
(* This method produces an AST representing code of the form:

[ | mixinApp |
  mixinApp = .... (* incoming parameter *)
  mixinApp methodDictionary at: initName put: ((nestedMixin methodDictionary at: initName) clone methodClass: mixinApp).
  mixinApp class methodDictionary
	at: factoryName
	put: ((nestedMixin classMixin methodDictionary at: factoryName) clone methodCass: mixinApp class).
  mixinApp
] value

This code is then placed in the class accessor for a mixin application class.
Executing this code will copy the precompiled factory and
instance initializer methods from the fake mixin nodes where they are stored at compile time (nestedMixin and nestedMixin's classMixin)
to the actual mixin application (mixinApp and mixinApp class) generated at run time.
*)
|
nestedMixin2 = nestedMixin (*apply: ASTCopier new*).
mixinAppVarDecl = VarDeclAST name: #mixinApp type: nil.
mixinAppSlotDef = MutableSlotDefAST new slotDecl: mixinAppVarDecl; initializer: nil. (* | mixinApp | *)
mixinAppVar1 = hereSendFrom: mixinAppVarDecl. (* mixinApp *)
mixinAppVar2 = hereSendFrom: mixinAppVarDecl.
mixinAppVar3 = hereSendFrom: mixinAppVarDecl.
mixinAppVar4 = hereSendFrom: mixinAppVarDecl.
mixinAppVar5 = hereSendFrom: mixinAppVarDecl.
classMixinMessage = MessageAST new send: #classMixin with: {}.
classMessage = MessageAST new send: #class with: {}.
methodDictMessage1 = MessageAST new send: #methodDictionary with: {}.
methodDictMessage2 = MessageAST new send: #methodDictionary with: {}.
methodDictMessage3 = MessageAST new send: #methodDictionary with: {}.
methodDictMessage4 = MessageAST new send: #methodDictionary with: {}.
valueMessage = MessageAST new send: #value with: {}.
nestedMixinClass = UnresolvedSendAST new to: nestedMixin send: classMixinMessage. (* nestedMixin classMixin *)
mixinClassMtds = UnresolvedSendAST new to: nestedMixinClass send: methodDictMessage1.
(* nestedMixin classMixin methodDictionary*)
mixinInstMtds = UnresolvedSendAST new to: nestedMixin2 send: methodDictMessage2.
(* nestedMixin methodDictionary*)
mixinAppClass = UnresolvedSendAST new to: mixinAppVar1 send: classMessage. (* mixinApp class*)
mixinAppClass2 = UnresolvedSendAST new to: mixinAppVar5 send: classMessage.
classMtds = UnresolvedSendAST new to: mixinAppClass send: methodDictMessage3.
(* mixinApp class methodDictionary*)
instMtds = UnresolvedSendAST new to: mixinAppVar3 send: methodDictMessage4. (* mixinApp methodDictionary*)
initName = SymbolAST new value: (initializerSelectorNameFor: facName). (* #'initializer`factoryName' *)
initMethod = UnresolvedSendAST new to: mixinInstMtds send: #at: with: {initName}.
(* nestedMixin methodDictionary at: #'initializer`factoryName' *)
initMethodClone = UnresolvedSendAST new to: initMethod send: #clone with: {}.
(* (nestedMixin methodDictionary at: #'initializer`factoryName') clone *)
initMethodCopy = UnresolvedSendAST new to: initMethodClone send: #methodClass: with: {mixinAppVar4}.
(* (nestedMixin methodDictionary at: #'initializer`factoryName') clone methodClass: mixinApp *)
factoryName = SymbolAST new value: facName. (* #factoryName *)
factoryMethod = UnresolvedSendAST new to: mixinClassMtds send: #at: with: {factoryName}.
(* nestedMixin classMixin methodDictionary at: #'factoryName *)
factoryMethodClone = UnresolvedSendAST new to: factoryMethod send: #clone with: {}.
(* (nestedMixin classMixin methodDictionary at: #'factoryName) clone *)
factoryMethodCopy = UnresolvedSendAST new to: factoryMethodClone send: #methodClass: with: {mixinAppClass2}.
(* (nestedMixin classMixin methodDictionary at: #'factoryName) clone methodClass: mixinApp class *)
setMixinApp = UnresolvedSendAST new to: hereNode send: #mixinApp: with: {mixinApp}.
setInstInit = UnresolvedSendAST new to: instMtds send: #at:put: with: {initName. initMethodCopy}.
(* mixinApp methodDictionary
	at: #'initializer`factoryName'
	put: ((nestedMixin methodDictionary at: #'initializer`factoryName')  clone methodClass: mixinApp) *)
setClassFactory = UnresolvedSendAST new to: classMtds send: #at:put: with: {factoryName. factoryMethodCopy}.
(* mixinApp class methodDictionary
	at: #factoryName
	put: ((nestedMixin classMixin methodDictionary at: #factoryName) clone methodClass: mixinApp class) *)
stmts = List new
	        add: setMixinApp; add: setInstInit; add: setClassFactory; add: mixinAppVar3; yourself.
blockBody = CodeBodyAST new temporaries: {mixinAppSlotDef} statements: stmts.
block = BlockAST new body: blockBody. (* [...] *)
result = UnresolvedSendAST new to: block send: valueMessage. (* [...] value*)
|
^result
)
private allButFirstOf: oldArray = (
	| newArray = Array new: oldArray size - 1. |
	newArray replaceFrom: 1 to: newArray size with: oldArray startingAt: 2.
	^newArray
)
astForClassDeclarationInitializer: aNode <ClassHeaderAST> ^<MethodAST> = (
	|
	start <integer>
	end <Integer>
	stmts <List[StmtAST]>
	initHdr <MessagePatternAST>
	body <CodeBodyAST>
	slots <Collection[StmtAST]>
	|

	initHdr:: MessagePatternAST new
		accessModifier: aNode constructor accessModifier;
		selector: (initializerSelectorNameFor: aNode constructor selector);
		parameters: aNode constructor parameters;
		copyPositionFrom: aNode constructor.

	(* Call super initializers *)
	stmts:: mixinInitializationCallsFor: aNode inheritanceChain.

	(* run slot initializers *)
	slots:: computeSlotInitializersFor: aNode.

	stmts addAll: slots.

	(*  run init expressions *)
	aNode initExprs do:
		[:ie <ExpressionAST> | stmts add: ie].

	body:: CodeBodyAST new
		parameters: initHdr parameters
		temporaries: List new
		statements: stmts;
		copyPositionFrom: aNode.
	^MethodAST new
		pattern: initHdr body: body accessModifier: #public;
		copyPositionFrom: aNode
)
astForComputingClassDeclaration: simpleName <String> superCall: superCall <NormalSendAST> iList: iList <List[SendAST]> ^ <NormalSendAST> = (
(* Compute the tree for an ordinary class declaration whose superclass is a generalized mixin application. *)
	|
	nestedMixin = nestedMixinASTFor: simpleName asSymbol.
	superChain = inheritanceASTWIthSuperclass: superCall receiver iList: iList.
	|

	^UnresolvedSendAST new
		to: nestedMixin
		send: #applyTo:withEnclosingObject:
		with: {superChain. selfNode}
)
astForComputingMixinApplicationClassDeclaration: simpleName <String>
superCall: superCall <NormalSendAST>
iList: iList <List[SendAST]>
factoryName: factoryName <Symbol> ^ <NormalSendAST> = (
(* Returns a tree representing the computation of a mixin application
class. First we compute the chain of anonymous mixin applications that
constitutes the superclass of the desired mixin application class using
#inheritanceASTWIthSuperclass:iList: and then we define a named mixin
application by applying the last element of the inheritance chain to that
superclass.
.*)
	|
	nestedMixin = nestedMixinASTFor: simpleName asSymbol.
	superChain = inheritanceASTWIthSuperclass: (superCall receiver)  iList: iList allButLast.
	mixinApp = UnresolvedSendAST new
		to: (mixinSendTreeFor: iList last receiver)
		send: #apply:withName:index:enclosingObject:
		with: {
			superChain.
			UnresolvedSendAST new
				to: (UnresolvedSendAST new
					to: (SymbolAST new value: simpleName, '`')
					send: #,
					with: {UnresolvedSendAST new
						to: (UnresolvedSendAST new to: selfNode send: #hash with: {})
						send: #asString
						with: {}})
				send: #asSymbol
				with: {}.
				NumberAST new value: iList size.
				selfNode
				}.
	|

	^addInitializersToMixinApplication: mixinApp nestedMixin: nestedMixin factoryName: factoryName
)
astForMixinInitializer: aNode <ClassHeaderAST> ^ <MethodAST> = (
	(* Creates the instance initializer method for the mixin. This code is shared by all invocations of the mixin defined by the argument *)
	|
	start <integer>
	end <Integer>
	stmts <List[StmtAST]>
	initHdr <MessagePatternAST>
	body <CodeBodyAST>
	slots <Collection[StmtAST]>
	subs <Collection[MethodAST]>
	|
	initHdr:: MessagePatternAST new
		accessModifier: aNode constructor accessModifier;
		selector: (mixinInitializerSelectorNameFor: aNode constructor selector);
		parameters: aNode constructor parameters;
		copyPositionFrom: aNode constructor.

	stmts:: (aNode slots reject: [:slot | slot initializer isNil]) collect:
		[:slot <SlotDefAST> |
		| aMsg <MessageAST> slotInitializer <ExpressionAST> |
		slotInitializer:: slot initializer.
		aNode isSeq ifFalse: [slotInitializer:: futureFor: slotInitializer].
		aMsg:: MessageAST new
			send: (namer selectorForSlotInitializer: slot) with: {slotInitializer};
			start: slot start;
			end: slot end.
		UnresolvedSendAST new
			message: aMsg;
			receiver: (selfNode start: aMsg start; end: aMsg end);
			start: aMsg start; end: aMsg end].

	(* then add the initializer code *)
	aNode initExprs do:
		[:ie <ExpressionAST> | stmts add: ie].
	start:: stmts isEmpty ifTrue: [initHdr end+2] ifFalse: [stmts first start].
	end:: stmts isEmpty ifTrue: [initHdr end + 3] ifFalse: [stmts last end].
	body:: CodeBodyAST new
		temporaries: List new
		statements: stmts;
		start: start; end: end.
	^MethodAST new
		pattern: initHdr body: body accessModifier: #public;
		start: initHdr start; end: end.
)
astForPrimaryFactory: hdr <ClassHeaderAST> ^<MethodAST> = (
	(* Manufacture a method with the given class header's primary constructor's signature, and body that creates a new instance of the class and calls its initializer.
		| @newInstance |
		(@newInstance: self basicNew) initializer`factory: arg1 ... with: argN.
		^@newInstance
	*)
	|
	tempDecl
	cons <MessagePatternAST>
	newInstance <ExpressionAST>
	args <List[ExpressionAST]>
	msgFromConstructor <MessageAST>
	stmts <List[AST]>
	body <CodeBodyAST>
	|

	tempDecl:: MutableSlotDefAST new
		slotDecl: (VarDeclAST name: #'@newInstance' type: nil).
	cons:: hdr constructor.

	newInstance:: UnresolvedSendAST new
		to: hereNode
		send: #'@newInstance:'
		with: {UnresolvedSendAST new
			to: selfNode
			send: #basicNew
			with: {}}.
	args:: cons parameters collect:
		[:vd <VarDeclAST> |
		UnresolvedSendAST new
			to: hereNode
			send: (MessageAST new
				send: vd name with: {};
				start: vd start; end: vd end);
		start: vd start; end: vd end].
	msgFromConstructor:: MessageAST new send: (initializerSelectorNameFor: cons selector) with: args.
	msgFromConstructor copyPositionFrom: cons.

	stmts:: List new.
	stmts add: (UnresolvedSendAST new
		to: newInstance
		send: msgFromConstructor;
		copyPositionFrom: cons).
	stmts add: (ReturnStatAST new
		expression: (UnresolvedSendAST new
			to: hereNode
			send: #'@newInstance'
			with: {})).

	body:: CodeBodyAST new
		temporaries: {tempDecl}
		statements: stmts;
		copyPositionFrom: cons.
	^MethodAST new
		pattern: cons body: body accessModifier: #public;
		copyPositionFrom: cons
)
astForTransientSlotGetter: tree <SlotDefAST> = (
(* Build an AST for a method that would lazily create a execute the expression in a transient  slot, and cache it. The generated code has the form

simpleName = (
	self simpleName`slot isNil ifTrue:
		[self simpleName`slot: initTransientSlotExpression].
	^self simpleName`slot
)

*)

	| initMethodName cacheSlotName selector cacheSlot  assignSlot nilCheck block if return initValue |

	selector:: tree name asSymbol.

	initMethodName:: IntermediateTransientSlot initMethodNameForTransientSlotNamed: selector.
	cacheSlotName:: IntermediateTransientSlot slotNameForTransientSlotNamed: selector.

	cacheSlot:: UnresolvedSendAST new
		to: selfNode
		send: cacheSlotName with: {}.


	initValue:: UnresolvedSendAST new
		to: selfNode
		send: initMethodName
		with: {}.


	assignSlot:: UnresolvedSendAST new
		to: selfNode
		send: (cacheSlotName, ':') asSymbol
		with: {initValue}.

	nilCheck:: UnresolvedSendAST new
		to: cacheSlot
		send: #isNil
		with: {}.

	block:: BlockAST new
		body: (CodeBodyAST new
			parameters: {}
			temporaries: {}
			statements: {assignSlot}).

	if:: UnresolvedSendAST new
		to: nilCheck
		send: #ifTrue:
		with: {block}.
	return:: ReturnStatAST new expression: cacheSlot.


	^MethodAST new
		pattern: (MessagePatternAST new
			accessModifier: tree accessModifier;
			selector: selector
			parameters: {});
		body: (CodeBodyAST new
			parameters: {}
			temporaries: {}
			statements: {if. return});
		start: 1; end: 1
)
astForTransientSlotInitializer: tree <SlotDefAST> do: astAndSourceBlock <[:MethodAST :String]> = (
	| initializer initMethodName selector messagePattern body return newAST newSource |


	selector:: tree name.
	initializer:: tree initializer.

	initMethodName:: IntermediateTransientSlot initMethodNameForTransientSlotNamed: selector.

	messagePattern:: (MessagePatternAST new
		selector: initMethodName;
		accessModifier: #protected;
		parameters: {} asMutableArrayList).

	return:: ReturnStatAST new
		expression: initializer;
		yourself.


	body:: (CodeBodyAST new
		parameters: {} asMutableArrayList
		temporaries: {} asMutableArrayList
	      statements: { return } asMutableArrayList).


	newAST:: MethodAST new
		pattern: messagePattern;
		body: body;
		start: 1;
		end: 1.

(*	newSource:: messagePattern accessModifier , ' ', 'zzzz', ' = ( ^ ', (sourceForNode: initializer), ' )'  .    *)
	newSource:: messagePattern accessModifier , ' ', messagePattern selector, ' = ( ^ ', (sourceForNode: initializer), ' )'.
	astAndSourceBlock value: newAST value: newSource.
)
astForTransientSlotSetter: tree <SlotDefAST> = (
	| cacheSlotName selector assignToSlot newValueParameter parameterName parameter |

	selector:: tree name asSymbol.
	cacheSlotName:: IntermediateTransientSlot slotNameForTransientSlotNamed: selector.
	parameterName:: #p1.

	parameter:: UnresolvedSendAST new
		to: hereNode
		send: parameterName
		with: {}.

	assignToSlot:: UnresolvedSendAST new
		to: selfNode
		send: (cacheSlotName, ':') asSymbol
		with: {parameter}.

	newValueParameter:: VarDeclAST name: parameterName type: nil.

	^MethodAST new
		pattern: (MessagePatternAST new
			accessModifier: tree accessModifier;
			selector: (selector, ':') asSymbol
			parameters: { newValueParameter} asMutableArrayList);
		body: (CodeBodyAST new
			parameters: {newValueParameter} asMutableArrayList
			temporaries: {}
			statements: { assignToSlot } asMutableArrayList);
		start: 1; end: 1
)
buildIncrementalScopeFor: mm <MixinMirror> = (
	| enclosingClass thisClass |
	enclosingClass:: mm declaration enclosingClass.
	nil = enclosingClass ifFalse: [buildIncrementalScopeFor: enclosingClass instanceSide].

	thisClass:: ClassEntry
		forDeclaration: (MessagePatternAST new selector: mm declaration name)
		atDepth: currentDepth.
	thisClass enclosingClass: (currentScope at: #'@currentClass' ifAbsent: [nil]).

	pushScope:: Scope parent: currentScope.
	currentDepth:: currentDepth + 1.

	currentScope at: #'@currentClass' put: thisClass.

	mm slots do:
		[:s <SlotMirror> |
		| se = SlotEntry
			forDeclaration: (MessagePatternAST new selector: s name; accessModifier: s accessModifier)
			atDepth: currentDepth. |
		currentScope at: (namer selectorForSlotInitializer: s) put: se.
		currentScope at: (namer selectorForSlotGetter: s) put: se.
		s isMutable ifTrue:
			[currentScope at: (namer selectorForSlotSetter: s) put: se]].

	mm methods do:
		[:m <MethodMirror> |
		| me = MethodEntry
			forDeclaration: (MessagePatternAST new selector: m name; accessModifier: m accessModifier)
			atDepth: currentDepth. |
		currentScope at: m name put: me].

	mm nestedClasses do:
		[:c <ClassDeclarationMirror> |
		| ce = ClassEntry
			forDeclaration: (MessagePatternAST new selector: c name; accessModifier: c accessModifier)
			atDepth: currentDepth. |
		ce enclosingClass: thisClass.
		currentScope at: c name put: ce].
)
checkForDuplicateNames: node <ClassDeclarationAST> = (
	| namesWithDuplicates names duplicateNames |

	namesWithDuplicates:: List new.
	node instanceSide methods do: [:each | namesWithDuplicates add: each selector].

	node header slots do: [:each |
		namesWithDuplicates add: each name.
		each isMutable ifTrue: [namesWithDuplicates add: each name, ':']].

	namesWithDuplicates
		addAll: (node instanceSide nestedClasses collect: [:each | each name]).

	names:: Set new.
	duplicateNames:: Set new.
	namesWithDuplicates do: [:each | | present |
		present:: true.
		names include: each ifNew: [present:: false].
		present ifTrue: [duplicateNames add: each]].

	duplicateNames isEmpty ifFalse: [ | message |
		message:: String streamContents: [:s |
			s
				nextPutAll: 'Class ';
				nextPutAll: node name;
				nextPutAll: '" has multiple definitions for '.
			duplicateNames
				do: [:each | s nextPutAll: each asString]
				separatedBy: [ s nextPutAll: ','].
			s nextPutAll: '.'.].
		assert: [false] message: message].
)
private compileClass: node <ClassDeclarationAST> ^<IntermediateClassDeclaration> = (
	| headerNode <ClassHeaderAST> classDecl <IntermediateClassDeclaration> |

	checkForDuplicateNames: node.

	headerNode:: node header.
	classDecl:: IntermediateClassDeclaration new.
	classDecl simpleName: headerNode name.
	classDecl headerSource: (sourceForNode: headerNode).
	classDecl factoryName: headerNode constructor selector.
	classDecl comment: (headerNode classComment isNil ifTrue: [''] ifFalse: [headerNode classComment]).
	classDecl category: headerNode category.

	currentDepth:: currentDepth + 1.
	within: classDecl instanceSide compileInstanceSide: node.
	within: classDecl classSide compileClassSide: node.
	currentDepth:: currentDepth - 1.

	^classDecl
)
public compileClassHeader2: src <String> within: enclosing <InstanceMixin> ^<IntermediateClassDeclaration> = (
	| tree <ClassDeclarationAST> intermediate <IntermediateClassDeclaration>  |

	currentSource:: src.
	currentScope:: Scope new.
	currentDepth:: 0.

	nil = enclosing ifFalse: [buildIncrementalScopeFor: enclosing].
	tree:: parser parseClassDeclaration: src , '()'.

	toScope: currentScope addClass: tree.

	nil = enclosing
		ifTrue: [intermediate:: compileClass: tree]
		ifFalse: [intermediate:: within: enclosing compileClassNoAdd: tree].

	^intermediate
)
public compileClassHeader: source <String> within: enclosingIR <IntermediateMixin> = (
	^compileClassSource: (source, '()') within: enclosingIR
)
public compileClassSource: src <String> within: enclosingIR <IntermediateMixin> ^<IntermediateClassDeclaration> = (
	| tree <ClassDeclarationAST> intermediate <IntermediateClassDeclaration>  |

	currentSource:: src.
	currentScope:: Scope new.
	currentDepth:: 0.

	nil = enclosingIR
		ifTrue:
			[tree:: parser parseCompilationUnit: src]
		ifFalse:
			[buildIncrementalScopeFor: enclosingIR builder.
			 tree:: parser parseClassDeclaration: src].

	toScope: currentScope addClass: tree.

	nil = enclosingIR
		ifTrue: [intermediate:: compileClass: tree]
		ifFalse: [intermediate:: within: enclosingIR compileClassNoAdd: tree].

	^intermediate
)
public compileExpressionSource: src <String> debugMapper: debugMapper <MethodContext> withScope: withScope <Map> inMixin: enclosing <MixinMirror> ^<IntermediateMethod> = (
	(* Compile a DoIt method.  If aContext is not nil, compile a DoItIn:ctxt method where accesses to names in scope of the context are rewritten to access through the context.  Cog closures complicate this rewriting compared to BlockContexts, as access might be rather indirect.  Also, in cases where a temp is only a copied value and not in a remote indirection vector, it would be impractical to handle writes such that they actually track down all places where the temp lives and update them.  In these cases, we should merely find the most local copy, which I believe is what closure compiled Squeak does. *)
	|
	body <CodeBodyAST>
	method <MethodAST>
	|

	currentSource:: src.
	currentScope:: Scope new.
	currentDepth:: 0.

	buildIncrementalScopeFor: enclosing.

	(* Parse as a code body *)
	body:: parser parseExpression: src.

	(* Ensure last statement is a return statement *)
	body statements isEmpty ifFalse:
		[body statements last isKindOfReturnStatNode ifFalse:
			[| last |
			last:: body statements removeLast.
			body statements add: (ReturnStatAST new
				expression: last; start: last start; end: last end)]].

	(* Put into a method *)
	method:: MethodAST new
		pattern: (MessagePatternAST new
			selector: #DoItIn:With:
			parameters:
				{VarDeclAST name: namer doitContextArgumentName type: nil.
				 VarDeclAST name: namer scopeArgumentName type: nil});
		body: body;
		accessModifier: #public;
		start: 1;
		end: src size.

	(* Build scope *)
	pushScope:: Scope parent: currentScope.

	nil = debugMapper ifFalse:
		[debugMapper localNames do:
			[:name <Symbol> |
			 | entry = ContextMappedEntry name: name mapper: debugMapper. |
			 currentScope at: name put: entry.
			 currentScope at: (name,':') asSymbol put: entry]].
	nil = withScope ifFalse:
		[withScope keysAndValuesDo:
			[:key <Symbol> :value |
			 | entry = WithMappedEntry name: key asSymbol. |
			 currentScope at: key asSymbol put: entry.
			 currentScope at: (key,':') asSymbol put: entry]].

	(* Rewrite and compile *)
	^compileMethod: method
)
private compileMethod: node <MethodAST> ^<IntermediateMethod> = (
	| result capturedMap |
	result:: rewriter methodNode: node inScope: currentScope.
	capturedMap:: result apply: ClosureRewriter1 new.
	result:: result apply: (ClosureRewriter2 with: capturedMap).
	result:: result apply: methodCompiler.
	result source: (sourceForNode: node).
	^result
)
public compileMethodSource: src <String> within: enclosing <IntermediateMixin> ^<IntermediateMethod> = (
	| tree <MethodAST> |

	currentSource:: src.
	currentScope:: Scope new.
	currentDepth:: 0.

	buildIncrementalScopeFor: enclosing.

	tree:: parser parseMethodDeclaration: src.

	^compileMethod: tree.
)
private compileSyntheticMethod: node <MethodAST> ^<IntermediateMethod> = (
	| result <IntermediateMethod> |
	result:: compileMethod: node.
	result isSynthetic: true.
	^result
)
public compileTransientSlotSource: src <String> within: enclosingIR <IntermediateMixin> ^<IntermediateTransientSlot> = (
	| tree <SlotDefAST> |

	currentSource:: src.
	currentScope:: Scope new.
	currentDepth:: 0.

	buildIncrementalScopeFor: enclosingIR.

	tree:: parser parseTransientSlotDeclaration: src.

	^within: enclosingIR compileTransientSlotNoAdd: tree
)
computeSlotInitializersFor: aNode <ClassHeaderAST> ^ <Collection[StmtAST]> = (
	^(aNode slots reject: [:slot | slot initializer isNil]) collect:
		[:slot <SlotDefAST> |
		| aMsg <MessageAST> slotInitializer <ExpressionAST> |
		slotInitializer:: slot initializer.
		aNode isSeq ifFalse: [slotInitializer:: futureFor: slotInitializer].
		aMsg:: MessageAST new
			send: (namer selectorForSlotInitializer: slot) with: {slotInitializer};
			copyPositionFrom: slot.
		UnresolvedSendAST new message: aMsg;
			receiver: (selfNode start: aMsg start; end: aMsg end);
			copyPositionFrom: slot].
)
private createNestedClassAccessorFrom: nestedClassNode <ClassDeclarationAST | MixinApplicationClassAST> = (
	(* Create an accessor method for the nested class represented by the incoming class tree. This accessor will lazily generate the nested class when its enclosing instance is first asked for it. *)
	|
	simpleName <String>
	ast <MethodAST>
	hdr <ClassHeaderAST>
	classTree <NormalSendAST>
	|

	simpleName:: nestedClassNode name.
	classTree:: nestedClassNode isKindOfMixinApplicationClassAST
		ifTrue:
			[astForComputingMixinApplicationClassDeclaration: simpleName
				superCall: nestedClassNode inheritanceChain first
				iList: (allButFirstOf: nestedClassNode inheritanceChain)
				factoryName: nestedClassNode constructor selector]
		ifFalse:
			[hdr:: nestedClassNode header.
			astForComputingClassDeclaration: simpleName
				superCall: hdr superCall
				iList: (allButFirstOf: hdr inheritanceChain)].
	ast:: accessorASTForNestedClassNamed: simpleName
		classTree: classTree
		accessModifier: nestedClassNode accessModifier.

	^compileSyntheticMethod: ast
)
enclosingObjectTreeFor: c <ExpressionAST> ^ <NormalSendAST> = (
	^UnresolvedSendAST new
		to: c
		send: (MessageAST new send: #enclosingObjectSlot with: {});
		start: c start; end: c end
)
futureFor: expression <ExpressionAST> ^<ExpressionAST> = (
	(* @here Future computing: [expression] *)
	^UnresolvedSendAST new
		receiver: (UnresolvedSendAST new
			receiver: hereNode;
			message: (MessageAST new selector: #Future; arguments: {}));
		message: (MessageAST new selector: #computing:; arguments: {
			BlockAST new body: (
				 CodeBodyAST new
					parameters: List new;
					temporaries: List new;
					statements: {expression}
			)
		})
)
hereNode ^<VariableAST> = (
	(* Generates an AST representing the implicit receiver. Note we use a name that is not a legal identifier. *)
	^VariableAST new name: #'@here'; start: 0; end: 0.
)
hereSendFrom: arg <VarDeclAST> ^<MessageNode> = (
	^UnresolvedSendAST new
		to: hereNode
		send: (MessageAST new
			send: arg name
			with: {};
			start: arg start; end: arg end);
		start: arg start; end: arg end
)
inheritanceASTWIthSuperclass: sc <ExpressionAST> iList: iList <List[SendAST]> ^ <NormalSendAST> = (
(*
Produce an AST representing a series of mixin applications corresponding
to the contents of the inheritance chain described by iList, applied to
the tree representing the superclass clause sc.
Each mixin application is provided an index according to its position in
the list. This index is used as a suffix when renaming the instance initializer
of the mixin application, in order to ensure that none of the instance initializers
of the various mixin applications produced conflict with each other.
*)
	^(iList inject: {sc. 1} into: [:nsc <{ExpressionAST. Integer}> :m <SendAST> |
		{UnresolvedSendAST new
				to: (mixinSendTreeFor: m receiver)
				send: #apply:index:enclosingObject:
				with: {nsc first. NumberAST new value: nsc last. enclosingObjectTreeFor: m receiver}.
		nsc last + 1
		}
		]) first.
)
initializerSelectorNameFor: selector <Symbol> ^<Symbol> = (
	^('initializer`', selector) asSymbol
)
mixinApplicationClassNode: nc <MixinApplicationClassAST>
 in: mixinIR <IntermediateMixin>
 category: cat <String>
 ^<IntermediateClassDeclaration> = (
	|
	classDecl = IntermediateClassDeclaration new.
	scope <Scope> = scopeMap at: nc.
	init <IntermediateMethod> =
		processMethod: (mixinApplicationInitializerFor: nc) inScope: scope in: classDecl instanceSide.
	iListSource <String>
	hdrSource <String>
	cmm <CompiledMixinMirror>
	|
	classDecl simpleName: nc name.
	iListSource:: nc inheritanceChain allButLast
		 inject: '' into: [:s : e | s, (sourceForNode: e), ' <: '].
	iListSource:: iListSource, (sourceForNode: nc inheritanceChain last).
	hdrSource:: nc name, ' ',  (sourceForNode: nc constructor), ' = ', iListSource, '.'.

	classDecl headerSource: hdrSource.
	classDecl factoryName: nc constructor selector.
	classDecl category: cat.
	classDecl comment: ''.
	init isSubinitializer: true.
	init metadata at: #hasBody put: false.
	(* classDecl instanceSide methods add: init.*)
	processFactoryFor: nc inScope: scope in: classDecl classSide.
	classDecl initializers: (List new add: init; yourself). (* is this it? *)
	^classDecl
)
mixinApplicationInitializerFor: classDef <MixinApplicationClassAST> ^ <MethodAST> = (
	(* Probably migrate to superclass *)
	|
	pattern = MessagePatternAST new
		accessModifier: classDef constructor accessModifier;
		selector: (initializerSelectorNameFor: classDef constructor selector);
		parameters: classDef constructor parameters;
		copyPositionFrom: classDef constructor.
	iList = classDef inheritanceChain.
	stmts = mixinInitializationCallsFor: iList.
	body = CodeBodyAST new temporaries: {} statements: stmts.
	mtd = MethodAST new pattern: pattern body: body accessModifier: #public.
	|
	body start: stmts first start; end: stmts last end.
	mtd start: pattern start; end: body end.
	^mtd.
)
mixinCall: number <Integer> inheritanceList: iList <Collection[SendAST]> ^ <NormalSendAST> = (
	(* Probably migrate to superclass *)
	(* create call to superclass initializer *)
	|
	aNode <SendAST> = iList at: number.
	|
	^UnresolvedSendAST new
		to: (VariableAST new
			name: #self;
			copyPositionFrom: aNode)
		send: (MessageAST new
			selector: (superMixinInitializerSelectorFor: aNode message selector number: number - 1);
			arguments: aNode message arguments;
			copyPositionFrom: aNode message);
		copyPositionFrom: aNode
)
mixinInitializationCallsFor: iList <List[SendAST]> ^ <List[StmtAST]> = (
	| stmts <List[StmtAST]> = List new. |
	iList size to: 2 by: -1 do: [:i | stmts addFirst: (mixinCall: i inheritanceList: iList)].
	stmts addFirst: (superFactoryCallFor: iList first).
	^stmts
)
mixinInitializerSelectorNameFor: selector <Symbol> ^<Symbol> = (
	^('mixinInitializer`', selector) asSymbol
)
mixinSendTreeFor: c <ExpressionAST> ^ <NormalSendAST> = (
	^UnresolvedSendAST new
		to: c
		send: (MessageAST new send: #mixin with: {});
		start: c start; end: c end
)
private nestedMixinASTFor: nestedName <String> ^ <NormalSendAST> = (
	|
	mixin = UnresolvedSendAST new
		to: MixinAST new
		send: #value
		with: {}.
	nestedMixins = UnresolvedSendAST new
		to: mixin
		send: #nestedMixins
		with: {}.
	|
	^UnresolvedSendAST new
		to: nestedMixins
		send: #at:
		with: {SymbolAST new value: nestedName}
)
popScope = (
	currentScope:: currentScope parent.
)
pushScope: scope <Scope> = (
	currentScope:: scope
)
selfNode ^<VariableAST> = (
	^VariableAST new name: #self; start: 0; end: 0
)
sourceForNode: node <AST> ^ <String> = (
	^currentSource copyFrom: node start to: node end
)
superConstructorCallFor: aNode <ClassHeaderAST> ^<NormalSendAST> = (
	(* create call to super constructor method *)
	|
	var <VariableAST>
	send <NormalSendAST>
	start <Integer>
	end <Integer>
	superMsg <MessageAST>
	args <List[VariableAST]>
	|

	start:: aNode superConstructorCall start.
	end:: aNode superConstructorCall end.
	var:: VariableAST new name: #self; start: start; end: end.
	args:: aNode constructor parameters collect:
		[:p <VarDeclAST> | hereSendFrom: p].
	superMsg:: MessageAST new
		send: (superConstructorNameFor: aNode) with: args;
		start: start; end: end.
	send:: UnresolvedSendAST new to: var send: superMsg; start: start; end: end.
	^send
)
superConstructorNameFor: aNode <ClassHeaderAST> ^ <Symbol> = (
	^(aNode name, '`superInit`', aNode constructor selector) asSymbol
)
superFactoryCallFor: aNode <SendAST> ^ <NormalSendAST> = (
	(* Probably migrate to superclass *)
	(* create call to superclass initializer *)
	^UnresolvedSendAST new
		to: (VariableAST new
			name: #super;
			copyPositionFrom: aNode)
		send: (MessageAST new
			selector: (initializerSelectorNameFor: aNode message selector);
			arguments: aNode message arguments;
			copyPositionFrom: aNode message);
		copyPositionFrom: aNode
)
superMixinInitializerSelectorFor: selector <Symbol> number: i <Integer> ^<Symbol> = (
	^('mixinInitializer`',  i printString, '`', selector ) asSymbol
)
toScope: scope <Scope> addClass: nestedClassNode <ClassDeclarationAST> = (
	| entry = ClassEntry forDeclaration: nestedClassNode atDepth: currentDepth. |
	checkForReservedWord: nestedClassNode selector.
	entry enclosingClass: (currentScope at: #'@currentClass' ifAbsent: [nil]).
	scope
		at: nestedClassNode selector
		put: entry
)
toScope: scope <Scope> addMethod: methodNode <MethodAST> = (
	checkForReservedWord: methodNode selector.
	currentScope
		at: methodNode selector
		put: (MethodEntry forDeclaration: methodNode atDepth: currentDepth).
)
toScope: scope <Scope> addSlot: slotNode <SlotDeclAST> = (
	| entry = SlotEntry forDeclaration: slotNode atDepth: currentDepth. |
	checkForReservedWord: slotNode name.
	scope at: (namer selectorForSlotInitializer: slotNode) put: entry.
	scope at: (namer selectorForSlotGetter: slotNode) put: entry.
	slotNode isMutable ifTrue:
		[scope at: (namer selectorForSlotSetter: slotNode) put: entry].
)
private within: mixinIR <IntermediateMixin> compileClass: nestedClassNode <MethodAST> = (
	mixinIR nestedClasses add: (within: mixinIR compileClassNoAdd: nestedClassNode).
)
private within: mixinIR <IntermediateMixin> compileClassNoAdd: nestedClassNode <MethodAST> = (
	| nestedClassIR |
	nestedClassIR:: nestedClassNode isKindOfClassDeclarationNode
		ifTrue: [compileClass: nestedClassNode]
		ifFalse: [mixinApplicationClassNode: nestedClassNode in: mixinIR category: 'XYZ'].
	nestedClassIR enclosingClass: mixinIR.
	nestedClassIR accessor: (createNestedClassAccessorFrom: nestedClassNode).
	^nestedClassIR
)
private within: mixinIR <IntermediateMixin> compileClassSide: classNode <ClassDeclarationAST> = (
	| thisClass <ClassEntry> |
	thisClass:: currentScope at: classNode name.
	pushScope:: Scope parent: currentScope.
	currentScope at: #'@currentClass' put: thisClass.
	classNode instanceSide methods do:
		[:methodNode <MethodAST> | toScope: currentScope addMethod: methodNode].

	within: mixinIR compileFactory: classNode header.
	classNode classSide methods do:
		[:methodNode <MethodAST> | within: mixinIR compileMethod: methodNode].

	popScope.
)
private within: mixinIR <IntermediateMixin> compileFactory: headerNode <ClassHeaderAST> = (
	mixinIR declaration factory: (compileSyntheticMethod: (astForPrimaryFactory: headerNode)).
)
private within: mixinIR <IntermediateMixin> compileInitializers: headerNode <ClassHeaderAST> = (
	(* The superclass clause is not a property of the mixin; this method is specific to the application. That said, all applications derived from the class declaration will share it *)
	mixinIR declaration initializers: {
		compileSyntheticMethod: (astForClassDeclarationInitializer: headerNode).
		compileSyntheticMethod: (astForMixinInitializer: headerNode).
	}.
)
private within: mixinIR <IntermediateMixin> compileInstanceSide: classNode <ClassDeclarationAST> = (
	| thisClass <ClassEntry> |
	thisClass:: currentScope at: classNode name.
	pushScope:: Scope parent: currentScope.
	currentScope at: #'@currentClass' put: thisClass.
	classNode header slots do:
		[:slotNode <SlotDefAST> | toScope: currentScope addSlot: slotNode].
	classNode instanceSide methods do:
		[:methodNode <MethodAST> | toScope: currentScope addMethod: methodNode].
	classNode instanceSide nestedClasses do:
		[:nestedClassNode <ClassDeclarationAST> | toScope: currentScope addClass: nestedClassNode].

	classNode header slots do:
		[:slotNode <SlotDefAST> | within: mixinIR compileSlot: slotNode].
	within: mixinIR compileInitializers: classNode header.
	classNode instanceSide methods do:
		[:methodNode <MethodAST> | within: mixinIR compileMethod: methodNode].
	classNode instanceSide transientSlots do:
		[:transientSlotNode <SlotDefAST> | within: mixinIR compileTransientSlot: transientSlotNode].
	classNode instanceSide nestedClasses do:
		[:nestedClassNode <ClassDeclarationAST> | within: mixinIR compileClass: nestedClassNode].

	popScope.
)
private within: mixinIR <IntermediateMixin> compileMethod: methodNode <MethodAST> = (
	| methodIR = compileMethod: methodNode. |
	methodIR category: 'as yet unclassified'.
	mixinIR methods add: methodIR.
)
private within: mixinIR <IntermediateMixin> compileSlot: slotNode <SlotDefAST> = (
	| slotIR = IntermediateSlotDeclaration new. |
	slotIR name: slotNode name.
	slotIR isMutable: slotNode isMutable.
	slotIR accessModifier: slotNode accessModifier.
	mixinIR slots add: slotIR.
)
private within: mixinIR <IntermediateMixin> compileTransientSlot: transientSlotNode <SlotDefAST> = (
	mixinIR transientSlots add: (within: mixinIR compileTransientSlotNoAdd: transientSlotNode)
)
private within: enclosingIR <IntermediateMixin> compileTransientSlotNoAdd: tree <SlotDefAST> = (
	| intermediateTS treeMainMethod mixinIR name initMethod mainMethod category source |

	category:: #'transientslots'.
	mixinIR: enclosingIR.
	name: tree name.
	intermediateTS:: IntermediateTransientSlot new.
	source:: sourceForNode: tree.

	(* cache slot is created by IntermediateTransientSlot *)

	(* init method *)
	 astForTransientSlotInitializer: tree do:
		[:treeInitMethod :newSource |
		initMethod:: compileMethod: treeInitMethod.
		initMethod isSynthetic: false.
		initMethod category: category.
		initMethod source: newSource.
		intermediateTS intermediateInitMethod: initMethod].

	(* main method  *)
	treeMainMethod:: astForTransientSlotGetter: tree.
	mainMethod:: compileMethod: treeMainMethod.
	mainMethod isSynthetic: false.
	mainMethod category: category.
	mainMethod source: source.
	intermediateTS intermediateMainMethod: mainMethod.

	(* setter Method*)
	tree isMutable ifTrue:
		[ | treeSetterMethod setterMethod |
		treeSetterMethod:: astForTransientSlotSetter: tree.
		setterMethod:: compileMethod: treeSetterMethod.
		setterMethod isSynthetic: false.
		setterMethod category: category.
		intermediateTS intermediateSetterMethod: setterMethod].

	^intermediateTS
)
) : (
)
class ContextMappedEntry name: nom mapper: mapper = SymbolTableEntry forAST: nil atDepth: nil (|
	public name = nom.
	debugMapper = mapper.
|) (
public getterAst = (
	^debugMapper getterAstFor: name.
)
public setterAst: newVal = (
	^debugMapper setterAstFor: name putting: newVal.
)
public isKindOfMappedBinding = (
	^true
)
) : (
)
class WithMappedEntry name: nom = SymbolTableEntry forAST: nil atDepth: nil (|
	public name = nom.
|) (
public getterAst = (
	^UnresolvedSendAST new
		receiver: mapAst;
		message: (MessageAST new
			selector: #at:;
			arguments: {SymbolAST new value: name})
)
public isMappedBinding = (
	^true
)
private mapAst = (
	^UnresolvedSendAST new
		receiver: (VariableAST new name: #'@here');
		message: (MessageAST new
			selector: namer scopeArgumentName;
			arguments: {})
)
public setterAst: newVal = (
	^UnresolvedSendAST new
		receiver: mapAst;
		message: (MessageAST new
			selector: #at:put:;
			arguments: {SymbolAST new value: name. newVal})
)
public isKindOfMappedBinding = (
	^true
)
) : (
)
ClassEntry = (
	^super ClassEntry
)
LocalEntry = (
	^super LocalEntry
)
MethodEntry = (
	^super MethodEntry
)
Scope = (
	^super Scope
)
SlotEntry = (
	^super SlotEntry
)
SymbolTableEntry = (
	^super SymbolTableEntry
)
assert: c = (
	self assert: c message: 'Assert failed'.
)
private isSqueak = (
	^'A' first isKindOfCharacter
)
namer = (
	^super namer
)
) : (
)