API Improvement and Refactoring

src/Sindarin-Scripts/SindarinDebugger.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #SindarinDebugger }
+
+{ #category : #'*Sindarin-Scripts' }
+SindarinDebugger >> run: aSindarinScript [
+
+	aSindarinScript executeWith: self
+]

src/Sindarin-Scripts/TSindarin.extension.st

@@ -0,0 +1,21 @@
+Extension { #name : #TSindarin }
+
+{ #category : #'*Sindarin-Scripts' }
+TSindarin classSide >> debugSessionWithScript: aDebugSession [
+
+	| debugger exception sindarinPointCutExceptionClass |
+	debugger := self debugSession: aDebugSession.
+
+	exception := aDebugSession exception.
+	sindarinPointCutExceptionClass := Smalltalk at: #SindarinPointcutException ifAbsent:[nil].
+	exception class == sindarinPointCutExceptionClass ifFalse: [ 
+		aDebugSession resume; clear.
+		^ self ].
+
+	"Stepping to return to the context requesting the execution of a Sindarin script"
+	debugger step.
+	debugger step.
+	exception script executeWith: debugger.
+	aDebugSession resume; clear; terminate
+
+]

src/Sindarin-Tests/SindarinDebuggerTest.class.st

@@ -487,6 +487,18 @@ SindarinDebuggerTest >> testIsAboutToInstantiateClass [
 
 ]
 
+{ #category : #tests }
+SindarinDebuggerTest >> testIsAssignment [
+
+	| scdbg |
+	scdbg := SindarinDebugger debug: [ self methodWithOneAssignment ].
+	self deny: scdbg isAssignment.
+	scdbg step.
+	self assert: scdbg isAssignment.
+	scdbg step.
+	self deny: scdbg isAssignment
+]
+
 { #category : #tests }
 SindarinDebuggerTest >> testIsExecutionFinished [
 
@@ -499,6 +511,26 @@ SindarinDebuggerTest >> testIsExecutionFinished [
 	self assert: scdbg currentProcess isTerminated
 ]
 
+{ #category : #tests }
+SindarinDebuggerTest >> testIsMessageSend [
+
+	| scdbg |
+	scdbg := SindarinDebugger debug: [ self methodWithOneAssignment ].
+	self assert: scdbg isMessageSend.
+	scdbg step.
+	self deny: scdbg isMessageSend.
+	scdbg step.
+	self assert: scdbg isMessageSend
+]
+
+{ #category : #tests }
+SindarinDebuggerTest >> testMessage [
+
+	| scdbg |
+	scdbg := SindarinDebugger debug: [ self methodWithOneAssignment ].
+	self assert: (scdbg message: #methodWithOneAssignment)
+]
+
 { #category : #tests }
 SindarinDebuggerTest >> testMessageArguments [
 	| scdbg |

src/Sindarin/SindarinDebugger.class.st

@@ -25,17 +25,17 @@ Class {
 { #category : #stackAccessHelpers }
 SindarinDebugger >> assignmentValue [
 	"Returns the value about to be assigned, if the current node is an assignment node. Otherwise, returns nil"
-
-	self node isAssignment ifFalse: [
+	self flag: 'Why there is no error raised here, while for the case of message sends there is an error?'.
+	self isAssignment ifFalse: [
 		^ nil "Error signal: 'Not about to perform a assignment'" ].
 	^ self context at: self currentContextStackSize
 ]
 
 { #category : #stackAccessHelpers }
 SindarinDebugger >> assignmentVariableName [
 	"Returns the variable name about to be assigned to, if the current node is an assignment node. Otherwise, returns nil"
-
-	self node isAssignment ifFalse: [
+	self flag: 'Why there is no error raised in the case of assignemnts, while there is one for message sends?'.
+	self isAssignment ifFalse: [
 		^ nil "Error signal: 'Not about to perform a assignment'" ].
 	^ self node variable name
 ]
@@ -70,14 +70,13 @@ SindarinDebugger >> contextIsAboutToSignalException: aContext [
 
 	| node |
 	node := self node.
-	node isMessage ifFalse: [ ^ false ].
+	self isMessageSend ifFalse: [ ^ false ].
 	(#( #signal #signalIn: ) includes: node selector) ifFalse: [ ^ false ].
 	aContext basicSize >= 1 ifFalse: [ ^ false ].
 	(Exception allSubclasses includes: (aContext at: aContext basicSize))
 		ifTrue: [ ^ true ]. "#signal sent to a subclass of Exception"
-	(Exception allSubclasses includes:
-		 (aContext at: aContext basicSize) class) ifTrue: [ ^ true ]. "#signal sent to an instance of a subclass of Exception"
-	^ false
+	^(Exception allSubclasses includes: (aContext at: aContext basicSize) class) "#signal sent to an instance of a subclass of Exception"
+
 ]
 
 { #category : #'stepping - auto' }
@@ -108,7 +107,7 @@ SindarinDebugger >> hasSignalledUnhandledException [
 SindarinDebugger >> isAboutToInstantiateClass [
 
 	| methodAboutToExecute |
-	self node isMessage ifFalse: [ ^ false ].
+	self isMessageSend ifFalse: [ ^ false ].
 	methodAboutToExecute := self receiver class lookupSelector:
 		                        self node selector.
 	^ methodAboutToExecute notNil and: [ 
@@ -144,9 +143,7 @@ SindarinDebugger >> jumpIntoBlock: aBlockNode toNode: targetNode [
 SindarinDebugger >> message: aSelector [
 	"Returns whether the execution is about to send a message of selector @aSelector to any object"
 
-	[ ^ self messageSelector = aSelector ]
-		on: Error
-		do: [ ^ false ]
+	^ self isMessageSend and: [ self messageSelector = aSelector ]
 ]
 
 { #category : #stackAccessHelpers }
@@ -162,21 +159,17 @@ SindarinDebugger >> message: aSelector toInstanceOf: aClass [
 
 	| node |
 	node := self node.
-	node isMessage
-		ifFalse: [ ^ false ].
-	node selector = aSelector
-		ifFalse: [ ^ false ].
-	(self messageReceiver isKindOf: aClass)
-		ifFalse: [ ^ false ].
-	^ true
+	self isMessageSend ifFalse: [ ^ false ].
+	node selector = aSelector ifFalse: [ ^ false ].
+	^ self messageReceiver isKindOf: aClass
 ]
 
 { #category : #stackAccessHelpers }
 SindarinDebugger >> messageArguments [
 	"Returns the arguments of the message about to be sent, if the current node is a message node."
 
 	| argumentNumber arguments i |
-	self node isMessage ifFalse: [
+	self isMessageSend ifFalse: [
 		Error signal: 'Not about to send a message' ].
 	argumentNumber := self node arguments size.
 	arguments := OrderedCollection new.
@@ -192,7 +185,7 @@ SindarinDebugger >> messageArguments [
 SindarinDebugger >> messageReceiver [
 	"Returns the receiver of the message about to be sent, if the current node is a message node."
 
-	self node isMessage
+	self isMessageSend
 		ifFalse: [ Error signal: 'Not about to send a message' ].
 	^ self context
 		at: self currentContextStackSize - self node arguments size
@@ -202,7 +195,7 @@ SindarinDebugger >> messageReceiver [
 SindarinDebugger >> messageSelector [
 	"Returns the selector of the message about to be sent, if the current node is a message node."
 
-	self node isMessage
+	self isMessageSend
 		ifFalse: [ Error signal: 'Not about to send a message' ].
 	^ self node selector
 ]
@@ -280,19 +273,13 @@ SindarinDebugger >> proceed [
 	^ self continue
 ]
 
-{ #category : #scripts }
-SindarinDebugger >> run: aSindarinScript [
-
-	aSindarinScript executeWith: self
-]
-
 { #category : #asserting }
 SindarinDebugger >> shouldStepIntoInMethod: aRBMethodNode [
 	"used by #stpeToReturn to know if it should stepInto or stepOver. It should stepInto to get to non-local returns"
 
 	| messageNode childrenOfMessageNode |
 	messageNode := self node.
-	messageNode isMessage ifFalse: [ ^ false ].
+	self isMessageSend ifFalse: [ ^ false ].
 	childrenOfMessageNode := messageNode children.
 	childrenOfMessageNode := childrenOfMessageNode
 		                         select: [ :child |
@@ -488,13 +475,12 @@ SindarinDebugger >> skipWith: replacementValue [
 
 	"If the current node is a message send or assignment"
 
-	(self node isMessage not
-		and: [ self node isAssignment not ])
-		ifTrue: [ ^ self ].
-	self node isMessage
-		ifTrue: [ ^ self skipMessageNodeWith: replacementValue ].
-	self node isAssignment
-		ifTrue: [ ^	self skipAssignmentNodeWith: replacementValue ]
+	(self isMessageSend not and: [ self isAssignment not ]) ifTrue: [
+		^ self ].
+	self node isMessage ifTrue: [
+		^ self skipMessageNodeWith: replacementValue ].
+	self node isAssignment ifTrue: [
+		^ self skipAssignmentNodeWith: replacementValue ]
 ]
 
 { #category : #'ast manipulation' }

src/Sindarin/TSindarin.trait.st

@@ -35,24 +35,10 @@ TSindarin classSide >> debug: aBlock [
 { #category : #'instance creation' }
 TSindarin classSide >> debugSession: aDebugSession [
 
-	| debugger exception sindarinPointCutExceptionClass |
-	debugger := self attachTo: aDebugSession.
-
-	exception := aDebugSession exception.
-	sindarinPointCutExceptionClass := Smalltalk at: #SindarinPointcutException ifAbsent:[nil].
-	exception class == sindarinPointCutExceptionClass ifFalse: [ 
-		aDebugSession resume; clear.
-		^ self ].
-
-	"Stepping to return to the context requesting the execution of a Sindarin script"
-	debugger step.
-	debugger step.
-	exception script executeWith: debugger.
-	aDebugSession resume; clear; terminate
-
+	^ self attachTo: aDebugSession
 ]
 
-{ #category : #stackAccessHelpers }
+{ #category : #'stack access - helpers' }
 TSindarin >> arguments [
 	"Returns the arguments of the current stack-frame."
 
@@ -93,7 +79,7 @@ TSindarin >> cleanStack [
 		self context pop ]
 ]
 
-{ #category : #stackAccess }
+{ #category : #'stack access' }
 TSindarin >> context [
 	"Returns a reification of the current stack-frame."
 
@@ -151,14 +137,24 @@ TSindarin >> instructionStream [
 	^ self context instructionStream
 ]
 
-{ #category : #stackAccess }
+{ #category : #'stack access - testing' }
+TSindarin >> isAssignment [
+	^self node isAssignment 
+]
+
+{ #category : #'stack access' }
 TSindarin >> isExecutionFinished [
 	"Returns whether the debugged execution is finished"
 
 	^ process isTerminated
 ]
 
-{ #category : #stackAccessHelpers }
+{ #category : #'stack access - testing' }
+TSindarin >> isMessageSend [
+	^self node isMessage
+]
+
+{ #category : #'stack access - helpers' }
 TSindarin >> method [
 	"Returns the method of the current stack-frame."
 
@@ -207,13 +203,13 @@ TSindarin >> pc [
 	^ self context pc
 ]
 
-{ #category : #stackAccessHelpers }
+{ #category : #'stack access - helpers' }
 TSindarin >> readVariableNamed: aSymbol [
 
 	^ self context readVariableNamed: aSymbol
 ]
 
-{ #category : #stackAccessHelpers }
+{ #category : #'stack access - helpers' }
 TSindarin >> receiver [
 	"Returns the receiver of the current stack-frame."
 
@@ -234,7 +230,7 @@ TSindarin >> resume [
 	sindarinSession resumeAndClear
 ]
 
-{ #category : #stackAccessHelpers }
+{ #category : #'stack access - helpers' }
 TSindarin >> selector [
 	"Returns the selector of the current stack-frame."
 
@@ -255,7 +251,7 @@ TSindarin >> skipPcToNextBytecode [
 	self context pc: self context pc + currentBytecode bytes size
 ]
 
-{ #category : #stackAccess }
+{ #category : #'stack access' }
 TSindarin >> stack [
 	"Returns a list of context objects representing the current call stack."
 
@@ -274,7 +270,7 @@ TSindarin >> terminate [
 	sindarinSession terminate
 ]
 
-{ #category : #stackAccessHelpers }
+{ #category : #'stack access - helpers' }
 TSindarin >> topStack [
 
 	^ self context top