Integrate interop source location APIs

- Add interop messages and ForeignObject>>#getSource - Display members and source if available in PolyglotInspector
hpi-swa · Jul 21, 2020 · 458ebee · 458ebee
1 parent 4106a02
commit 458ebee
Show file tree

Hide file tree

Showing 23 changed files with 111 additions and 37 deletions.
diff --git a/src/TruffleSqueak-Core.package/ForeignObject.class/instance/getSource.st b/src/TruffleSqueak-Core.package/ForeignObject.class/instance/getSource.st
@@ -0,0 +1,5 @@
+source code management
+getSource
+	^ (Interop hasSourceLocation: self)
+		ifFalse: [ nil ]
+		ifTrue: [ (Interop getSourceLocation: self) getCharacters asString ]
diff --git a/src/TruffleSqueak-Core.package/ForeignObject.class/methodProperties.json b/src/TruffleSqueak-Core.package/ForeignObject.class/methodProperties.json
@@ -42,6 +42,7 @@
 		"doesNotUnderstand:" : "fn 8/2/2019 17:02",
 		"explorableMembers" : "fn 4/13/2019 22:49",
 		"explorerContents" : "fn 11/11/2019 22:14",
+		"getSource" : "fn 7/17/2020 15:22",
 		"hasContentsInExplorer" : "fn 4/13/2019 22:50",
 		"hash" : "fn 11/11/2019 22:13",
 		"identityHash" : "fn 5/29/2020 16:19",

diff --git a/src/TruffleSqueak-Core.package/Interop.class/class/getSourceLocation..st b/src/TruffleSqueak-Core.package/Interop.class/class/getSourceLocation..st
@@ -0,0 +1,6 @@
+primitives meta-data
+getSourceLocation: anObject
+	<primitive: 'primitiveGetSourceLocation' module: 'PolyglotPlugin'>
+	(self hasSourceLocation: anObject)
+		ifFalse: [ self error: 'Object has no source location' ]
+		ifTrue: [ self primitiveFailed ]
diff --git a/src/TruffleSqueak-Core.package/Interop.class/class/hasSourceLocation..st b/src/TruffleSqueak-Core.package/Interop.class/class/hasSourceLocation..st
@@ -0,0 +1,4 @@
+primitives meta-data
+hasSourceLocation: anObject
+	<primitive: 'primitiveHasSourceLocation' module: 'PolyglotPlugin'>
+	self primitiveFailed
diff --git a/src/TruffleSqueak-Core.package/Interop.class/methodProperties.json b/src/TruffleSqueak-Core.package/Interop.class/methodProperties.json
@@ -22,12 +22,14 @@
 		"getMetaObject:" : "fn 5/6/2020 14:48",
 		"getMetaQualifiedName:" : "fn 5/6/2020 14:50",
 		"getMetaSimpleName:" : "fn 5/6/2020 14:50",
+		"getSourceLocation:" : "fn 7/12/2020 23:04",
 		"hasArrayElements:" : "fn 11/11/2019 21:59",
 		"hasLanguage:" : "fn 5/6/2020 14:48",
 		"hasMemberReadSideEffects:member:" : "fn 11/11/2019 21:59",
 		"hasMemberWriteSideEffects:member:" : "fn 11/11/2019 21:59",
 		"hasMembers:" : "fn 12/3/2019 11:43",
 		"hasMetaObject:" : "fn 5/6/2020 14:50",
+		"hasSourceLocation:" : "fn 7/12/2020 23:04",
 		"identityHash:" : "fn 12/3/2019 11:43",
 		"instantiate:with:" : "fn 12/3/2019 11:44",
 		"invokeMember:member:arguments:" : "fn 12/3/2019 11:46",

diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/aboutToStyle..st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/aboutToStyle..st
@@ -1,4 +1,4 @@
-overrides
+morphic ui
 aboutToStyle: aStyler
 	"Do not use styler for now"
 	^true
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/arrayFieldList.st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/arrayFieldList.st
@@ -0,0 +1,10 @@
+accessing
+arrayFieldList
+	^ (Interop hasArrayElements: object)
+			ifFalse: [#()]
+			ifTrue: [
+				(object basicSize <= (self i1 + self i2)
+				ifTrue: [(1 to: object basicSize)
+					collect: [:i | i printString]]
+				ifFalse: [(1 to: self i1) , (object basicSize-(self i2-1) to: object basicSize)
+					collect: [:i | i printString]])]
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/baseFieldList.st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/baseFieldList.st
@@ -1,6 +1,4 @@
-overrides
+accessing
 baseFieldList
-	"Answer an Array consisting of 'self'
-	and the members of the inspected object."
 
-	^ Array with: 'self' with: 'members'
+	^ #('self')
diff --git a/...ffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/calculateOptionalFields.st b/...ffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/calculateOptionalFields.st
@@ -0,0 +1,5 @@
+selecting
+calculateOptionalFields
+	optionalFields := #().
+	(self hasMembers: object) ifTrue: [ optionalFields := optionalFields, #('members') ].
+	(Interop hasSourceLocation: object) ifTrue: [ optionalFields := optionalFields, #('source') ]
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/contentsIsString.st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/contentsIsString.st
@@ -0,0 +1,4 @@
+selecting
+contentsIsString
+
+	^ (selectionIndex = 0) | (selectionIndex between: 2 and: (1 + self optionalFieldList size))
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/exploreObject.st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/exploreObject.st
@@ -1,4 +1,4 @@
-overrides
+toolbuilder
 exploreObject
 	"Switch to an explorer tool."
 

diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/fieldList.st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/fieldList.st
@@ -1,11 +1,4 @@
-overrides
+accessing
 fieldList
-	"Answer the base field list plus an abbreviated list of indices."
 
-	(Interop hasArrayElements: object) ifFalse: [^ self baseFieldList].
-	^ self baseFieldList ,
-		(object basicSize <= (self i1 + self i2)
-			ifTrue: [(1 to: object basicSize)
-						collect: [:i | i printString]]
-			ifFalse: [(1 to: self i1) , (object basicSize-(self i2-1) to: object basicSize)
-						collect: [:i | i printString]])
+	^ self baseFieldList, self optionalFieldList, self arrayFieldList
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/getMemberList..st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/getMemberList..st
@@ -0,0 +1,11 @@
+helpers
+getMemberList: anObject
+	^ String streamContents: [:aStream |
+		(Interop getMembers: anObject) sorted doWithIndex:
+			[ :member :index |
+			aStream nextPutAll: member;
+			nextPut: $:;
+		 	space;
+		 	tab.
+			(Interop readMember: anObject member: member) printOn: aStream.
+		 	aStream cr ] ]
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/getSource..st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/getSource..st
@@ -0,0 +1,5 @@
+helpers
+getSource: anObject
+	^ (Interop hasSourceLocation: anObject)
+		ifTrue: [ (Interop getSourceLocation: anObject) getCharacters asString ]
+		ifFalse: [ 'object has no source location' ].
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/hasMembers..st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/hasMembers..st
@@ -0,0 +1,3 @@
+helpers
+hasMembers: anObject
+	^ (Interop hasMembers: anObject) and: [ (Interop getMemberSize: anObject) > 0 ]
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/initialize.st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/initialize.st
@@ -0,0 +1,4 @@
+initialize-release
+initialize
+	super initialize.
+	self calculateOptionalFields
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/inspect..st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/inspect..st
@@ -1,4 +1,4 @@
-overrides
+initialize-release
 inspect: anObject 
 	"Initialize the receiver so that it is inspecting anObject. There is no current selection."
 

diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/longPrintStringFor..st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/longPrintStringFor..st
@@ -1,14 +1,5 @@
 helpers
 longPrintStringFor: anObject
-	((Interop hasMembers: anObject) and:
-		[ (Interop getMemberSize: anObject) > 0 ])
-			ifFalse: [ ^ 'object has no members' ].
-	^  String streamContents: [:aStream |
-		(Interop getMembers: anObject) sorted doWithIndex:
-			[ :member :index |
-			aStream nextPutAll: member;
-			nextPut: $:;
-		 	space;
-		 	tab.
-			(Interop readMember: anObject member: member) printOn: aStream.
-		 	aStream cr ] ]
+	^ (self hasMembers: anObject)
+		ifTrue: [ self getMemberList: anObject ]
+		ifFalse: [ 'object has no members' ]
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/mainFieldListMenu..st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/mainFieldListMenu..st
@@ -0,0 +1,18 @@
+menu commands
+mainFieldListMenu: aMenu
+	"Arm the supplied menu with items for the field-list of the receiver"
+
+	aMenu addStayUpItemSpecial.
+
+	aMenu addList: #(
+		('inspect (i)'						inspectSelection)
+		('explore (I)'						exploreSelection)).
+
+	self addCollectionItemsTo: aMenu.
+
+	aMenu addList: #(
+		-
+		('copy name (c)'					copyName)		
+		('basic inspect'						inspectBasic)).
+
+	^ aMenu
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/optionalFieldList.st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/optionalFieldList.st
@@ -0,0 +1,3 @@
+accessing
+optionalFieldList
+	^ optionalFields
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/selection.st b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/instance/selection.st
@@ -1,12 +1,13 @@
-overrides
+selecting
 selection
 	"The receiver has a list of variables of its inspected object.
 	One of these is selected. Answer the value of the selected variable."
 	| basicIndex |
 	selectionIndex = 0 ifTrue: [^ ''].
 	selectionIndex = 1 ifTrue: [^ object].
-	selectionIndex = 2 ifTrue: [^ self longPrintStringFor: object].
-	basicIndex := selectionIndex - 2.
-	(object basicSize <= (self i1 + self i2)  or: [basicIndex <= self i1])
+	selectionIndex = (1 + (self optionalFieldList indexOf: 'members')) ifTrue: [^ self longPrintStringFor: object].
+	selectionIndex = (1 + (self optionalFieldList indexOf: 'source')) ifTrue: [^ self getSource: object].
+	basicIndex := selectionIndex - 1 - self optionalFieldList size.
+	(object basicSize <= (self i1 + self i2) or: [basicIndex <= self i1])
 		ifTrue: [^ object basicAt: basicIndex]
 		ifFalse: [^ object basicAt: object basicSize - (self i1 + self i2) + basicIndex]
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/methodProperties.json b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/methodProperties.json
@@ -3,9 +3,18 @@
 		 },
 	"instance" : {
 		"aboutToStyle:" : "fn 12/5/2018 19:14",
-		"baseFieldList" : "fn 2/9/2020 21:02",
+		"arrayFieldList" : "fn 7/17/2020 15:50",
+		"baseFieldList" : "fn 7/17/2020 15:46",
+		"calculateOptionalFields" : "fn 7/17/2020 16:16",
+		"contentsIsString" : "fn 7/17/2020 15:57",
 		"exploreObject" : "fn 3/3/2020 16:55",
-		"fieldList" : "fn 11/11/2019 22:12",
+		"fieldList" : "fn 7/17/2020 15:51",
+		"getMemberList:" : "fn 7/17/2020 16:12",
+		"getSource:" : "fn 7/17/2020 15:22",
+		"hasMembers:" : "fn 7/17/2020 16:16",
+		"initialize" : "fn 7/17/2020 15:52",
 		"inspect:" : "fn 11/21/2019 15:47",
-		"longPrintStringFor:" : "fn 2/10/2020 15:47",
-		"selection" : "fn 2/9/2020 21:05" } }
+		"longPrintStringFor:" : "fn 7/17/2020 16:16",
+		"mainFieldListMenu:" : "fn 7/17/2020 15:36",
+		"optionalFieldList" : "fn 7/17/2020 15:53",
+		"selection" : "fn 7/17/2020 16:04" } }
diff --git a/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/properties.json b/src/TruffleSqueak-Tools-Core.package/PolyglotInspector.class/properties.json
@@ -6,7 +6,8 @@
 		 ],
 	"commentStamp" : "",
 	"instvars" : [
-		"languageID" ],
+		"languageID",
+		"optionalFields" ],
 	"name" : "PolyglotInspector",
 	"pools" : [
 		 ],