1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234 |
- Smalltalk current createPackage: 'Compiler-Interpreter'!
- BlockClosure subclass: #AIBlockClosure
- instanceVariableNames: 'node outerContext'
- package: 'Compiler-Interpreter'!
- !AIBlockClosure commentStamp!
- I am a special `BlockClosure` subclass used by an interpreter to interpret a block node.
- While I am polymorphic with `BlockClosure`, some methods such as `#new` will raise interpretation errors. Unlike a `BlockClosure`, my instance are not JavaScript functions.
- Evaluating an instance will result in interpreting the `node` instance variable (instance of `BlockNode`).!
- !AIBlockClosure methodsFor: 'accessing'!
- compiledSource
- "Unlike blocks, the receiver doesn't represent a JS function"
-
- ^ '[ AST Block closure ]'
- !
- numArgs
- ^ node temps size
- ! !
- !AIBlockClosure methodsFor: 'converting'!
- currySelf
- self interpreterError
- ! !
- !AIBlockClosure methodsFor: 'error handling'!
- interpreterError
- AIInterpreterError signal: 'Method cannot be interpreted by the interpreter.'
- ! !
- !AIBlockClosure methodsFor: 'evaluating'!
- applyTo: anObject arguments: aCollection
- self interpreterError
- !
- value
- ^ self valueWithPossibleArguments: #()
- !
- value: anArgument
- ^ self valueWithPossibleArguments: {anArgument}
- !
- value: firstArgument value: secondArgument
- ^ self valueWithPossibleArguments: {firstArgument . secondArgument}
- !
- value: firstArgument value: secondArgument value: thirdArgument
- ^ self valueWithPossibleArguments: {firstArgument . secondArgument . thirdArgument}
- !
- valueWithPossibleArguments: aCollection
- | context sequenceNode |
- context := outerContext newBlockContext.
- "Interpret a copy of the sequence node to avoid creating a new AIBlockClosure"
- sequenceNode := node nodes first copy
- parent: nil;
- yourself.
- "Populate the arguments into the context locals"
- node parameters withIndexDo: [ :each :index |
- context localAt: each put: (aCollection at: index ifAbsent: [ nil ]) ].
- "Interpret the first node of the BlockSequenceNode"
- context interpreter
- node: sequenceNode nextChild;
- proceed.
-
- outerContext interpreter
- returnValue: context interpreter returnValue.
-
- console log: context interpreter returnValue.
-
- ^ context interpreter pop
- ! !
- !AIBlockClosure methodsFor: 'initialization'!
- initializeWithContext: aContext node: aNode
- node := aNode.
- outerContext := aContext
- ! !
- !AIBlockClosure class methodsFor: 'instance creation'!
- forContext: aContext node: aNode
- ^ self new
- initializeWithContext: aContext node: aNode;
- yourself
- ! !
- Object subclass: #AIContext
- instanceVariableNames: 'outerContext innerContext pc locals method index ast interpreter'
- package: 'Compiler-Interpreter'!
- !AIContext commentStamp!
- I am like a `MethodContext`, used by the `ASTInterpreter`.
- Unlike a `MethodContext`, my instances are not read-only.
- When debugging, my instances are created by copying the current `MethodContext` (thisContext)!
- !AIContext methodsFor: 'accessing'!
- index
- ^ index ifNil: [ 0 ]
- !
- index: anInteger
- index := anInteger
- !
- innerContext
- ^ innerContext
- !
- innerContext: anAIContext
- innerContext := anAIContext
- !
- localAt: aString
- "Lookup the local value up to the method context"
- ^ self locals at: aString ifAbsent: [
- self isBlockContext
- ifTrue: [ nil ]
- ifFalse: [ self outerContext localAt: aString ] ]
- !
- localAt: aString put: anObject
- self locals at: aString put: anObject
- !
- locals
- locals ifNil: [ self initializeLocals ].
-
- ^ locals
- !
- method
- ^ method
- !
- method: aCompiledMethod
- method := aCompiledMethod
- !
- methodContext
- self isBlockContext ifFalse: [ ^ self ].
-
- ^ self outerContext ifNotNil: [ :outer |
- outer methodContext ]
- !
- outerContext
- ^ outerContext
- !
- outerContext: anAIContext
- outerContext := anAIContext.
- outerContext innerContext: self
- !
- selector
- ^ self method ifNotNil: [
- self method selector ]
- ! !
- !AIContext methodsFor: 'converting'!
- asString
- ^self isBlockContext
- ifTrue: [ 'a block (in ', self methodContext asString, ')' ]
- ifFalse: [ self receiver class name, ' >> ', self selector ]
- ! !
- !AIContext methodsFor: 'factory'!
- newBlockContext
- ^ self class new
- outerContext: self;
- yourself
- ! !
- !AIContext methodsFor: 'initialization'!
- initializeAST
- ast := self method ast.
- (SemanticAnalyzer on: self method methodClass)
- visit: ast
- !
- initializeFromMethodContext: aMethodContext
- self
- pc: aMethodContext pc;
- index: aMethodContext index;
- receiver: aMethodContext receiver;
- method: aMethodContext method.
-
- aMethodContext outerContext ifNotNil: [ :outer |
- "If the method context is nil, the block was defined in JS, so ignore it"
- outer methodContext ifNotNil: [
- self outerContext: (self class fromMethodContext: aMethodContext outerContext) ].
- aMethodContext locals keysAndValuesDo: [ :key :value |
- self locals at: key put: value ] ]
- !
- initializeInterpreter
- interpreter := Interpreter new
- context: self;
- yourself.
- ast ifNotNil: [ interpreter node: self retrieveNode ].
-
- (self innerContext notNil and: [
- self innerContext isBlockContext not ]) ifTrue: [
- self setupInterpreter: interpreter ]
- !
- initializeLocals
- locals := Dictionary new.
- locals at: 'thisContext' put: self.
- ! !
- !AIContext methodsFor: 'interpreting'!
- arguments
- ^ self ast arguments collect: [ :each |
- self localAt: each ]
- !
- ast
- self isBlockContext ifTrue: [ ^ self outerContext ast ].
- ast ifNil: [ self initializeAST ].
- ^ ast
- !
- interpreter
- interpreter ifNil: [ self initializeInterpreter ].
- ^ interpreter
- !
- interpreter: anInterpreter
- interpreter := anInterpreter
- !
- pc
- ^ pc ifNil: [ pc := 0 ]
- !
- pc: anInteger
- pc := anInteger
- !
- receiver
- ^ self localAt: 'self'
- !
- receiver: anObject
- self localAt: 'self' put: anObject
- !
- retrieveNode
- ^ ASTPCNodeVisitor new
- context: self;
- visit: self ast;
- currentNode
- !
- setupInterpreter: anInterpreter
- "Push the send args and receiver to the interpreter stack"
-
- self innerContext arguments reversed do: [ :each |
- anInterpreter push: each ].
-
- anInterpreter push: (self innerContext receiver)
- ! !
- !AIContext methodsFor: 'testing'!
- isBlockContext
- "Block context do not have selectors."
-
- ^ self selector isNil
- ! !
- !AIContext class methodsFor: 'instance creation'!
- fromMethodContext: aMethodContext
- ^ self new
- initializeFromMethodContext: aMethodContext;
- yourself
- ! !
- Error subclass: #AIInterpreterError
- instanceVariableNames: ''
- package: 'Compiler-Interpreter'!
- !AIInterpreterError commentStamp!
- I get signaled when an AST interpreter is unable to interpret a node.!
- Object subclass: #ASTDebugger
- instanceVariableNames: 'interpreter context'
- package: 'Compiler-Interpreter'!
- !ASTDebugger commentStamp!
- I am a stepping debugger interface for Amber code.
- I internally use an instance of `ASTSteppingInterpreter` to actually step through node and interpret them.
- My instances are created from a `MethodContext` with `ASTDebugger class >> context:`.
- They hold an `AIContext` instance internally, recursive copy of the `MethodContext`.
- ## API
- Use the methods of the `'stepping'` protocol to do stepping.!
- !ASTDebugger methodsFor: 'accessing'!
- context
- ^ context
- !
- context: aContext
- context := aContext
- !
- interpreter
- ^ interpreter ifNil: [ interpreter := self defaultInterpreterClass new ]
- !
- interpreter: anInterpreter
- interpreter := anInterpreter
- !
- method
- ^ self context method
- !
- nextNode
- ^ self interpreter nextNode
- ! !
- !ASTDebugger methodsFor: 'defaults'!
- defaultInterpreterClass
- ^ ASTSteppingInterpreter
- ! !
- !ASTDebugger methodsFor: 'initialization'!
- buildAST
- "Build the AST tree from the method source code.
- The AST is annotated with a SemanticAnalyzer,
- to know the semantics and bindings of each node needed for later debugging"
-
- | ast |
-
- ast := Smalltalk current parse: self method source.
- (SemanticAnalyzer on: self context receiver class)
- visit: ast.
-
- ^ ast
- !
- initializeInterpreter
- | ast next |
- ast := self buildAST.
- next := ASTPCNodeVisitor new
- context: self context;
- visit: ast;
- currentNode.
- self interpreter interpret: next
- !
- initializeWithContext: aContext
- "TODO: do we need to handle block contexts?"
-
- self context: aContext.
- self initializeInterpreter
- ! !
- !ASTDebugger methodsFor: 'stepping'!
- proceed
- self shouldBeImplemented
- !
- restart
- self shouldBeImplemented
- !
- step
- "The ASTSteppingInterpreter stops at each node interpretation.
- One step will interpret nodes until:
- - we get at the end
- - the next node is a stepping node (send, assignment, etc.)"
-
- [ (self interpreter nextNode notNil and: [ self interpreter nextNode stopOnStepping ])
- or: [ self interpreter atEnd not ] ]
- whileFalse: [
- self interpreter step.
- self step ]
- !
- stepInto
- self shouldBeImplemented
- !
- stepOver
- self step
- ! !
- !ASTDebugger methodsFor: 'testing'!
- atEnd
- ^ self interpreter atEnd
- ! !
- !ASTDebugger class methodsFor: 'instance creation'!
- context: aContext
- ^ self new
- initializeWithContext: aContext;
- yourself
- ! !
- Object subclass: #ASTInterpreter
- instanceVariableNames: 'currentNode nextNode context shouldReturn result'
- package: 'Compiler-Interpreter'!
- !ASTInterpreter commentStamp!
- I am like a `NodeVisitor`, interpreting nodes one after each other.
- I am built using Continuation Passing Style for stepping purposes.
- ## Usage example:
- | ast interpreter |
- ast := Smalltalk current parse: 'foo 1+2+4'.
- (SemanticAnalyzer on: Object) visit: ast.
- ASTInterpreter new
- interpret: ast nodes first;
- result "Answers 7"!
- !ASTInterpreter methodsFor: 'accessing'!
- context
- ^ context ifNil: [ context := AIContext new ]
- !
- context: anAIContext
- context := anAIContext
- !
- currentNode
- ^ currentNode
- !
- nextNode
- ^ nextNode ifNil: [ self currentNode ]
- !
- nextNode: aNode
- nextNode := aNode
- !
- result
- ^ result
- ! !
- !ASTInterpreter methodsFor: 'initialization'!
- initialize
- super initialize.
- shouldReturn := false
- ! !
- !ASTInterpreter methodsFor: 'interpreting'!
- interpret: aNode
- shouldReturn := false.
- self interpret: aNode continue: [ :value |
- result := value ]
- !
- interpret: aNode continue: aBlock
- shouldReturn ifTrue: [ ^ self ].
- aNode isNode
- ifTrue: [
- currentNode := aNode.
- self interpretNode: aNode continue: [ :value |
- self continue: aBlock value: value ] ]
- ifFalse: [ self continue: aBlock value: aNode ]
- !
- interpretAssignmentNode: aNode continue: aBlock
- self interpret: aNode right continue: [ :value |
- self
- continue: aBlock
- value: (self assign: aNode left to: value) ]
- !
- interpretBlockNode: aNode continue: aBlock
- self
- continue: aBlock
- value: [
- self withBlockContext: [
- self interpret: aNode nodes first; result ] ]
- !
- interpretBlockSequenceNode: aNode continue: aBlock
- self interpretSequenceNode: aNode continue: aBlock
- !
- interpretCascadeNode: aNode continue: aBlock
- "TODO: Handle super sends"
-
- self interpret: aNode receiver continue: [ :receiver |
- "Only interpret the receiver once"
- aNode nodes do: [ :each | each receiver: receiver ].
- self
- interpretAll: aNode nodes allButLast
- continue: [
- self
- interpret: aNode nodes last
- continue: [ :val | self continue: aBlock value: val ] ] ]
- !
- interpretClassReferenceNode: aNode continue: aBlock
- self continue: aBlock value: (Smalltalk current at: aNode value)
- !
- interpretDynamicArrayNode: aNode continue: aBlock
- self interpretAll: aNode nodes continue: [ :array |
- self
- continue: aBlock
- value: array ]
- !
- interpretDynamicDictionaryNode: aNode continue: aBlock
- self interpretAll: aNode nodes continue: [ :array | | hashedCollection |
- hashedCollection := HashedCollection new.
- array do: [ :each | hashedCollection add: each ].
- self
- continue: aBlock
- value: hashedCollection ]
- !
- interpretJSStatementNode: aNode continue: aBlock
- shouldReturn := true.
- self continue: aBlock value: (self eval: aNode source)
- !
- interpretMethodNode: aNode continue: aBlock
- self interpretAll: aNode nodes continue: [ :array |
- self continue: aBlock value: array first ]
- !
- interpretNode: aNode continue: aBlock
- aNode interpreter: self continue: aBlock
- !
- interpretReturnNode: aNode continue: aBlock
- self interpret: aNode nodes first continue: [ :value |
- shouldReturn := true.
- self continue: aBlock value: value ]
- !
- interpretSendNode: aNode continue: aBlock
- self interpret: aNode receiver continue: [ :receiver |
- self interpretAll: aNode arguments continue: [ :args |
- self
- messageFromSendNode: aNode
- arguments: args
- do: [ :message |
- self context pc: self context pc + 1.
- self
- continue: aBlock
- value: (self sendMessage: message to: receiver superSend: aNode superSend) ] ] ]
- !
- interpretSequenceNode: aNode continue: aBlock
- self interpretAll: aNode nodes continue: [ :array |
- self continue: aBlock value: array last ]
- !
- interpretValueNode: aNode continue: aBlock
- self continue: aBlock value: aNode value
- !
- interpretVariableNode: aNode continue: aBlock
- self
- continue: aBlock
- value: (aNode binding isInstanceVar
- ifTrue: [ self context receiver instVarAt: aNode value ]
- ifFalse: [ self context localAt: aNode value ])
- ! !
- !ASTInterpreter methodsFor: 'private'!
- assign: aNode to: anObject
- ^ aNode binding isInstanceVar
- ifTrue: [ self context receiver instVarAt: aNode value put: anObject ]
- ifFalse: [ self context localAt: aNode value put: anObject ]
- !
- continue: aBlock value: anObject
- result := anObject.
- aBlock value: anObject
- !
- eval: aString
- "Evaluate aString as JS source inside an JS function.
- aString is not sandboxed."
-
- | source function |
-
- source := String streamContents: [ :str |
- str nextPutAll: '(function('.
- self context locals keys
- do: [ :each | str nextPutAll: each ]
- separatedBy: [ str nextPutAll: ',' ].
- str
- nextPutAll: '){ return (function() {';
- nextPutAll: aString;
- nextPutAll: '})() })' ].
-
- function := Compiler new eval: source.
-
- ^ function valueWithPossibleArguments: self context locals values
- !
- interpretAll: aCollection continue: aBlock
- self
- interpretAll: aCollection
- continue: aBlock
- result: OrderedCollection new
- !
- interpretAll: nodes continue: aBlock result: aCollection
- nodes isEmpty
- ifTrue: [ self continue: aBlock value: aCollection ]
- ifFalse: [
- self interpret: nodes first continue: [:value |
- self
- interpretAll: nodes allButFirst
- continue: aBlock
- result: aCollection, { value } ] ]
- !
- messageFromSendNode: aSendNode arguments: aCollection do: aBlock
- self
- continue: aBlock
- value: (Message new
- selector: aSendNode selector;
- arguments: aCollection;
- yourself)
- !
- sendMessage: aMessage to: anObject superSend: aBoolean
- | method |
-
- aBoolean ifFalse: [ ^ aMessage sendTo: anObject ].
- anObject class superclass ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
-
- method := anObject class superclass methodDictionary
- at: aMessage selector
- ifAbsent: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
-
- ^ method fn applyTo: anObject arguments: aMessage arguments
- !
- withBlockContext: aBlock
- "Evaluate aBlock with a BlockContext:
- - a context is pushed before aBlock evaluation.
- - the context is poped after aBlock evaluation
- - the result of aBlock evaluation is answered"
-
- | blockResult |
-
- self context: (AIContext new
- outerContext: self context;
- yourself).
-
- blockResult := aBlock value.
-
- self context: self context outerContext.
- ^ blockResult
- ! !
- !ASTInterpreter methodsFor: 'testing'!
- shouldReturn
- ^ shouldReturn ifNil: [ false ]
- ! !
- ASTInterpreter subclass: #ASTSteppingInterpreter
- instanceVariableNames: 'continuation nextNode'
- package: 'Compiler-Interpreter'!
- !ASTSteppingInterpreter commentStamp!
- I am an interpreter with stepping capabilities. The higher level `ASTDebugger` class should be used as a debugger model, as it provides convenience methods for debugging.
- ## API
- Use `#step` to actually interpret the next node. Interpretation stops at each node evaluation, weither it's a message node or not.
- ## Usage example:
- | ast interpreter |
- ast := Smalltalk current parse: 'foo 1+2+4'.
- (SemanticAnalyzer on: Object) visit: ast.
- interpreter := ASTSteppingInterpreter new
- interpret: ast nodes first;
- yourself.
-
- interpreter step; step.
- interpreter step; step.
- interpreter result."Answers 1"
- interpreter step.
- interpreter result. "Answers 3"
- interpreter step.
- interpreter result. "Answers 7"!
- !ASTSteppingInterpreter methodsFor: 'accessing'!
- nextNode
- ^ nextNode
- ! !
- !ASTSteppingInterpreter methodsFor: 'initialization'!
- initialize
- super initialize.
- continuation := []
- ! !
- !ASTSteppingInterpreter methodsFor: 'interpreting'!
- interpret: aNode continue: aBlock
- nextNode := aNode.
- continuation := [
- super interpret: aNode continue: aBlock ]
- ! !
- !ASTSteppingInterpreter methodsFor: 'stepping'!
- step
- continuation value
- ! !
- !ASTSteppingInterpreter methodsFor: 'testing'!
- atEnd
- ^ self shouldReturn or: [ self nextNode == self currentNode ]
- ! !
- NodeVisitor subclass: #ASTPCNodeVisitor
- instanceVariableNames: 'useInlinings pc context blockIndex currentNode'
- package: 'Compiler-Interpreter'!
- !ASTPCNodeVisitor commentStamp!
- I visit an AST until I get to the current pc node and answer it.
- ## API
- My instances must be filled with a context object using `#context:`.
- After visiting the AST the current node corresponding to the `pc` is answered by `#currentNode`!
- !ASTPCNodeVisitor methodsFor: 'accessing'!
- blockIndex
- ^ blockIndex ifNil: [ blockIndex := 0 ]
- !
- context
- ^ context
- !
- context: aContext
- context := aContext
- !
- currentNode
- ^ currentNode
- !
- increaseBlockIndex
- blockIndex := self blockIndex + 1
- !
- pc
- ^ pc ifNil: [ 0 ]
- !
- pc: anInteger
- pc := anInteger
- !
- useInlinings
- ^ useInlinings ifNil: [ true ]
- !
- useInlinings: aBoolean
- useInlinings := aBoolean
- ! !
- !ASTPCNodeVisitor methodsFor: 'visiting'!
- visitBlockNode: aNode
- aNode shouldBeInlined
- ifFalse: [
- self blockIndex >= self context index ifFalse: [
- self increaseBlockIndex.
- super visitBlockNode: aNode ] ]
- ifTrue: [ super visitBlockNode: aNode ]
- !
- visitJSStatementNode: aNode
- currentNode := aNode
- !
- visitSendNode: aNode
- super visitSendNode: aNode.
-
- self pc = self context pc ifFalse: [
- aNode shouldBeInlined ifFalse: [
- self blockIndex = self context index ifTrue: [
- self pc: self pc + 1.
- currentNode := aNode ] ] ]
- ! !
- NodeVisitor subclass: #Interpreter
- instanceVariableNames: 'node context stack returnValue'
- package: 'Compiler-Interpreter'!
- !Interpreter methodsFor: 'accessing'!
- context
- ^ context
- !
- context: aContext
- context := aContext
- !
- node
- "Answer the next node, ie the node to be evaluated in the next step"
-
- ^ node
- !
- node: aNode
- node := aNode
- !
- result
- ^ self returnValue ifNil: [ self context receiver ]
- !
- returnValue
- ^ returnValue
- !
- returnValue: anObject
- returnValue := anObject
- !
- stack
- ^ stack ifNil: [ stack := OrderedCollection new ]
- ! !
- !Interpreter methodsFor: 'interpreting'!
- interpret
- "Interpret the next node to be evaluated"
-
- self visit: self node
- !
- interpret: aNode
- self node: aNode.
- self interpret
- !
- next
- self node: self node nextNode
- !
- proceed
- "Eagerly evaluate the ast"
-
- [ self atEnd ] whileFalse: [
- self step ]
- !
- restart
- self node: self context ast nextChild
- !
- skip
- self next
- !
- step
- self
- interpret;
- next
- !
- stepOver
- self step.
-
- [ self node isSteppingNode ] whileFalse: [
- self step ]
- ! !
- !Interpreter methodsFor: 'private'!
- assign: aNode to: anObject
- aNode binding isInstanceVar
- ifTrue: [ self context receiver instVarAt: aNode value put: anObject ]
- ifFalse: [ self context localAt: aNode value put: anObject ]
- !
- eval: aString
- "Evaluate aString as JS source inside an JS function.
- aString is not sandboxed."
-
- | source function |
-
- source := String streamContents: [ :str |
- str nextPutAll: '(function('.
- self context locals keys
- do: [ :each | str nextPutAll: each ]
- separatedBy: [ str nextPutAll: ',' ].
- str
- nextPutAll: '){ return (function() {';
- nextPutAll: aString;
- nextPutAll: '})() })' ].
-
- function := Compiler new eval: source.
-
- ^ function valueWithPossibleArguments: self context locals values
- !
- messageFromSendNode: aSendNode arguments: aCollection
- ^ Message new
- selector: aSendNode selector;
- arguments: aCollection;
- yourself
- !
- messageNotUnderstood: aMessage receiver: anObject
- MessageNotUnderstood new
- meesage: aMessage;
- receiver: anObject;
- signal
- !
- sendMessage: aMessage to: anObject superSend: aBoolean
- | method |
-
- aBoolean ifFalse: [ ^ aMessage sendTo: anObject ].
- anObject class superclass ifNil: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
-
- method := anObject class superclass methodDictionary
- at: aMessage selector
- ifAbsent: [ ^ self messageNotUnderstood: aMessage receiver: anObject ].
-
- ^ method sendTo: anObject arguments: aMessage arguments
- ! !
- !Interpreter methodsFor: 'stack'!
- peek
- "Peek the top object of the context stack"
-
- self stack ifEmpty: [ ^ nil ].
-
- ^ self stack last
- !
- pop
- "Pop an object from the context stack"
-
- | peekedValue |
-
- peekedValue := self peek.
- self stack removeLast.
- ^ peekedValue
- !
- push: anObject
- "Push an object to the context stack"
-
- ^ self stack add: anObject
- ! !
- !Interpreter methodsFor: 'testing'!
- atEnd
- ^ self shouldReturn or: [ self node isNil ]
- !
- shouldReturn
- ^ self returnValue notNil
- ! !
- !Interpreter methodsFor: 'visiting'!
- visit: aNode
- self shouldReturn ifFalse: [ super visit: aNode ]
- !
- visitAssignmentNode: aNode
- | poppedValue |
-
- poppedValue := self pop.
-
- "Pop the left side of the assignment.
- It already has been visited, and we don't need its value."
- self pop.
-
- self push: poppedValue.
- self assign: aNode left to: poppedValue
- !
- visitBlockNode: aNode
- "Do not evaluate the block node.
- Instead, put all instructions into a block that we push to the stack for later evaluation"
-
- | block |
-
- block := AIBlockClosure forContext: self context node: aNode.
-
- self push: block
- !
- visitClassReferenceNode: aNode
- self push: (Smalltalk current
- at: aNode value
- ifAbsent: [ PlatformInterface globals at: aNode value ])
- !
- visitDynamicArrayNode: aNode
- | array |
-
- array := #().
- aNode nodes do: [ :each |
- array addFirst: self pop ].
-
- self push: array
- !
- visitDynamicDictionaryNode: aNode
- | hashedCollection |
-
- hashedCollection := HashedCollection new.
- aNode nodes do: [ :each |
- hashedCollection add: self pop ].
-
- self push: hashedCollection
- !
- visitJSStatementNode: aNode
- self returnValue: (self eval: aNode source)
- !
- visitNode: aNode
- "Do nothing by default. Especially, do not visit children recursively."
- !
- visitReturnNode: aNode
- self returnValue: self pop
- !
- visitSendNode: aNode
- | receiver args message result |
-
- args := aNode arguments collect: [ :each | self pop ].
- receiver := self pop.
-
- message := self
- messageFromSendNode: aNode
- arguments: args reversed.
-
- result := self sendMessage: message to: receiver superSend: aNode superSend.
-
- self context pc: self context pc + 1.
-
- "For cascade sends, push the reciever if the send is not the last one"
- (aNode isCascadeSendNode and: [ aNode isLastChild not ])
- ifTrue: [ self push: receiver ]
- ifFalse: [ self push: result ]
- !
- visitValueNode: aNode
- self push: aNode value
- !
- visitVariableNode: aNode
- aNode binding isUnknownVar ifTrue: [
- ^ self push: (PlatformInterface globals at: aNode value ifAbsent: [ self error: 'Unknown variable' ]) ].
-
- self push: (aNode binding isInstanceVar
- ifTrue: [ self context receiver instVarAt: aNode value ]
- ifFalse: [ self context localAt: aNode value ])
- ! !
- !Node methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretNode: self continue: aBlock
- !
- isSteppingNode
- ^ false
- ! !
- !AssignmentNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretAssignmentNode: self continue: aBlock
- !
- isSteppingNode
- ^ true
- ! !
- !BlockNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretBlockNode: self continue: aBlock
- !
- isSteppingNode
- ^ true
- ! !
- !CascadeNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretCascadeNode: self continue: aBlock
- ! !
- !DynamicArrayNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretDynamicArrayNode: self continue: aBlock
- !
- isSteppingNode
- ^ true
- ! !
- !DynamicDictionaryNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretDynamicDictionaryNode: self continue: aBlock
- !
- isSteppingNode
- ^ true
- ! !
- !JSStatementNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretJSStatementNode: self continue: aBlock
- !
- isSteppingNode
- ^ true
- ! !
- !MethodNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretMethodNode: self continue: aBlock
- ! !
- !ReturnNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretReturnNode: self continue: aBlock
- ! !
- !SendNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretSendNode: self continue: aBlock
- !
- isSteppingNode
- ^ true
- ! !
- !SequenceNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretSequenceNode: self continue: aBlock
- ! !
- !BlockSequenceNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretBlockSequenceNode: self continue: aBlock
- ! !
- !ValueNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretValueNode: self continue: aBlock
- ! !
- !VariableNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretVariableNode: self continue: aBlock
- ! !
- !ClassReferenceNode methodsFor: '*Compiler-Interpreter'!
- interpreter: anInterpreter continue: aBlock
- ^ anInterpreter interpretClassReferenceNode: self continue: aBlock
- ! !
|