Add extensions and tooling to support transient, invariant and non-pe…

…rsistent GS64 options in Tonel
ba-st · Apr 3, 2024 · a0748df · a0748df
1 parent de082b1
commit a0748df
Show file tree

Hide file tree

Showing 8 changed files with 79 additions and 23 deletions.
diff --git a/source/Buoy-Development-Tools/Namespace.extension.st b/source/Buoy-Development-Tools/Namespace.extension.st
@@ -1,20 +1,20 @@
-Extension { #name : #Namespace }
+Extension { #name : 'Namespace' }
 
-{ #category : #'*Buoy-Development-Tools' }
+{ #category : '*Buoy-Development-Tools' }
 Namespace >> gtInspectorItemsIn: composite [
 
 	<gtInspectorPresentationOrder: 0>
 	^ bindings gtInspectorItemsIn: composite
 ]
 
-{ #category : #'*Buoy-Development-Tools' }
+{ #category : '*Buoy-Development-Tools' }
 Namespace >> inspectionItems: builder [
 
 	<inspectorPresentationOrder: 0 title: 'Items'>
 	^ bindings inspectionItems: builder
 ]
 
-{ #category : #'*Buoy-Development-Tools' }
+{ #category : '*Buoy-Development-Tools' }
 Namespace >> spotterForKeysFor: aStep [
 
 	<spotterOrder: 15>

diff --git a/source/Buoy-Development-Tools/TonelWriterV3.extension.st b/source/Buoy-Development-Tools/TonelWriterV3.extension.st
@@ -0,0 +1,26 @@
+Extension { #name : 'TonelWriterV3' }
+
+{ #category : '*Buoy-Development-Tools' }
+TonelWriterV3 >> typeClassDefinitionOf: aClassDefinition [
+
+	| definition |
+	definition := OrderedDictionary new.
+	self
+		at: #name put: aClassDefinition className in: definition;
+		at: #superclass put: aClassDefinition superclassName in: definition.
+	aClassDefinition type = #normal ifFalse: [ self at: #type put: aClassDefinition type in: definition ].
+	aClassDefinition hasTraitComposition ifTrue: [ definition at: #traits put: aClassDefinition traitCompositionString ].
+	aClassDefinition hasClassTraitComposition ifTrue: [ definition at: #classTraits put: aClassDefinition classTraitCompositionString ].
+	aClassDefinition instVarNames ifNotEmpty: [ :vars | definition at: #instVars put: vars asArray ].
+	(aClassDefinition variables
+		 select: #isClassVariable
+		 thenCollect: #name) ifNotEmpty: [ :vars | definition at: #classVars put: vars asArray ].
+	(aClassDefinition variables
+		 select: #isPoolImport
+		 thenCollect: #name) ifNotEmpty: [ :vars | definition at: #pools put: vars asArray ].
+	aClassDefinition classInstVarNames ifNotEmpty: [ :vars | definition at: #classInstVars put: vars asArray ].
+	self setPackageInfoOf: aClassDefinition in: definition.
+	"Write gs_options if available as class properties"
+	(aClassDefinition actualClass propertyAt: #gs_options) ifNotNil: [ :options | definition at: #gs_options put: options ].
+	^ self toSTON: definition
+]
diff --git a/source/Buoy-Development-Tools/package.st b/source/Buoy-Development-Tools/package.st
@@ -1 +1 @@
-Package { #name : #'Buoy-Development-Tools' }
+Package { #name : 'Buoy-Development-Tools' }
diff --git a/source/Buoy-Metaprogramming-Pharo-Extensions/Behavior.extension.st b/source/Buoy-Metaprogramming-Pharo-Extensions/Behavior.extension.st
@@ -1,6 +1,6 @@
-Extension { #name : #Behavior }
+Extension { #name : 'Behavior' }
 
-{ #category : #'*Buoy-Metaprogramming-Pharo-Extensions' }
+{ #category : '*Buoy-Metaprogramming-Pharo-Extensions' }
 Behavior >> allLeafSubclasses [
 
 	| leafs |
@@ -9,3 +9,32 @@ Behavior >> allLeafSubclasses [
 	self allSubclassesDo: [ :class | class subclasses ifEmpty: [ leafs add: class ] ].
 	^ leafs
 ]
+
+{ #category : '*Buoy-Metaprogramming-Pharo-Extensions' }
+Behavior >> makeInstancesDbTransient [
+	"In GS64 instances of classes that are DbTransient can be committed — that is, there is no error if they are committed — 
+	but their instance variables are not written to disk.
+
+	These properties are written later by our version of the TonelWriterV3"
+
+	self propertyAt: #gs_options put: #( 'dbTransient' )
+]
+
+{ #category : '*Buoy-Metaprogramming-Pharo-Extensions' }
+Behavior >> makeInstancesInvariant [
+	"In GS64 instances of this class will be made invariant as soon as they are committed.
+
+	These properties are written later by our version of the TonelWriterV3"
+
+	self propertyAt: #gs_options put: #( 'instancesInvariant' )
+]
+
+{ #category : '*Buoy-Metaprogramming-Pharo-Extensions' }
+Behavior >> makeInstancesNonPersistent [
+	"In GS64 instances of this class cannot be committed, so you cannot include references to
+	instances of non-persistent classes within a persistent data structure.
+
+	These properties are written later by our version of the TonelWriterV3"
+
+	self propertyAt: #gs_options put: #( 'instancesNonPersistent' )
+]
diff --git a/source/Buoy-Metaprogramming-Pharo-Extensions/OSPlatform.extension.st b/source/Buoy-Metaprogramming-Pharo-Extensions/OSPlatform.extension.st
@@ -1,6 +1,6 @@
-Extension { #name : #OSPlatform }
+Extension { #name : 'OSPlatform' }
 
-{ #category : #'*Buoy-Metaprogramming-Pharo-Extensions' }
+{ #category : '*Buoy-Metaprogramming-Pharo-Extensions' }
 OSPlatform >> environmentAt: aVariableName ifPresent: aBlock ifAbsent: anAbsentBlock [
 
 	^ self environment
@@ -9,13 +9,13 @@ OSPlatform >> environmentAt: aVariableName ifPresent: aBlock ifAbsent: anAbsentB
 		  ifAbsent: anAbsentBlock
 ]
 
-{ #category : #'*Buoy-Metaprogramming-Pharo-Extensions' }
+{ #category : '*Buoy-Metaprogramming-Pharo-Extensions' }
 OSPlatform >> environmentAt: variableName put: value [
 
 	self environment at: variableName put: value
 ]
 
-{ #category : #'*Buoy-Metaprogramming-Pharo-Extensions' }
+{ #category : '*Buoy-Metaprogramming-Pharo-Extensions' }
 OSPlatform >> removeEnvironmentKey: variableName [
 
 	self environment removeKey: variableName

diff --git a/source/Buoy-Metaprogramming-Pharo-Extensions/PharoPlatform.class.st b/source/Buoy-Metaprogramming-Pharo-Extensions/PharoPlatform.class.st
@@ -1,41 +1,42 @@
 Class {
-	#name : #PharoPlatform,
-	#superclass : #LanguagePlatform,
-	#category : #'Buoy-Metaprogramming-Pharo-Extensions'
+	#name : 'PharoPlatform',
+	#superclass : 'LanguagePlatform',
+	#category : 'Buoy-Metaprogramming-Pharo-Extensions',
+	#package : 'Buoy-Metaprogramming-Pharo-Extensions'
 }
 
-{ #category : #'class initialization' }
+{ #category : 'class initialization' }
 PharoPlatform class >> initialize [
 
 	<ignoreForCoverage>
 	LanguagePlatform setCurrentTo: self new
 ]
 
-{ #category : #reflection }
+{ #category : 'reflection' }
 PharoPlatform >> atInstanceVariableNamed: name on: object put: value [
 
 	object instVarNamed: name put: value
 ]
 
-{ #category : #'process scheduling' }
+{ #category : 'process scheduling' }
 PharoPlatform >> fork: block named: processName at: priority [
 
 	^ block forkAt: priority named: processName
 ]
 
-{ #category : #reflection }
+{ #category : 'reflection' }
 PharoPlatform >> globalNamed: aSymbol ifAbsent: absentBlock [
 
 	^ Smalltalk globals at: aSymbol ifAbsent: absentBlock
 ]
 
-{ #category : #reflection }
+{ #category : 'reflection' }
 PharoPlatform >> includesGlobalNamed: aSymbol [
 
 	^ Smalltalk globals includesKey: aSymbol
 ]
 
-{ #category : #accessing }
+{ #category : 'accessing' }
 PharoPlatform >> os [
 
 	^ OSPlatform current

diff --git a/source/Buoy-Metaprogramming-Pharo-Extensions/Symbol.extension.st b/source/Buoy-Metaprogramming-Pharo-Extensions/Symbol.extension.st
@@ -1,6 +1,6 @@
-Extension { #name : #Symbol }
+Extension { #name : 'Symbol' }
 
-{ #category : #'*Buoy-Metaprogramming-Pharo-Extensions' }
+{ #category : '*Buoy-Metaprogramming-Pharo-Extensions' }
 Symbol >> argumentCount [
 
 	^self numArgs

diff --git a/source/Buoy-Metaprogramming-Pharo-Extensions/package.st b/source/Buoy-Metaprogramming-Pharo-Extensions/package.st
@@ -1 +1 @@
-Package { #name : #'Buoy-Metaprogramming-Pharo-Extensions' }
+Package { #name : 'Buoy-Metaprogramming-Pharo-Extensions' }