add smalltalk packages and trace serializer

.project

@@ -0,0 +1,3 @@
+{
+	'srcDirectory' : 'packages'
+}

.squot

@@ -0,0 +1,4 @@
+OrderedDictionary {
+	'packages/BaselineOfTrace4D.package' : #SquotCypressCodeSerializer,
+	'packages/Trace4D.package' : #SquotCypressCodeSerializer
+}

packages/BaselineOfTrace4D.package/.filetree

@@ -0,0 +1,4 @@
+{
+	"noMethodMetaData" : true,
+	"separateMethodMetaAndSource" : false,
+	"useCypressPropertiesFile" : true }

packages/BaselineOfTrace4D.package/.squot-contents

@@ -0,0 +1,6 @@
+SquotTrackedObjectMetadata {
+	#objectClassName : #PackageInfo,
+	#id : UUID [ '09c330835f4dcf498290c4053f7a0de1' ],
+	#objectsReplacedByNames : true,
+	#serializer : #SquotCypressCodeSerializer
+}

packages/BaselineOfTrace4D.package/BaselineOfTrace4D.class/instance/baseline..st

@@ -0,0 +1,20 @@
+baseline
+baseline: spec
+	<baseline>
+
+	spec for: #common do: [
+		"dependencies"
+		spec
+			baseline: 'TraceDebugger' with: [
+				spec
+					repository: 'github://hpi-swa-lab/squeak-tracedebugger';
+					loads: 'TraceDebugger']].
+
+		"packages"
+		spec
+			package: 'Trace4D' with: [
+				spec requires: 'TraceDebugger'].
+
+		"groups"
+		spec
+			group: #default with: #('Trace4D').

packages/BaselineOfTrace4D.package/BaselineOfTrace4D.class/instance/projectClass.st

@@ -0,0 +1,4 @@
+accessing
+projectClass
+
+	^ MetacelloCypressBaselineProject

packages/BaselineOfTrace4D.package/BaselineOfTrace4D.class/methodProperties.json

@@ -0,0 +1,6 @@
+{
+	"class" : {
+		 },
+	"instance" : {
+		"baseline:" : "ct 5/27/2023 01:26",
+		"projectClass" : "ct 5/27/2023 01:23" } }

packages/BaselineOfTrace4D.package/BaselineOfTrace4D.class/properties.json

@@ -0,0 +1,14 @@
+{
+	"category" : "BaselineOfTrace4D",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "",
+	"instvars" : [
+		 ],
+	"name" : "BaselineOfTrace4D",
+	"pools" : [
+		 ],
+	"super" : "BaselineOf",
+	"type" : "normal" }

packages/BaselineOfTrace4D.package/monticello.meta/categories.st

@@ -0,0 +1 @@
+SystemOrganization addCategory: #BaselineOfTrace4D!

packages/BaselineOfTrace4D.package/properties.json

@@ -0,0 +1,2 @@
+{
+	 }

packages/Trace4D.package/.filetree

@@ -0,0 +1,4 @@
+{
+	"noMethodMetaData" : true,
+	"separateMethodMetaAndSource" : false,
+	"useCypressPropertiesFile" : true }

packages/Trace4D.package/.squot-contents

@@ -0,0 +1,6 @@
+SquotTrackedObjectMetadata {
+	#objectClassName : #PackageInfo,
+	#id : UUID [ 'd6cbd64ac6ce3a4396ba426e0334d4f9' ],
+	#objectsReplacedByNames : true,
+	#serializer : #SquotCypressCodeSerializer
+}

packages/Trace4D.package/T4DTrace.class/class/cursorClass.st

@@ -0,0 +1,4 @@
+accessing
+cursorClass
+
+	^ TDBCursor

packages/Trace4D.package/T4DTrace.class/class/forBlock..st

@@ -0,0 +1,5 @@
+instance creation
+forBlock: aBlock
+
+	^ self forCursor:
+		(self cursorClass traceForBlock: aBlock)

packages/Trace4D.package/T4DTrace.class/class/forCursor..st

@@ -0,0 +1,4 @@
+instance creation
+forCursor: aTDBCursor
+
+	^ self new cursor: aTDBCursor

packages/Trace4D.package/T4DTrace.class/instance/buildClasses.st

@@ -0,0 +1,12 @@
+building
+buildClasses
+
+	| classes |
+	classes := self makeContainer.
+	classNames keysAndValuesDo: [:class :name |
+		classes at: name put:
+			(self makeContainer
+				category: class category;
+				package: (class packageInfo ifNotNil: [:package | package name]);
+				yourself)].
+	^ classes

packages/Trace4D.package/T4DTrace.class/instance/buildFieldHistoryFor.field..st

@@ -0,0 +1,15 @@
+building
+buildFieldHistoryFor: anObject field: field
+
+	| slice |
+	slice := self cursor object: anObject collect: [:object |
+		| value error |
+		[value := field value: object] ifError: [:err | error := err].
+		error
+			ifNotNil: ['<error: {1}>' format: {error}]
+			ifNil: [self idOrStringFor: value]].
+	slice intervals size > 1 ifFalse: [^ nil].
+	^ self makeContainer
+		times: (slice intervals allButLast collect: [:interval | interval stop + 1]);
+		values: (slice values allButLast collect: [:value | value copy tdbproxyYourself]);
+		yourself

packages/Trace4D.package/T4DTrace.class/instance/buildJson.st

@@ -0,0 +1,18 @@
+building
+buildJson
+
+	| trace objects classes |
+	objectIds := PluggableDictionary
+		hashBlock: [:a | a perform: #identityHash]
+		equalBlock: [:a :b | a tdbIdentical: b].
+	classNames := Dictionary new.
+
+	trace := self buildTrace.
+	objects := self buildObjects.
+	classes := self buildClasses.
+
+	^ self makeContainer
+		objects: objects;
+		classes: classes;
+		trace: trace;
+		yourself

packages/Trace4D.package/T4DTrace.class/instance/buildObjectFor..st

@@ -0,0 +1,17 @@
+building
+buildObjectFor: anObject
+
+	| fields |
+	fields := self fieldsFor: anObject.
+	^ self makeContainer
+		class: (self nameForClass: (anObject perform: #class));
+		name: (self stringFor: anObject);
+		fields:
+			(fields
+				collect: [:field | field key -> (self idOrStringFor: (field value value: anObject))]
+				as: self containerClass);
+		historicFields:
+			(fields
+				collect: [:field | field key -> (self buildFieldHistoryFor: anObject field: field value)]
+				as: self containerClass);
+		yourself

packages/Trace4D.package/T4DTrace.class/instance/buildObjects.st

@@ -0,0 +1,10 @@
+building
+buildObjects
+
+	| objects |
+	objects := self makeContainer.
+	objectIds keysAndValuesDo: [:object :id |
+		objects at: id put:
+			(self buildObjectFor:
+				(self cursor object: object atTime: self cursor maxTimeIndex))].
+	^ objects

packages/Trace4D.package/T4DTrace.class/instance/buildTrace.st

@@ -0,0 +1,5 @@
+building
+buildTrace
+
+	^ self buildTraceFor:
+		(self cursor contextAtTime: 0)

packages/Trace4D.package/T4DTrace.class/instance/buildTraceFor..st

@@ -0,0 +1,19 @@
+building
+buildTraceFor: aContext
+
+	| trace |
+	trace := self makeContainer
+		receiver: (self objectIdFor: aContext receiver);
+		message: aContext tdbBlockAndSelectorString;
+		arguments:
+			((aContext arguments collect: [:ea | self idOrStringFor: ea])
+				copy collect: [:ea | ea tdbproxyYourself]) tdbproxyYourself;
+		yourself.
+	self cursor returnValueFor: aContext ifPresent: [:value |
+		trace answer: (self idOrStringFor: value)].
+	trace
+		startTime: (self cursor minTimeIndexFor: aContext);
+		endTime: (self cursor maxTimeIndexFor: aContext);
+		children: ((self cursor childContextsFor: aContext)
+			collect: [:childContext | self buildTraceFor: childContext]).
+	^ trace

packages/Trace4D.package/T4DTrace.class/instance/containerClass.st

@@ -0,0 +1,4 @@
+private
+containerClass
+
+	^ OrderedJsonObject

packages/Trace4D.package/T4DTrace.class/instance/cursor..st

@@ -0,0 +1,4 @@
+accessing
+cursor: aTDBCursor
+
+	cursor := aTDBCursor.

packages/Trace4D.package/T4DTrace.class/instance/cursor.st

@@ -0,0 +1,4 @@
+accessing
+cursor
+
+	^ cursor

packages/Trace4D.package/T4DTrace.class/instance/fieldsFor..st

@@ -0,0 +1,10 @@
+building
+fieldsFor: anObject
+
+	| inspector inspectorFields |
+	inspector := Inspector inspect: anObject.
+	inspectorFields := Array streamContents: [:stream |
+		[inspector streamVariableFieldsOn: stream]
+			ifError: [inspector streamError: #error on: stream]].
+	^ inspectorFields collect: [:inspectorField |
+		inspectorField name asString -> inspectorField valueGetter]

packages/Trace4D.package/T4DTrace.class/instance/idOrStringFor..st

@@ -0,0 +1,8 @@
+building
+idOrStringFor: anObject
+
+	^ objectIds at: anObject ifAbsent:
+		[(self stringFor: anObject) ifNotEmpty: [:string |
+			('@\' includes: string first)
+				ifTrue: [string copyWithFirst: $\]
+				ifFalse: [string]]]

packages/Trace4D.package/T4DTrace.class/instance/makeContainer.st

@@ -0,0 +1,4 @@
+private
+makeContainer
+
+	^ self containerClass new

packages/Trace4D.package/T4DTrace.class/instance/nameForClass..st

@@ -0,0 +1,5 @@
+building
+nameForClass: aClass
+
+	^ classNames at: aClass ifAbsentPut:
+		[aClass name]

packages/Trace4D.package/T4DTrace.class/instance/objectIdFor..st

@@ -0,0 +1,5 @@
+building
+objectIdFor: anObject
+
+	^ objectIds at: anObject ifAbsentPut:
+		['@' , UUID new]

packages/Trace4D.package/T4DTrace.class/instance/storeJsonInFileNamed..st

@@ -0,0 +1,7 @@
+writing
+storeJsonInFileNamed: fileName
+
+	| json |
+	json := self buildJson.
+	FileStream newFileNamed: fileName do: [:stream |
+		json jsonWriteOn: stream].

packages/Trace4D.package/T4DTrace.class/instance/stringFor..st

@@ -0,0 +1,4 @@
+building
+stringFor: anObject
+
+	^ [anObject printString] ifError: [:error | '<printString error: {1}>' format: {error}]

packages/Trace4D.package/T4DTrace.class/methodProperties.json

@@ -0,0 +1,23 @@
+{
+	"class" : {
+		"cursorClass" : "ct 5/26/2023 00:40",
+		"forBlock:" : "ct 5/21/2023 17:39",
+		"forCursor:" : "ct 5/21/2023 17:39" },
+	"instance" : {
+		"buildClasses" : "ct 5/21/2023 18:36",
+		"buildFieldHistoryFor:field:" : "ct 5/26/2023 00:45",
+		"buildJson" : "ct 5/21/2023 18:37",
+		"buildObjectFor:" : "ct 5/27/2023 01:20",
+		"buildObjects" : "ct 5/21/2023 18:48",
+		"buildTrace" : "ct 5/21/2023 18:30",
+		"buildTraceFor:" : "ct 5/21/2023 20:01",
+		"containerClass" : "ct 5/21/2023 18:36",
+		"cursor" : "ct 5/21/2023 17:39",
+		"cursor:" : "ct 5/21/2023 17:39",
+		"fieldsFor:" : "ct 5/21/2023 18:40",
+		"idOrStringFor:" : "ct 5/21/2023 18:54",
+		"makeContainer" : "ct 5/21/2023 18:36",
+		"nameForClass:" : "ct 5/21/2023 19:57",
+		"objectIdFor:" : "ct 5/21/2023 17:53",
+		"storeJsonInFileNamed:" : "ct 5/21/2023 20:05",
+		"stringFor:" : "ct 5/21/2023 18:34" } }

packages/Trace4D.package/T4DTrace.class/properties.json

@@ -0,0 +1,16 @@
+{
+	"category" : "Trace4D",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "",
+	"instvars" : [
+		"cursor",
+		"objectIds",
+		"classNames" ],
+	"name" : "T4DTrace",
+	"pools" : [
+		 ],
+	"super" : "Object",
+	"type" : "normal" }

packages/Trace4D.package/monticello.meta/categories.st

@@ -0,0 +1 @@
+SystemOrganization addCategory: #Trace4D!

packages/Trace4D.package/properties.json

@@ -0,0 +1,2 @@
+{
+	 }