From 9ace94005c6ad16fdd5185f7632930c856db9cb0 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Thu, 17 Aug 2023 11:47:53 +0200 Subject: [PATCH 01/15] Block which opens all methods containing variants --- packages/Sandblocks-Core/SBBlock.class.st | 6 +++ packages/Sandblocks-Core/SBEditor.class.st | 30 +++++++++++ .../Sandblocks-Core/SBExploriants.class.st | 52 +++++++++++++++++++ .../Sandblocks-Smalltalk/SBVariant.class.st | 14 ++++- 4 files changed, 101 insertions(+), 1 deletion(-) create mode 100644 packages/Sandblocks-Core/SBExploriants.class.st diff --git a/packages/Sandblocks-Core/SBBlock.class.st b/packages/Sandblocks-Core/SBBlock.class.st index af75093d..538e1cda 100644 --- a/packages/Sandblocks-Core/SBBlock.class.st +++ b/packages/Sandblocks-Core/SBBlock.class.st @@ -1705,6 +1705,12 @@ SBBlock >> isValidAction: aPragmaOrMethod [ ^ validMode and: [validInvocation] ] +{ #category : #testing } +SBBlock >> isVariant [ + + ^ false +] + { #category : #testing } SBBlock >> isWatch [ diff --git a/packages/Sandblocks-Core/SBEditor.class.st b/packages/Sandblocks-Core/SBEditor.class.st index 3fba9db0..09ada07e 100644 --- a/packages/Sandblocks-Core/SBEditor.class.st +++ b/packages/Sandblocks-Core/SBEditor.class.st @@ -1147,6 +1147,36 @@ SBEditor >> openAll: aCollection [ aCollection do: [:object | self open: object] ] +{ #category : #actions } +SBEditor >> openExploriants [ + + + SBExploriants openIn: self + + "| allCompiledMethodsContainingVariants | + allCompiledMethodsContainingVariants := ((self systemNavigation allCallsOn: #named:associations:activeIndex:) + reject: [:aMethodReference | aMethodReference methodSymbol = #openExploriants]) + collect: #compiledMethod. + + allCompiledMethodsContainingVariants + collect: #asSandblock + thenDo: [:aSBStMethod | + aSBStMethod body allMorphsMutableDo: [:aMorph | aMorph visible: false]. + aSBStMethod containedVariants + do: [:aVariant | |current| + current := aVariant. + [current := current owner] + doWhileFalse: [current = aSBStMethod]. + current submorphsDo: [:m| m visible: true]]. + self openMorphInView: aSBStMethod]." + + "collect: [:aMethodBlock | aMethodBlock allMorphs + select: [:aMorph | aMorph submorphs + ifEmpty: [false] + ifNotEmpty: [(aMorph submorphOfClass: SBVariant) isNil not]]] + thenDo: [:aCollectionOfOwnersOfVariants | aCollectionOfOwnersOfVariants do: [:aVariantOwner| self openMorphInView: aVariantOwner]]" +] + { #category : #'actions creating' } SBEditor >> openFile [ diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st new file mode 100644 index 00000000..8a104d6d --- /dev/null +++ b/packages/Sandblocks-Core/SBExploriants.class.st @@ -0,0 +1,52 @@ +Class { + #name : #SBExploriants, + #superclass : #SBBlock, + #category : #'Sandblocks-Core' +} + +{ #category : #'as yet unclassified' } +SBExploriants class >> openIn: anEditor [ + + (self new visualize) openIn: anEditor +] + +{ #category : #'as yet unclassified' } +SBExploriants >> allMethodsContainingVariants [ + + ^ ((self systemNavigation allCallsOn: SBVariant matchingSelector) + reject: [:aMethodReference | aMethodReference actualClass = SBVariant class]) + collect: #compiledMethod +] + +{ #category : #'as yet unclassified' } +SBExploriants >> initialize [ + + super initialize. + + self + attachDecorator: SBMoveDecorator new; + attachDecorator: SBResizableDecorator new; + changeTableLayout; + listDirection: #topToBottom; + layoutInset: 8; + cellGap: 16; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap +] + +{ #category : #'as yet unclassified' } +SBExploriants >> openIn: anEditor [ + + anEditor openMorphInView: self +] + +{ #category : #'as yet unclassified' } +SBExploriants >> visualize [ + + self allMethodsContainingVariants + collect: #asSandblock + thenDo: [:aSBStMethod | self addMorphBack: aSBStMethod]. + + + +] diff --git a/packages/Sandblocks-Smalltalk/SBVariant.class.st b/packages/Sandblocks-Smalltalk/SBVariant.class.st index d4f905f5..689acca2 100644 --- a/packages/Sandblocks-Smalltalk/SBVariant.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariant.class.st @@ -32,7 +32,13 @@ SBVariant class >> matches: aBlock [ ^ aBlock receiver isBinding and: [aBlock receiver contents = 'SBVariant'] - and: [aBlock selector = 'named:associations:activeIndex:'] + and: [aBlock selector = self matchingSelector] +] + +{ #category : #constants } +SBVariant class >> matchingSelector [ + + ^ #named:associations:activeIndex: ] { #category : #'instance creation' } @@ -134,6 +140,12 @@ SBVariant >> initialize [ hResizing: #shrinkWrap ] +{ #category : #testing } +SBVariant >> isVariant [ + + ^ true +] + { #category : #accessing } SBVariant >> name [ From 2492f8691f57d44141f937b217e9caceb034c6cb Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Thu, 24 Aug 2023 15:30:03 +0200 Subject: [PATCH 02/15] Adds SBVariantProxy s in Exploriants and utilities in other classes for it to stay consistent with original --- .../Sandblocks-Core/SBExploriants.class.st | 7 +- .../SBStBasicMethod.class.st | 18 +++ .../SBStBlockBody.class.st | 36 ++++-- .../Sandblocks-Smalltalk/SBStMethod.class.st | 6 + .../Sandblocks-Smalltalk/SBVariant.class.st | 64 +++++++++- .../SBVariantProxy.class.st | 114 ++++++++++++++++++ 6 files changed, 227 insertions(+), 18 deletions(-) create mode 100644 packages/Sandblocks-Smalltalk/SBVariantProxy.class.st diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st index 8a104d6d..a750a39c 100644 --- a/packages/Sandblocks-Core/SBExploriants.class.st +++ b/packages/Sandblocks-Core/SBExploriants.class.st @@ -25,11 +25,11 @@ SBExploriants >> initialize [ self attachDecorator: SBMoveDecorator new; - attachDecorator: SBResizableDecorator new; changeTableLayout; listDirection: #topToBottom; layoutInset: 8; cellGap: 16; + cellInset: 10; hResizing: #shrinkWrap; vResizing: #shrinkWrap ] @@ -45,7 +45,10 @@ SBExploriants >> visualize [ self allMethodsContainingVariants collect: #asSandblock - thenDo: [:aSBStMethod | self addMorphBack: aSBStMethod]. + thenDo: [:aSBStMethod | + self addMorphBack: aSBStMethod methodHeader copy. + aSBStMethod containedVariants do: [:aSBVariant | self addMorphBack: (SBVariantProxy for: aSBVariant)]. + self addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2)]. diff --git a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st index 02257312..14ab188d 100644 --- a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st @@ -20,6 +20,12 @@ SBStBasicMethod class >> selector: aSymbol arguments: aCollection class: aClass body: aBlock asSandblock ] +{ #category : #comparing } +SBStBasicMethod >> = anotherSBStBasicMethod [ + + ^ anotherSBStBasicMethod class = self class and: [anotherSBStBasicMethod compiledMethod equivalentTo: self compiledMethod] +] + { #category : #accessing } SBStBasicMethod >> actualReceiver [ @@ -217,6 +223,12 @@ SBStBasicMethod >> compiledMethod [ ifAbsent: [self] ] +{ #category : #accessing } +SBStBasicMethod >> containedVariants [ + + ^ self body containedVariants +] + { #category : #actions } SBStBasicMethod >> createTestMethod [ @@ -291,6 +303,12 @@ SBStBasicMethod >> deleteMethod [ ^ self sandblockEditor do: (SBStDeleteMethodCommand new target: self) ] +{ #category : #accessing } +SBStBasicMethod >> detectVariant: aVariant [ + + ^ self body detectVariant: aVariant +] + { #category : #'artefact protocol' } SBStBasicMethod >> ensureExpanded [ diff --git a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st index 13b24e61..40492db0 100644 --- a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st @@ -113,18 +113,24 @@ SBStBlockBody >> blockBodyNestingDepth [ ^ d ] -{ #category : #'as yet unclassified' } +{ #category : #'insert/delete' } SBStBlockBody >> canDeleteChild: aBlock [ ^ true ] -{ #category : #'as yet unclassified' } +{ #category : #'layout properties - table' } SBStBlockBody >> cellGap [ ^ self colorPolicy lineGap ] +{ #category : #accessing } +SBStBlockBody >> containedVariants [ + + ^ self allBlocksSelect: #isVariant +] + { #category : #'ast helpers' } SBStBlockBody >> declarationsDo: aBlock [ @@ -152,6 +158,12 @@ SBStBlockBody >> declareTemporaryVariableCommand: aString [ yourself] ] +{ #category : #accessing } +SBStBlockBody >> detectVariant: aVariant [ + + ^ (self allBlocksSelect: #isVariant) detect: [:oneOfMyVariants | oneOfMyVariants = aVariant] +] + { #category : #'as yet unclassified' } SBStBlockBody >> endPC [ @@ -176,13 +188,13 @@ SBStBlockBody >> fixedNumberOfChildren [ ^ false ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } SBStBlockBody >> guessedClass [ ^ BlockClosure ] -{ #category : #'as yet unclassified' } +{ #category : #'initialize-release' } SBStBlockBody >> initialize [ super initialize. @@ -201,7 +213,7 @@ SBStBlockBody >> initialize [ addMorphBack: temporaries) ] -{ #category : #'as yet unclassified' } +{ #category : #'insert/delete' } SBStBlockBody >> insertCommandRequest: aMorph near: aBlock before: aBoolean [ (aBlock notNil and: [aBlock owner = bindings]) ifTrue: [ @@ -227,7 +239,7 @@ SBStBlockBody >> insertCommandRequest: aMorph near: aBlock before: aBoolean [ title: 'insert statement' ] -{ #category : #'as yet unclassified' } +{ #category : #testing } SBStBlockBody >> isBlockBody [ ^ true @@ -251,7 +263,7 @@ SBStBlockBody >> isScope [ ^ true ] -{ #category : #'as yet unclassified' } +{ #category : #layout } SBStBlockBody >> layoutCommands [ | preamble preambleHasContent multiLine | @@ -294,13 +306,13 @@ SBStBlockBody >> localNestingDepth [ ^ 1 ] -{ #category : #'as yet unclassified' } +{ #category : #layout } SBStBlockBody >> minHeight [ ^ self fontToUse height + self layoutInset asEdgeInsets y ] -{ #category : #'as yet unclassified' } +{ #category : #'geometry - layout' } SBStBlockBody >> minimumHeight [ ^ self fontToUse height + self layoutInset asEdgeInsets vertical @@ -320,7 +332,7 @@ SBStBlockBody >> newEmptyChildNear: aBlock before: aBoolean [ ^ super newEmptyChildNear: aBlock before: aBoolean ] -{ #category : #'as yet unclassified' } +{ #category : #'object interface' } SBStBlockBody >> objectInterfaceNear: aBlock at: aSymbol [ ({bindings. temporaries} includes: (aBlock ifNotNil: #owner)) ifTrue: [^ SBInterfaces stName]. @@ -395,7 +407,7 @@ SBStBlockBody >> statementsDo: aBlock [ ^ self submorphs allButFirstDo: aBlock ] -{ #category : #'as yet unclassified' } +{ #category : #'colors and color policies' } SBStBlockBody >> symbols [ ^ self isMethodBody ifTrue: [#(nil nil)] ifFalse: [self colorPolicy symbolsForBlock: self] @@ -413,7 +425,7 @@ SBStBlockBody >> temporaries: aCollection [ temporaries bindings: aCollection ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } SBStBlockBody >> updatePCFrom: aBlock [ super updatePCFrom: aBlock. diff --git a/packages/Sandblocks-Smalltalk/SBStMethod.class.st b/packages/Sandblocks-Smalltalk/SBStMethod.class.st index f2dded4c..c2070443 100644 --- a/packages/Sandblocks-Smalltalk/SBStMethod.class.st +++ b/packages/Sandblocks-Smalltalk/SBStMethod.class.st @@ -144,6 +144,12 @@ SBStMethod >> methodClass [ ^ classPrefix selectedClass ifNil: [self outerArtefact ifNotNil: #relatedClass] ] +{ #category : #accessing } +SBStMethod >> methodHeader [ + + ^ self firstSubmorph +] + { #category : #'object interface' } SBStMethod >> objectInterfaceNear: aBlock at: aSymbol [ diff --git a/packages/Sandblocks-Smalltalk/SBVariant.class.st b/packages/Sandblocks-Smalltalk/SBVariant.class.st index 689acca2..2dbda922 100644 --- a/packages/Sandblocks-Smalltalk/SBVariant.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariant.class.st @@ -3,7 +3,8 @@ Class { #superclass : #SBStSubstitution, #instVars : [ 'name', - 'widget' + 'widget', + 'id' ], #category : #'Sandblocks-Smalltalk' } @@ -38,7 +39,7 @@ SBVariant class >> matches: aBlock [ { #category : #constants } SBVariant class >> matchingSelector [ - ^ #named:associations:activeIndex: + ^ #named:associations:activeIndex:id: ] { #category : #'instance creation' } @@ -52,7 +53,18 @@ SBVariant class >> named: aString alternatives: aCollectionOfNamedBlocks activeI ] { #category : #'instance creation' } -SBVariant class >> named: aString associations: aCollectionOfAssociations activeIndex: aNumber [ +SBVariant class >> named: aString alternatives: aCollectionOfNamedBlocks activeIndex: aNumber id: uuid [ + + ^ self new + named: aString + alternatives: aCollectionOfNamedBlocks + activeIndex: aNumber + id: uuid + +] + +{ #category : #'instance creation' } +SBVariant class >> named: aString associations: aCollectionOfAssociations activeIndex: aNumber id: uuid [ ^ aNumber > 0 ifTrue: [(aCollectionOfAssociations at: aNumber) value value] ifFalse: [nil] @@ -71,6 +83,7 @@ SBVariant class >> newFor: aBlock [ named: aBlock arguments first contents alternatives: (aBlock arguments second childSandblocks collect: [:anAssociation | SBNamedBlock block: (anAssociation arguments first) named: (anAssociation receiver contents)]) activeIndex: aBlock arguments third parsedContents + id: aBlock arguments fourth contents ] { #category : #shortcuts } @@ -80,6 +93,12 @@ SBVariant class >> registerShortcuts: aProvider [ ] +{ #category : #comparing } +SBVariant >> = otherVariant [ + + ^ otherVariant class = self class and: [otherVariant id = self id] +] + { #category : #accessing } SBVariant >> active [ @@ -104,6 +123,18 @@ SBVariant >> alternatives [ ^ self widget namedBlocks ] +{ #category : #comparing } +SBVariant >> alternativesEqual: otherAlternatives [ + + "Private" + "Does a cheap version of python's zip and then allSatisfy:" + | areSame | + areSame := true. + ^ self alternatives size = otherAlternatives size and: [ + (1 to: self alternatives size) do: [:index | + areSame := areSame and: [(self alternatives at: index) = (otherAlternatives at: index)]]. areSame] +] + { #category : #accessing } SBVariant >> color [ @@ -116,6 +147,16 @@ SBVariant >> drawnColor [ ^ Color white ] +{ #category : #accessing } +SBVariant >> id [ + ^ id +] + +{ #category : #accessing } +SBVariant >> id: anObject [ + id := anObject +] + { #category : #initialization } SBVariant >> initialize [ @@ -128,7 +169,7 @@ SBVariant >> initialize [ self widget: (SBTabView namedBlocks: {SBNamedBlock block: (SBStBlockBody emptyWithDeclarations: {'a'. 'c'}) named: 'Code'} activeIndex: 1). - + id := UUID new asString. self layoutInset: 0; @@ -164,6 +205,13 @@ SBVariant >> named: aString alternatives: aCollectionOfNamedBlocks activeIndex: self widget namedBlocks: aCollectionOfNamedBlocks activeIndex: aNumber ] +{ #category : #initialization } +SBVariant >> named: aString alternatives: aCollectionOfNamedBlocks activeIndex: aNumber id: uuid [ + + self id: uuid. + self named: aString alternatives: aCollectionOfNamedBlocks activeIndex: aNumber +] + { #category : #accessing } SBVariant >> namedBlocks [ @@ -191,6 +239,12 @@ SBVariant >> replaceSelfWithChosen [ unwrapped: {self activeBlock lastSubmorph}) ] +{ #category : #initialization } +SBVariant >> replaceValuesFrom: anotherVariant [ + + self named: anotherVariant name alternatives: anotherVariant alternatives activeIndex: anotherVariant activeIndex +] + { #category : #ui } SBVariant >> updateResize [ @@ -231,5 +285,7 @@ SBVariant >> writeSourceOn: aStream [ separatedBy: [aStream nextPut: $.]. aStream nextPutAll: '} activeIndex: '. self activeIndex storeOn: aStream. + aStream nextPutAll: ' id: '. + self id storeOn: aStream. aStream nextPutAll: ')' ] diff --git a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st new file mode 100644 index 00000000..7e05fce1 --- /dev/null +++ b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st @@ -0,0 +1,114 @@ +Class { + #name : #SBVariantProxy, + #superclass : #SBBlock, + #instVars : [ + 'original' + ], + #category : #'Sandblocks-Smalltalk' +} + +{ #category : #'as yet unclassified' } +SBVariantProxy class >> for: aVariant [ + + ^ self new for: aVariant +] + +{ #category : #callbacks } +SBVariantProxy >> artefactChanged: anArtefact [ + + anArtefact = self ifTrue: [ self updateOriginalWithOwnValues ]. + + (anArtefact = self containedMethod) + ifTrue: [ self updateSelfAfterMethodUpdate: anArtefact ] +] + +{ #category : #callbacks } +SBVariantProxy >> artefactSaved: anArtefact [ + + anArtefact = self containedMethod ifTrue: [self sandblockEditor markSaved: self] +] + +{ #category : #'ast helpers' } +SBVariantProxy >> binding: aString for: block class: aClass ifPresent: aBlock [ + + ^ self containedMethod binding: aString for: block class: aClass ifPresent: aBlock +] + +{ #category : #accessing } +SBVariantProxy >> containedMethod [ + + ^ original containingArtefact +] + +{ #category : #initialization } +SBVariantProxy >> for: aVariant [ + + self assert: aVariant containingArtefact notNil. + + original := aVariant. + self addMorphBack: original copyBlock. +] + +{ #category : #initialization } +SBVariantProxy >> initialize [ + + super initialize. + + self + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + changeTableLayout; + layoutInset: 4; + attachDecorator: SBForceMoveDecorator newConfigured +] + +{ #category : #testing } +SBVariantProxy >> isArtefact [ + + ^ true +] + +{ #category : #'artefact protocol' } +SBVariantProxy >> saveTryFixing: aFixBoolean quick: aQuickBoolean [ + + self sandblockEditor + save: self containedMethod + tryFixing: aFixBoolean + quick: aQuickBoolean. + ^ false +] + +{ #category : #'ast helpers' } +SBVariantProxy >> scopesDo: aBlock [ + + original scopesDo: aBlock +] + +{ #category : #callbacks } +SBVariantProxy >> updateOriginalWithOwnValues [ + + + | variantThatNeedsChanging | + original replaceBy: (original := self firstSubmorph copyBlock). + variantThatNeedsChanging := self containedMethod detectVariant: original. + variantThatNeedsChanging ifNil: [self delete. ^ self]. + variantThatNeedsChanging replaceValuesFrom: original copyBlock. + self sandblockEditor markChanged: self containedMethod +] + +{ #category : #callbacks } +SBVariantProxy >> updateSelfAfterMethodUpdate: newMethod [ + + | variantThatMaybeChanged | + variantThatMaybeChanged := newMethod detectVariant: original. + + "orignal variant has been deleted" + variantThatMaybeChanged ifNil: [self delete. ^ self]. + + (variantThatMaybeChanged sourceString ~= self firstSubmorph sourceString) + ifTrue: [ + original := variantThatMaybeChanged. + self firstSubmorph replaceBy: original copyBlock. + self sandblockEditor markChanged: self] + +] From 845cdc3449c411704a99dff5d713e8182bd39540 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Thu, 24 Aug 2023 17:32:37 +0200 Subject: [PATCH 03/15] Make Exploriants Singleton --- packages/Sandblocks-Core/SBEditor.class.st | 25 +--------- .../Sandblocks-Core/SBExploriants.class.st | 49 +++++++++++++------ .../SBStBlockBody.class.st | 2 +- 3 files changed, 37 insertions(+), 39 deletions(-) diff --git a/packages/Sandblocks-Core/SBEditor.class.st b/packages/Sandblocks-Core/SBEditor.class.st index 09ada07e..7b4859f8 100644 --- a/packages/Sandblocks-Core/SBEditor.class.st +++ b/packages/Sandblocks-Core/SBEditor.class.st @@ -1151,30 +1151,7 @@ SBEditor >> openAll: aCollection [ SBEditor >> openExploriants [ - SBExploriants openIn: self - - "| allCompiledMethodsContainingVariants | - allCompiledMethodsContainingVariants := ((self systemNavigation allCallsOn: #named:associations:activeIndex:) - reject: [:aMethodReference | aMethodReference methodSymbol = #openExploriants]) - collect: #compiledMethod. - - allCompiledMethodsContainingVariants - collect: #asSandblock - thenDo: [:aSBStMethod | - aSBStMethod body allMorphsMutableDo: [:aMorph | aMorph visible: false]. - aSBStMethod containedVariants - do: [:aVariant | |current| - current := aVariant. - [current := current owner] - doWhileFalse: [current = aSBStMethod]. - current submorphsDo: [:m| m visible: true]]. - self openMorphInView: aSBStMethod]." - - "collect: [:aMethodBlock | aMethodBlock allMorphs - select: [:aMorph | aMorph submorphs - ifEmpty: [false] - ifNotEmpty: [(aMorph submorphOfClass: SBVariant) isNil not]]] - thenDo: [:aCollectionOfOwnersOfVariants | aCollectionOfOwnersOfVariants do: [:aVariantOwner| self openMorphInView: aVariantOwner]]" + self open: SBExploriants uniqueInstance visualize ] { #category : #'actions creating' } diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st index a750a39c..963da6de 100644 --- a/packages/Sandblocks-Core/SBExploriants.class.st +++ b/packages/Sandblocks-Core/SBExploriants.class.st @@ -1,16 +1,37 @@ Class { #name : #SBExploriants, #superclass : #SBBlock, + #classInstVars : [ + 'uniqueInstance' + ], #category : #'Sandblocks-Core' } -{ #category : #'as yet unclassified' } -SBExploriants class >> openIn: anEditor [ +{ #category : #accessing } +SBExploriants class >> deleteUniqueInstance [ - (self new visualize) openIn: anEditor + uniqueInstance := nil ] -{ #category : #'as yet unclassified' } +{ #category : #'instance creation' } +SBExploriants class >> new [ + + ^ self error: 'Singleton. Use #uniqueInstance' +] + +{ #category : #accessing } +SBExploriants class >> uniqueInstance [ + + ^ uniqueInstance ifNil: [uniqueInstance := super new] +] + +{ #category : #comparing } +SBExploriants >> = other [ + + ^ self class = other class +] + +{ #category : #accessing } SBExploriants >> allMethodsContainingVariants [ ^ ((self systemNavigation allCallsOn: SBVariant matchingSelector) @@ -18,7 +39,7 @@ SBExploriants >> allMethodsContainingVariants [ collect: #compiledMethod ] -{ #category : #'as yet unclassified' } +{ #category : #initialization } SBExploriants >> initialize [ super initialize. @@ -34,20 +55,20 @@ SBExploriants >> initialize [ vResizing: #shrinkWrap ] -{ #category : #'as yet unclassified' } -SBExploriants >> openIn: anEditor [ - - anEditor openMorphInView: self -] - -{ #category : #'as yet unclassified' } +{ #category : #initialization } SBExploriants >> visualize [ + self submorphs copy do: #delete. + self allMethodsContainingVariants - collect: #asSandblock + collect: [:aCompiledMethod | + self blockFor: aCompiledMethod withInterfaces: #(#isEditor) + ifOpen: [:existingMethodBlock | existingMethodBlock] + ifClosed: [aCompiledMethod asSandblock]] thenDo: [:aSBStMethod | self addMorphBack: aSBStMethod methodHeader copy. - aSBStMethod containedVariants do: [:aSBVariant | self addMorphBack: (SBVariantProxy for: aSBVariant)]. + aSBStMethod containedVariants do: [:aSBVariant | + self addMorphBack: (SBVariantProxy for: aSBVariant)]. self addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2)]. diff --git a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st index 40492db0..1df32e69 100644 --- a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st @@ -161,7 +161,7 @@ SBStBlockBody >> declareTemporaryVariableCommand: aString [ { #category : #accessing } SBStBlockBody >> detectVariant: aVariant [ - ^ (self allBlocksSelect: #isVariant) detect: [:oneOfMyVariants | oneOfMyVariants = aVariant] + ^ (self containedVariants) detect: [:oneOfMyVariants | oneOfMyVariants = aVariant] ] { #category : #'as yet unclassified' } From 3448fca767ebdf90e8aed87bb5665cc5e9756615 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Thu, 31 Aug 2023 19:09:22 +0200 Subject: [PATCH 04/15] Adds comment to Exploriants visualize & right blockFor call on Editor --- packages/Sandblocks-Core/SBExploriants.class.st | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st index 963da6de..d7a36756 100644 --- a/packages/Sandblocks-Core/SBExploriants.class.st +++ b/packages/Sandblocks-Core/SBExploriants.class.st @@ -62,15 +62,15 @@ SBExploriants >> visualize [ self allMethodsContainingVariants collect: [:aCompiledMethod | - self blockFor: aCompiledMethod withInterfaces: #(#isEditor) + "We are looking for already opened methods so that we can assign the + variant there as the original in SBVariantProxy. That way, we immediately + have consistency between changes." + SBEditor current blockFor: aCompiledMethod withInterfaces: #(#isMethod) ifOpen: [:existingMethodBlock | existingMethodBlock] ifClosed: [aCompiledMethod asSandblock]] thenDo: [:aSBStMethod | self addMorphBack: aSBStMethod methodHeader copy. aSBStMethod containedVariants do: [:aSBVariant | self addMorphBack: (SBVariantProxy for: aSBVariant)]. - self addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2)]. - - - + self addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2)]. ] From 273b1b1f6d74add628c7b3f599cf6fa0fe674856 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Thu, 31 Aug 2023 19:10:17 +0200 Subject: [PATCH 05/15] adds containedMethod as variable to VariantProxy for consistent changes --- .../Sandblocks-Smalltalk/SBStBlockBody.class.st | 2 +- .../Sandblocks-Smalltalk/SBVariantProxy.class.st | 15 ++++++++------- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st index 1df32e69..2a171617 100644 --- a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st @@ -161,7 +161,7 @@ SBStBlockBody >> declareTemporaryVariableCommand: aString [ { #category : #accessing } SBStBlockBody >> detectVariant: aVariant [ - ^ (self containedVariants) detect: [:oneOfMyVariants | oneOfMyVariants = aVariant] + ^ (self containedVariants) detect: [:oneOfMyVariants | oneOfMyVariants = aVariant] ifNone: [nil] ] { #category : #'as yet unclassified' } diff --git a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st index 7e05fce1..566e32ab 100644 --- a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st @@ -2,7 +2,8 @@ Class { #name : #SBVariantProxy, #superclass : #SBBlock, #instVars : [ - 'original' + 'original', + 'containedMethod' ], #category : #'Sandblocks-Smalltalk' } @@ -30,20 +31,21 @@ SBVariantProxy >> artefactSaved: anArtefact [ { #category : #'ast helpers' } SBVariantProxy >> binding: aString for: block class: aClass ifPresent: aBlock [ - - ^ self containedMethod binding: aString for: block class: aClass ifPresent: aBlock + + ^ original binding: aString for: block class: aClass ifPresent: aBlock ] { #category : #accessing } SBVariantProxy >> containedMethod [ - ^ original containingArtefact + ^ containedMethod ] { #category : #initialization } SBVariantProxy >> for: aVariant [ - self assert: aVariant containingArtefact notNil. + containedMethod := aVariant containingArtefact. + self assert: containedMethod notNil. original := aVariant. self addMorphBack: original copyBlock. @@ -87,11 +89,10 @@ SBVariantProxy >> scopesDo: aBlock [ { #category : #callbacks } SBVariantProxy >> updateOriginalWithOwnValues [ - | variantThatNeedsChanging | - original replaceBy: (original := self firstSubmorph copyBlock). variantThatNeedsChanging := self containedMethod detectVariant: original. variantThatNeedsChanging ifNil: [self delete. ^ self]. + original replaceBy: (original := self firstSubmorph copyBlock). variantThatNeedsChanging replaceValuesFrom: original copyBlock. self sandblockEditor markChanged: self containedMethod ] From bf7f05b85db9103196baa034025c7e572ff9ab11 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Thu, 31 Aug 2023 19:11:18 +0200 Subject: [PATCH 06/15] Adjusts delete actiong for watches --- .../SBExampleWatch.class.st | 27 ++++++++++++++++--- .../Sandblocks-Watch/SBWatchView.class.st | 18 +++++++++++++ 2 files changed, 42 insertions(+), 3 deletions(-) diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st index f8ca0f21..9f2a3e23 100644 --- a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st @@ -33,6 +33,14 @@ SBExampleWatch class >> newFor: aBlock [ expression: aBlock arguments first ] +{ #category : #'as yet unclassified' } +SBExampleWatch class >> registerShortcuts: aProvider [ + + aProvider registerShortcut: Character backspace do: #replaceWithWatchedExpression. + aProvider cmdShortcut: Character delete do: #replaceWithWatchedExpression. + +] + { #category : #'event handling' } SBExampleWatch class >> registerWatch: aWatch [ @@ -84,12 +92,16 @@ SBExampleWatch >> color [ ^ self parentSandblock color ] +{ #category : #'insert/delete' } +SBExampleWatch >> deleteCommandFor: aBlock [ + + ^ nil +] + { #category : #'event handling' } SBExampleWatch >> doubleClick: anEvent [ - self sandblockEditor do: (SBReplaceCommand new - replacer: self expression; - target: self) + self replaceWithWatchedExpression ] { #category : #'colors and color policies' } @@ -252,6 +264,15 @@ SBExampleWatch >> printOn: aStream [ self modifyExpression printOn: aStream. ] +{ #category : #'event handling' } +SBExampleWatch >> replaceWithWatchedExpression [ + + + self sandblockEditor do: (SBReplaceCommand new + replacer: self expression; + target: self) +] + { #category : #actions } SBExampleWatch >> reportValue: anObject for: anExample modifying: aBlock [ diff --git a/packages/Sandblocks-Watch/SBWatchView.class.st b/packages/Sandblocks-Watch/SBWatchView.class.st index e10bf7b0..89693822 100644 --- a/packages/Sandblocks-Watch/SBWatchView.class.st +++ b/packages/Sandblocks-Watch/SBWatchView.class.st @@ -31,6 +31,18 @@ SBWatchView >> addValue: anObject [ ^ watchValues addLast: (SBWatchValue value: anObject sbSnapshot identityHash: anObject identityHash) ] +{ #category : #'insert/delete' } +SBWatchView >> canDelete [ + + ^ false +] + +{ #category : #'insert/delete' } +SBWatchView >> canDeleteChild: aBlock [ + + ^ false +] + { #category : #display } SBWatchView >> changeDisplay [ @@ -80,6 +92,12 @@ SBWatchView >> defaultDisplay [ height: 20) ] +{ #category : #'insert/delete' } +SBWatchView >> deleteCommandFor: aBlock [ + + ^ nil +] + { #category : #accessing } SBWatchView >> display [ From b181a73f0f26efe81ce6b40c85b9e93c20954ee4 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Mon, 11 Sep 2023 22:06:53 +0200 Subject: [PATCH 07/15] Inactive variants, tabview in exploriants --- .../SBActiveVariantPermutation.class.st | 5 + .../Sandblocks-Babylonian/SBExample.class.st | 51 ++++-- .../SBExampleValueDisplay.class.st | 29 +++- .../SBExampleWatch.class.st | 155 ++++++++++++++---- .../SBExampleWatch.extension.st | 2 +- .../Sandblocks-Core/SBExploriants.class.st | 35 +--- .../SBExploriantsView.class.st | 97 +++++++++++ .../Sandblocks-Core/SBResultsView.class.st | 101 ++++++++++++ packages/Sandblocks-Core/SBTabView.class.st | 12 ++ .../Sandblocks-Core/SBVariantsView.class.st | 30 ++++ .../SBPermutation.class.st | 46 ++++++ .../SBStBasicMethod.class.st | 12 ++ .../SBStBlockBody.class.st | 12 ++ .../Sandblocks-Smalltalk/SBVariant.class.st | 35 +++- .../SBVariantProxy.class.st | 6 + .../SBExampleWatchView.class.st | 10 +- .../Sandblocks-Watch/SBWatchView.class.st | 34 +++- 17 files changed, 585 insertions(+), 87 deletions(-) create mode 100644 packages/Sandblocks-Babylonian/SBActiveVariantPermutation.class.st create mode 100644 packages/Sandblocks-Core/SBExploriantsView.class.st create mode 100644 packages/Sandblocks-Core/SBResultsView.class.st create mode 100644 packages/Sandblocks-Core/SBVariantsView.class.st create mode 100644 packages/Sandblocks-Smalltalk/SBPermutation.class.st diff --git a/packages/Sandblocks-Babylonian/SBActiveVariantPermutation.class.st b/packages/Sandblocks-Babylonian/SBActiveVariantPermutation.class.st new file mode 100644 index 00000000..ddd9dd5d --- /dev/null +++ b/packages/Sandblocks-Babylonian/SBActiveVariantPermutation.class.st @@ -0,0 +1,5 @@ +Class { + #name : #SBActiveVariantPermutation, + #superclass : #ProcessLocalVariable, + #category : #'Sandblocks-Babylonian' +} diff --git a/packages/Sandblocks-Babylonian/SBExample.class.st b/packages/Sandblocks-Babylonian/SBExample.class.st index 3a301e2b..859aa8a9 100644 --- a/packages/Sandblocks-Babylonian/SBExample.class.st +++ b/packages/Sandblocks-Babylonian/SBExample.class.st @@ -17,12 +17,6 @@ Class { #category : #'Sandblocks-Babylonian' } -{ #category : #'as yet unclassified' } -SBExample class >> getAllInMethod: aBlock [ - - ^ aBlock body childSandblocks select: #isExample -] - { #category : #'as yet unclassified' } SBExample class >> instanceSuggestion [ @@ -46,6 +40,12 @@ SBExample class >> matches: aMessage [ and: [#('example:args:label:' 'example:args:label:assert:') includes: aMessage selector]] ] +{ #category : #'as yet unclassified' } +SBExample class >> matchingSelectors [ + + ^ #(#self:args:label: #self:args:label:assert: #example:args:label: #example:args:label:assert:) +] + { #category : #'as yet unclassified' } SBExample class >> newFor: aMessage [ @@ -125,6 +125,19 @@ SBExample >> assertionBlock [ ^ self submorphCount > 7 ifTrue: [self submorphs ninth] ifFalse: [nil] ] +{ #category : #'as yet unclassified' } +SBExample >> basicRunSynchronously [ + + | returned | + self sendStartNotification. + + SBExecutionEnvironment value: self. + [returned := self evaluate] on: Error do: [:e | self scheduleLastError: e. "^ self ?" ]. + self scheduleLastError: nil. + + self sendFinishNotification. +] + { #category : #'as yet unclassified' } SBExample >> click: anEvent [ @@ -368,15 +381,8 @@ SBExample >> providesExecutionEnvironment [ { #category : #'as yet unclassified' } SBExample >> run [ - self containingArtefact valid ifFalse: [^ self]. - processRunning ifTrue: [^ self]. - currentProcess ifNotNil: #terminate. - - errorDecorator ifNotNil: #detach. - errorDecorator := nil. - returnValue clear. + self runSetup. self sendStartNotification. - "self collectTypeInfo." processRunning := true. currentProcess := [ @@ -394,7 +400,9 @@ SBExample >> run [ returnValue reportValue: returned. returnValue updateDisplay. self sendFinishNotification] - ] forkAt: Processor userBackgroundPriority + ] forkAt: Processor userBackgroundPriority. + + ^ currentProcess ] { #category : #'as yet unclassified' } @@ -405,6 +413,19 @@ SBExample >> runOnlyThis [ self startRunning ] +{ #category : #'as yet unclassified' } +SBExample >> runSetup [ + + Transcript show: 'i', Character cr. + self containingArtefact valid ifFalse: [^ self]. + processRunning ifTrue: [^ self]. + currentProcess ifNotNil: #terminate. + + errorDecorator ifNotNil: #detach. + errorDecorator := nil. + returnValue clear. +] + { #category : #'as yet unclassified' } SBExample >> scheduleLastError: anError [ diff --git a/packages/Sandblocks-Babylonian/SBExampleValueDisplay.class.st b/packages/Sandblocks-Babylonian/SBExampleValueDisplay.class.st index 142a3b61..416dabcd 100644 --- a/packages/Sandblocks-Babylonian/SBExampleValueDisplay.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleValueDisplay.class.st @@ -13,6 +13,14 @@ Class { #category : #'Sandblocks-Babylonian' } +{ #category : #actions } +SBExampleValueDisplay >> clear [ + + display clear. + + hadValue := false +] + { #category : #accessing } SBExampleValueDisplay >> exampleFinished: anExample [ @@ -27,7 +35,6 @@ SBExampleValueDisplay >> exampleFinished: anExample [ SBExampleValueDisplay >> exampleStarting: anExample [ display exampleStarting: anExample. - display noValue. statusLabel contents: '...'. hadValue := false. @@ -73,7 +80,7 @@ SBExampleValueDisplay >> layoutCommands [ ] { #category : #naming } -SBExampleValueDisplay >> name: aString [ +SBExampleValueDisplay >> name: aString [ label contents: aString ] @@ -85,3 +92,21 @@ SBExampleValueDisplay >> reportValue: anObject name: aString [ label contents: aString. hadValue := true ] + +{ #category : #'event handling' } +SBExampleValueDisplay >> reportValues: aCollectionOfObjects name: aString [ + + display reportValues: aCollectionOfObjects. + label contents: aString. + hadValue := true +] + +{ #category : #actions } +SBExampleValueDisplay >> updateDisplay [ + + display updateDisplay. + + statusLabel contents: (hadValue + ifTrue: [''] + ifFalse: ['- Not reached -']) +] diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st index 9f2a3e23..208106b9 100644 --- a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st @@ -1,15 +1,16 @@ " -Observes (watches) an expression locally for added SBExamples. Whenever an example has finished running, it updates its belonging view. Further, with a given modifyExpression, it transforms the watched expression values. Also known as a Probe in the context of Babylonian Smalltalk. +Observes (watches) an expression locally for added SBExamples. Whenever an example has finished running, it updates its belonging view. Only active watches update their views. Further, with a given modifyExpression, it transforms the watched expression values. Also known as a Probe in the context of Babylonian Smalltalk. " Class { #name : #SBExampleWatch, #superclass : #SBStSubstitution, #instVars : [ 'identifier', - 'display', - 'exampleValues', 'watchedExpression', - 'modifyExpression' + 'modifyExpression', + 'isActive', + 'exampleToDisplay', + 'exampleToValues' ], #classVars : [ 'Registry' @@ -22,18 +23,36 @@ SBExampleWatch class >> matches: aBlock [ (super matches: aBlock) ifFalse: [^ false]. - ^ (aBlock receiver satisfies: #(notNil isBinding)) and: [aBlock receiver contents = self name] and: [aBlock selector = 'report:for:modifying:'] + ^ (aBlock receiver satisfies: #(notNil isBinding)) and: [aBlock receiver contents = self name] and: [aBlock selector = self matchingSelectors first] +] + +{ #category : #constants } +SBExampleWatch class >> matchingSelector [ + + ^ #report:for:modifying: +] + +{ #category : #constants } +SBExampleWatch class >> matchingSelectors [ + + ^ #(#report:for:modifying:) ] { #category : #'instance creation' } -SBExampleWatch class >> newFor: aBlock [ +SBExampleWatch class >> newFor: aMessageSend [ + "Saving the temp is necessary here, as directly accessing will cause + the message send to lose an arguments with each assignment" + "Also done in SBMemoize" + | args | + args := aMessageSend arguments. ^ self new - identifier: aBlock arguments second contents asNumber; - expression: aBlock arguments first + identifier: args second contents asNumber; + modifyExpression: args third; + expression: args first ] -{ #category : #'as yet unclassified' } +{ #category : #shortcuts } SBExampleWatch class >> registerShortcuts: aProvider [ aProvider registerShortcut: Character backspace do: #replaceWithWatchedExpression. @@ -58,7 +77,7 @@ SBExampleWatch class >> registry [ SBExampleWatch class >> report: aValue for: aSymbol [ "Compatibility to SBWatch" - ^ self reportValue: aValue for: aSymbol modifying: (SBStBlockBody identityNamed: 'result'). + ^ self reportValue: aValue for: aSymbol modifying: (SBStBlockBody identityNamed: 'result'). ] { #category : #'event handling' } @@ -68,8 +87,10 @@ SBExampleWatch class >> report: aValue for: aSymbol modifying: aBlock [ example := SBExecutionEnvironment value ifNil: [^ aValue]. reg := self registry. - watchers := reg select: [:watcher | watcher notNil and: [watcher identifier = aSymbol]]. - watchers do: [:watcher | watcher reportValue: aValue for: example modifying: aBlock]. + watchers := reg select: [:watcher | watcher notNil + and: [watcher identifier = aSymbol] + and: [watcher isActive]]. + watchers do: [:watcher | watcher reportValue: aValue for: example]. ^ aValue ] @@ -86,6 +107,50 @@ SBExampleWatch class >> watchViewClass [ ^ SBExampleWatchView ] +{ #category : #callbacks } +SBExampleWatch >> applyModifyExpressionOnValues [ + + exampleToDisplay associationsDo: [:anExampleDisplayPair | + anExampleDisplayPair value clear. + anExampleDisplayPair value + reportValues: (self modifiedValuesFor: anExampleDisplayPair key) + name: (anExampleDisplayPair key ifNotNil: #label ifNil: ['']). + anExampleDisplayPair value updateDisplay. + ] +] + +{ #category : #callbacks } +SBExampleWatch >> artefactSaved: aBlock [ + + "As we are inactive, we have to manually apply our modifyExpression if it changes. + Otherwise, we would reset by examples starting" + (self isActive not and: [aBlock = self containingArtefact]) ifTrue: [self applyModifyExpressionOnValues] +] + +{ #category : #copying } +SBExampleWatch >> asInactiveCopy [ + + ^ (self veryDeepCopy) beInactive. +] + +{ #category : #accessing } +SBExampleWatch >> beActive [ + + + self flag: #todo. "action for debugging, remove later. bc when applying modification and + then turning inactive, the already modified values are seen as the ground truth. + is aber allgemein ein problemchen....eig sollten die watchviews die wahren values haben und nur + die modifizierten anzeigen." + isActive := true +] + +{ #category : #accessing } +SBExampleWatch >> beInactive [ + + + isActive := false +] + { #category : #'colors and color policies' } SBExampleWatch >> color [ @@ -113,15 +178,25 @@ SBExampleWatch >> drawnColor [ { #category : #'event handling' } SBExampleWatch >> exampleFinished: anExample [ - exampleValues at: anExample ifPresent: [:val | val exampleFinished: anExample] + exampleToDisplay + at: anExample + ifPresent: [:aDisplay | | modifiedValues | + modifiedValues := self modifiedValuesFor: anExample. + modifiedValues ifNotEmpty: [ + aDisplay + reportValues: modifiedValues + name: (anExample ifNotNil: #label ifNil: [''])]. + aDisplay exampleFinished: anExample] ] { #category : #'event handling' } SBExampleWatch >> exampleStarting: anExample [ - (exampleValues at: anExample ifAbsentPut: [ | display | + exampleToValues at: anExample put: OrderedCollection new. + + (exampleToDisplay at: anExample ifAbsentPut: [ | display | display := SBExampleValueDisplay new. - self addMorph: (exampleValues at: anExample put: display) atIndex: 2. + self addMorph: (exampleToDisplay at: anExample put: display) atIndex: 2. anExample when: #outOfWorld send: #exampleStopped: to: self with: anExample. display]) exampleStarting: anExample; @@ -131,9 +206,9 @@ SBExampleWatch >> exampleStarting: anExample [ { #category : #'event handling' } SBExampleWatch >> exampleStopped: anExample [ - exampleValues at: anExample ifPresent: [:val | - self removeMorph: val. - exampleValues removeKey: anExample] + exampleToDisplay at: anExample ifPresent: [:aDisplay | + self removeMorph: aDisplay. + exampleToDisplay removeKey: anExample] ] { #category : #accessing } @@ -174,9 +249,11 @@ SBExampleWatch >> initialize [ super initialize. - exampleValues := Dictionary new. + exampleToDisplay := Dictionary new. + exampleToValues := Dictionary new. watchedExpression := SBStMessageSend new. modifyExpression := SBStBlockBody identityNamed: 'result'. + isActive := true. self cellGap: 4; @@ -195,6 +272,12 @@ SBExampleWatch >> intoWorld: aWorld [ self class registerWatch: self ] +{ #category : #accessing } +SBExampleWatch >> isActive [ + + ^ isActive +] + { #category : #'*Sandblocks-Babylonian' } SBExampleWatch >> isExampleWatch [ @@ -224,7 +307,16 @@ SBExampleWatch >> layoutCommands [ { #category : #'*Sandblocks-Babylonian' } SBExampleWatch >> listensToExamples [ - ^ true + ^ self isActive +] + +{ #category : #accessing } +SBExampleWatch >> modifiedValuesFor: anExample [ + + ^ exampleToValues at: anExample + ifPresent: [:aCollection | aCollection + collect: [:anObject | self modifyExpression evaluateWithArguments: {anObject}]] + ifAbsent: [{}] ] { #category : #accessing } @@ -274,29 +366,32 @@ SBExampleWatch >> replaceWithWatchedExpression [ ] { #category : #actions } -SBExampleWatch >> reportValue: anObject for: anExample modifying: aBlock [ +SBExampleWatch >> reportValue: anObject for: anExample [ - exampleValues + exampleToValues at: anExample - ifPresent: [:display | display reportValue: (self modifyExpression evaluateWithArguments: {anObject}) name: (anExample ifNotNil: #label ifNil: [''])] + ifPresent: [:values | values add: anObject] ] { #category : #accessing } SBExampleWatch >> valuesForExample: anExample [ - ^ exampleValues at: anExample ifAbsent: [nil] + ^ exampleToValues at: anExample ifAbsent: [nil] ] { #category : #copying } SBExampleWatch >> veryDeepCopyWith: deepCopier [ " assure that copies of us have a unique id " - | new oldExamplesValues | - oldExamplesValues := exampleValues. - exampleValues := Dictionary new. + | new oldExampleDisplays oldExampleValues | + oldExampleDisplays := exampleToDisplay. + oldExampleValues := exampleToValues. + exampleToDisplay := Dictionary new. + exampleToValues := Dictionary new. new := super veryDeepCopyWith: deepCopier. - exampleValues := oldExamplesValues. + exampleToDisplay := oldExampleDisplays. + exampleToValues := exampleToValues. new newIdentifier. ^ new ] @@ -304,9 +399,9 @@ SBExampleWatch >> veryDeepCopyWith: deepCopier [ { #category : #printing } SBExampleWatch >> writeSourceOn: aStream [ - aStream nextPutAll: '(SBExampleWatch report: '. + aStream nextPutAll: '(SBExampleWatch report: ('. self expression writeSourceOn: aStream. - aStream nextPutAll: ' for: '. + aStream nextPutAll: ') for: '. self identifier storeOn: aStream. aStream nextPutAll: ' modifying: '. self modifyExpression writeSourceOn: aStream. diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.extension.st b/packages/Sandblocks-Babylonian/SBExampleWatch.extension.st index 295787df..03cc8110 100644 --- a/packages/Sandblocks-Babylonian/SBExampleWatch.extension.st +++ b/packages/Sandblocks-Babylonian/SBExampleWatch.extension.st @@ -15,5 +15,5 @@ SBExampleWatch >> isGlobalWatch [ { #category : #'*Sandblocks-Babylonian' } SBExampleWatch >> listensToExamples [ - ^ true + ^ self isActive ] diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st index d7a36756..c14573be 100644 --- a/packages/Sandblocks-Core/SBExploriants.class.st +++ b/packages/Sandblocks-Core/SBExploriants.class.st @@ -1,6 +1,11 @@ Class { #name : #SBExploriants, #superclass : #SBBlock, + #instVars : [ + 'watchMethodBlocks', + 'variants', + 'activeExamples' + ], #classInstVars : [ 'uniqueInstance' ], @@ -31,14 +36,6 @@ SBExploriants >> = other [ ^ self class = other class ] -{ #category : #accessing } -SBExploriants >> allMethodsContainingVariants [ - - ^ ((self systemNavigation allCallsOn: SBVariant matchingSelector) - reject: [:aMethodReference | aMethodReference actualClass = SBVariant class]) - collect: #compiledMethod -] - { #category : #initialization } SBExploriants >> initialize [ @@ -47,30 +44,14 @@ SBExploriants >> initialize [ self attachDecorator: SBMoveDecorator new; changeTableLayout; - listDirection: #topToBottom; - layoutInset: 8; - cellGap: 16; - cellInset: 10; hResizing: #shrinkWrap; vResizing: #shrinkWrap ] -{ #category : #initialization } +{ #category : #actions } SBExploriants >> visualize [ self submorphs copy do: #delete. - - self allMethodsContainingVariants - collect: [:aCompiledMethod | - "We are looking for already opened methods so that we can assign the - variant there as the original in SBVariantProxy. That way, we immediately - have consistency between changes." - SBEditor current blockFor: aCompiledMethod withInterfaces: #(#isMethod) - ifOpen: [:existingMethodBlock | existingMethodBlock] - ifClosed: [aCompiledMethod asSandblock]] - thenDo: [:aSBStMethod | - self addMorphBack: aSBStMethod methodHeader copy. - aSBStMethod containedVariants do: [:aSBVariant | - self addMorphBack: (SBVariantProxy for: aSBVariant)]. - self addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2)]. + + self addMorphBack: SBExploriantsView asTabView. ] diff --git a/packages/Sandblocks-Core/SBExploriantsView.class.st b/packages/Sandblocks-Core/SBExploriantsView.class.st new file mode 100644 index 00000000..b437d021 --- /dev/null +++ b/packages/Sandblocks-Core/SBExploriantsView.class.st @@ -0,0 +1,97 @@ +Class { + #name : #SBExploriantsView, + #superclass : #SBNamedBlock, + #category : #'Sandblocks-Core' +} + +{ #category : #'instance creation' } +SBExploriantsView class >> asTabView [ + + ^ SBTabView + namedBlocks: (self subclasses collect: #new) + activeIndex: 1 +] + +{ #category : #'instance creation' } +SBExploriantsView class >> block: aSBBlock named: aString [ + + "only calling new allowed to guarantee intented purpose" + self shouldNotImplement +] + +{ #category : #accessing } +SBExploriantsView >> allCompiledMethodsContainingClass: aClass [ + + "aClass should have #matchingSelectors implemented" + ^ (((aClass matchingSelectors collect: [:aSelector | self systemNavigation allCallsOn: aSelector]) flatten) + reject: [:aMethodReference | aMethodReference actualClass = aClass class]) + collect: #compiledMethod +] + +{ #category : #accessing } +SBExploriantsView >> allCompiledMethodsContainingVariants [ + + ^ self allCompiledMethodsContainingClass: SBVariant +] + +{ #category : #'as yet unclassified' } +SBExploriantsView >> allMethodBlocksContainingVariants [ + + "We are looking for already opened methods so that we can assign the + variant there as the original in SBVariantProxy. That way, we immediately + have consistency between changes." + ^ self findExistingOrConvertToBlocks: self allCompiledMethodsContainingVariants + +] + +{ #category : #actions } +SBExploriantsView >> clean [ + + self block submorphs copy do: #delete +] + +{ #category : #building } +SBExploriantsView >> containerRow [ + + ^ SBRow new + color: Color transparent; + vResizing: #shrinkWrap; + hResizing: #shrinkWrap; + cellPositioning: #topLeft; + changeTableLayout; + listDirection: #leftToRight; + layoutInset: 1; + borderWidth: 0 +] + +{ #category : #accessing } +SBExploriantsView >> findExistingOrConvertToBlocks: aCollectionOfCompiledMethods [ + + ^ aCollectionOfCompiledMethods + collect: [:aCompiledMethod | + SBEditor current blockFor: aCompiledMethod withInterfaces: #(#isMethod) + ifOpen: [:existingMethodBlock | existingMethodBlock] + ifClosed: [aCompiledMethod asSandblock]] +] + +{ #category : #initialization } +SBExploriantsView >> initialize [ + + super initialize. + + self block: (SBBlock new + changeTableLayout; + color: Color white; + listDirection: #topToBottom; + layoutInset: 8; + cellGap: 16; + cellInset: 10; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap) +] + +{ #category : #actions } +SBExploriantsView >> visualize [ + + self subclassResponsibility +] diff --git a/packages/Sandblocks-Core/SBResultsView.class.st b/packages/Sandblocks-Core/SBResultsView.class.st new file mode 100644 index 00000000..dfd8453e --- /dev/null +++ b/packages/Sandblocks-Core/SBResultsView.class.st @@ -0,0 +1,101 @@ +Class { + #name : #SBResultsView, + #superclass : #SBExploriantsView, + #instVars : [ + 'variants' + ], + #category : #'Sandblocks-Core' +} + +{ #category : #accessing } +SBResultsView >> allActiveExamples [ + + ^ (self allCompiledMethodsContainingExamples + collect: [:aCompiledMethod | + "Only examples which are open in the editor can actually be active." + SBEditor current blockFor: aCompiledMethod withInterfaces: #(#isMethod) + ifOpen: [:existingMethodBlock | existingMethodBlock containedExamples select: #active] + ifClosed: [#()]]) flatten +] + +{ #category : #accessing } +SBResultsView >> allCompiledMethodsContainingExampleWatches [ + + ^ self allCompiledMethodsContainingClass: SBExampleWatch +] + +{ #category : #accessing } +SBResultsView >> allCompiledMethodsContainingExamples [ + + ^ self allCompiledMethodsContainingClass: SBExample +] + +{ #category : #accessing } +SBResultsView >> allMethodBlocksContainingWatches [ + + "We need existing originals to be noticed of changes." + ^ self findExistingOrConvertToBlocks: self allCompiledMethodsContainingExampleWatches + +] + +{ #category : #accessing } +SBResultsView >> allWatchesIn: aCollectionOfMethodBlocks [ + + ^ (aCollectionOfMethodBlocks collect: [:aMethodBlock | + aMethodBlock containedExampleWatches collect: #asInactiveCopy]) flatten +] + +{ #category : #building } +SBResultsView >> buildAllPossibleResults [ + + | permutations activeExamples watchMethodBlocks | + self flag: #todo. "don't calculate all variants a second time (first time being the variants view) -jb" + variants := (self allMethodBlocksContainingVariants collect: #containedVariants) flatten. + watchMethodBlocks := self allMethodBlocksContainingWatches. + activeExamples := self allActiveExamples. + permutations := SBPermutation allPermutationsOf: variants. + + [ permutations do: [:aPermutation | + SBActiveVariantPermutation value: aPermutation. + activeExamples do: #basicRunSynchronously. + self buildPermutationFor: aPermutation collectingWatchesFrom: watchMethodBlocks]] + forkAt: Processor userSchedulingPriority +] + +{ #category : #building } +SBResultsView >> buildPermutationFor: aPermutation collectingWatchesFrom: aCollectionOfMethodBlocks [ + + self block addMorphBack: (self titleMorphForPermutation: aPermutation). + self block addMorphBack: ( + self containerRow + addMorphBack: ((self containerRow listDirection: #leftToRight) + addAllMorphsBack: (self allWatchesIn: aCollectionOfMethodBlocks))). + self block addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2) +] + +{ #category : #initialization } +SBResultsView >> initialize [ + + super initialize. + + self name: 'Possible Results'. + + self visualize +] + +{ #category : #building } +SBResultsView >> titleMorphForPermutation: aPermutation [ + + "collecting instead of calling (a active name), ', ', (b active name) in fold + as one variant only will not return a string but a variant" + ^ SBOwnTextMorph new contents: ( + (aPermutation referencedVariants collect: [:aVariant | + (aVariant blockAt: (aPermutation at: aVariant id)) name]) + fold: [:a :b | a, ', ', b ]) +] + +{ #category : #actions } +SBResultsView >> visualize [ + + self buildAllPossibleResults +] diff --git a/packages/Sandblocks-Core/SBTabView.class.st b/packages/Sandblocks-Core/SBTabView.class.st index 21ba61ef..11b2d5ff 100644 --- a/packages/Sandblocks-Core/SBTabView.class.st +++ b/packages/Sandblocks-Core/SBTabView.class.st @@ -160,6 +160,12 @@ SBTabView >> asTabButton: aNamedBlock [ ^ button ] +{ #category : #accessing } +SBTabView >> blockAt: anIndex [ + + ^ self namedBlocks at: anIndex +] + { #category : #ui } SBTabView >> buildTabs [ @@ -396,6 +402,12 @@ SBTabView >> switchCommandFor: aNumber oldValue: oldNumber [ oldValue: oldNumber ] +{ #category : #accessing } +SBTabView >> tabCount [ + + ^ self namedBlocks size +] + { #category : #accessing } SBTabView >> tabs [ diff --git a/packages/Sandblocks-Core/SBVariantsView.class.st b/packages/Sandblocks-Core/SBVariantsView.class.st new file mode 100644 index 00000000..6e0ea858 --- /dev/null +++ b/packages/Sandblocks-Core/SBVariantsView.class.st @@ -0,0 +1,30 @@ +Class { + #name : #SBVariantsView, + #superclass : #SBExploriantsView, + #category : #'Sandblocks-Core' +} + +{ #category : #building } +SBVariantsView >> buildMethodSectionFor: aSBStMethod [ + + self block addMorphBack: aSBStMethod methodHeader copy. + self block addMorphBack: (self containerRow + addAllMorphsBack: (aSBStMethod containedVariants collect: #asProxy)). + self block addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2). +] + +{ #category : #initialization } +SBVariantsView >> initialize [ + + super initialize. + + self name: 'Variant Manager'. + + self visualize +] + +{ #category : #actions } +SBVariantsView >> visualize [ + + self allMethodBlocksContainingVariants do: [:aSBStMethod | self buildMethodSectionFor: aSBStMethod] +] diff --git a/packages/Sandblocks-Smalltalk/SBPermutation.class.st b/packages/Sandblocks-Smalltalk/SBPermutation.class.st new file mode 100644 index 00000000..605212dc --- /dev/null +++ b/packages/Sandblocks-Smalltalk/SBPermutation.class.st @@ -0,0 +1,46 @@ +" +helper class w/ synctactic sugars for variant -> alternative index dictionary +" +Class { + #name : #SBPermutation, + #superclass : #Dictionary, + #type : #variable, + #instVars : [ + 'referencedVariants' + ], + #category : #'Sandblocks-Smalltalk' +} + +{ #category : #utils } +SBPermutation class >> allPermutationsOf: aCollectionOfVariants [ + + "Returns a Collection of Collections containing indexes of alternatives, + e.g. a collection of two Variants, with A having 2 alternatives and B having 3, would result in + #( (A->1 B->1) (A->1 B->2) (A->1 B->3) + (A->2 B->1) (A->2 B->2) (A->2 B->3))" + | permutations | + permutations := (1 to: aCollectionOfVariants first alternativesCount) + collect: [:anIndex | {anIndex}]. + + (2 to: aCollectionOfVariants size) do: [:i | | alternatives | + alternatives := (aCollectionOfVariants at: i) alternativesCount. + permutations := permutations gather: [:aCollectionOfIndexes | + (1 to: alternatives) collect: [:aTabIndex | + {aCollectionOfIndexes. aTabIndex} flatten]]]. + + ^ permutations collect: [:aCollectionOfIndexes | + (self withAll: (aCollectionOfIndexes withIndexCollect: [:anAlternativeIndex :aVariantIndex | + (aCollectionOfVariants at: aVariantIndex) id -> anAlternativeIndex])) + referencedVariants: aCollectionOfVariants] + +] + +{ #category : #accessing } +SBPermutation >> referencedVariants [ + ^ referencedVariants +] + +{ #category : #accessing } +SBPermutation >> referencedVariants: anObject [ + referencedVariants := anObject +] diff --git a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st index 14ab188d..77b88ccf 100644 --- a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st @@ -223,6 +223,18 @@ SBStBasicMethod >> compiledMethod [ ifAbsent: [self] ] +{ #category : #accessing } +SBStBasicMethod >> containedExampleWatches [ + + ^ self body containedExampleWatches +] + +{ #category : #accessing } +SBStBasicMethod >> containedExamples [ + + ^ self body containedExamples +] + { #category : #accessing } SBStBasicMethod >> containedVariants [ diff --git a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st index 2a171617..a31b572d 100644 --- a/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBlockBody.class.st @@ -125,6 +125,18 @@ SBStBlockBody >> cellGap [ ^ self colorPolicy lineGap ] +{ #category : #accessing } +SBStBlockBody >> containedExampleWatches [ + + ^ self allBlocksSelect: #isExampleWatch +] + +{ #category : #accessing } +SBStBlockBody >> containedExamples [ + + ^ self allBlocksSelect: #isExample +] + { #category : #accessing } SBStBlockBody >> containedVariants [ diff --git a/packages/Sandblocks-Smalltalk/SBVariant.class.st b/packages/Sandblocks-Smalltalk/SBVariant.class.st index 2dbda922..1c56c817 100644 --- a/packages/Sandblocks-Smalltalk/SBVariant.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariant.class.st @@ -33,13 +33,13 @@ SBVariant class >> matches: aBlock [ ^ aBlock receiver isBinding and: [aBlock receiver contents = 'SBVariant'] - and: [aBlock selector = self matchingSelector] + and: [aBlock selector = self matchingSelectors first] ] { #category : #constants } -SBVariant class >> matchingSelector [ +SBVariant class >> matchingSelectors [ - ^ #named:associations:activeIndex:id: + ^ #(#named:associations:activeIndex:id:) ] { #category : #'instance creation' } @@ -66,7 +66,10 @@ SBVariant class >> named: aString alternatives: aCollectionOfNamedBlocks activeI { #category : #'instance creation' } SBVariant class >> named: aString associations: aCollectionOfAssociations activeIndex: aNumber id: uuid [ - ^ aNumber > 0 ifTrue: [(aCollectionOfAssociations at: aNumber) value value] ifFalse: [nil] + aNumber > 0 ifFalse: [^ nil]. + ^ SBActiveVariantPermutation value + ifNil: [(aCollectionOfAssociations at: aNumber) value value] + ifNotNil: [(aCollectionOfAssociations at: (SBActiveVariantPermutation value at: uuid)) value value]. ] @@ -123,6 +126,12 @@ SBVariant >> alternatives [ ^ self widget namedBlocks ] +{ #category : #accessing } +SBVariant >> alternativesCount [ + + ^ self widget tabCount +] + { #category : #comparing } SBVariant >> alternativesEqual: otherAlternatives [ @@ -135,6 +144,18 @@ SBVariant >> alternativesEqual: otherAlternatives [ areSame := areSame and: [(self alternatives at: index) = (otherAlternatives at: index)]]. areSame] ] +{ #category : #converting } +SBVariant >> asProxy [ + + ^ SBVariantProxy for: self +] + +{ #category : #accessing } +SBVariant >> blockAt: anIndex [ + + ^ self widget blockAt: anIndex +] + { #category : #accessing } SBVariant >> color [ @@ -245,6 +266,12 @@ SBVariant >> replaceValuesFrom: anotherVariant [ self named: anotherVariant name alternatives: anotherVariant alternatives activeIndex: anotherVariant activeIndex ] +{ #category : #actions } +SBVariant >> switchToAlternative: anIndex [ + + self widget jumpToTab: anIndex +] + { #category : #ui } SBVariant >> updateResize [ diff --git a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st index 566e32ab..e3accdba 100644 --- a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st @@ -70,6 +70,12 @@ SBVariantProxy >> isArtefact [ ^ true ] +{ #category : #accessing } +SBVariantProxy >> original [ + + ^ original +] + { #category : #'artefact protocol' } SBVariantProxy >> saveTryFixing: aFixBoolean quick: aQuickBoolean [ diff --git a/packages/Sandblocks-Watch/SBExampleWatchView.class.st b/packages/Sandblocks-Watch/SBExampleWatchView.class.st index f09f1b75..8da392aa 100644 --- a/packages/Sandblocks-Watch/SBExampleWatchView.class.st +++ b/packages/Sandblocks-Watch/SBExampleWatchView.class.st @@ -36,10 +36,18 @@ SBExampleWatchView >> reportValue: anObject [ updateScheduled := true ] +{ #category : #accessing } +SBExampleWatchView >> reportValues: aCollectionOfObjects [ + + aCollectionOfObjects do: [:anObject | self addValue: anObject]. + + updateScheduled := true +] + { #category : #display } SBExampleWatchView >> updateDisplay [ super updateDisplay. - count contents: (watchValues size) asString + self count: (watchValues size) asString ] diff --git a/packages/Sandblocks-Watch/SBWatchView.class.st b/packages/Sandblocks-Watch/SBWatchView.class.st index 89693822..f2fc01cd 100644 --- a/packages/Sandblocks-Watch/SBWatchView.class.st +++ b/packages/Sandblocks-Watch/SBWatchView.class.st @@ -19,7 +19,6 @@ Class { { #category : #'as yet unclassified' } SBWatchView class >> saving: anInteger [ "Any value < 1 will result in saving all reported values" - ^ self new numSavedValues: anInteger ] @@ -74,6 +73,12 @@ SBWatchView >> count [ ^ count contents ] +{ #category : #accessing } +SBWatchView >> count: aNumber [ + + count contents: aNumber asString +] + { #category : #display } SBWatchView >> defaultDisplay [ @@ -181,12 +186,6 @@ SBWatchView >> maxWidth [ ^ 450 ] -{ #category : #'event handling' } -SBWatchView >> noValue [ - - self scroller removeAllMorphs -] - { #category : #accessing } SBWatchView >> numSavedValues: anInteger [ "Private" @@ -224,6 +223,27 @@ SBWatchView >> reportValue: anObject [ Project current addDeferredUIMessage: [self updateDisplay]] ] +{ #category : #accessing } +SBWatchView >> reportValues: aCollectionOfObjects [ + + aCollectionOfObjects do: [:anObject | self addValue: anObject]. + self count: self count contents + aCollectionOfObjects size. + + updateScheduled ifFalse: [ + updateScheduled := true. + Project current addDeferredUIMessage: [self updateDisplay]] +] + +{ #category : #display } +SBWatchView >> reset [ + + self useDisplay: self defaultDisplay. + updateScheduled := false. + watchValues := LinkedList new. + count contents: '0'. + +] + { #category : #accessing } SBWatchView >> scrollBarHeight [ From 550261a31875756dc99c566362d0f46a874fba86 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Tue, 12 Sep 2023 14:45:05 +0200 Subject: [PATCH 08/15] Adds apply permutation, adds regenerate --- .../SBExploriantsView.class.st | 10 ++-- .../Sandblocks-Core/SBResultsView.class.st | 47 ++++++++++++------- .../Sandblocks-Core/SBVariantsView.class.st | 2 + .../SBPermutation.class.st | 22 +++++++++ 4 files changed, 61 insertions(+), 20 deletions(-) diff --git a/packages/Sandblocks-Core/SBExploriantsView.class.st b/packages/Sandblocks-Core/SBExploriantsView.class.st index b437d021..2ca58a9e 100644 --- a/packages/Sandblocks-Core/SBExploriantsView.class.st +++ b/packages/Sandblocks-Core/SBExploriantsView.class.st @@ -34,7 +34,7 @@ SBExploriantsView >> allCompiledMethodsContainingVariants [ ^ self allCompiledMethodsContainingClass: SBVariant ] -{ #category : #'as yet unclassified' } +{ #category : #accessing } SBExploriantsView >> allMethodBlocksContainingVariants [ "We are looking for already opened methods so that we can assign the @@ -60,7 +60,9 @@ SBExploriantsView >> containerRow [ cellPositioning: #topLeft; changeTableLayout; listDirection: #leftToRight; - layoutInset: 1; + layoutInset: 8; + cellGap: 8; + cellInset: 5; borderWidth: 0 ] @@ -84,8 +86,8 @@ SBExploriantsView >> initialize [ color: Color white; listDirection: #topToBottom; layoutInset: 8; - cellGap: 16; - cellInset: 10; + cellGap: 8; + cellInset: 5; hResizing: #shrinkWrap; vResizing: #shrinkWrap) ] diff --git a/packages/Sandblocks-Core/SBResultsView.class.st b/packages/Sandblocks-Core/SBResultsView.class.st index dfd8453e..4aa32e56 100644 --- a/packages/Sandblocks-Core/SBResultsView.class.st +++ b/packages/Sandblocks-Core/SBResultsView.class.st @@ -1,9 +1,6 @@ Class { #name : #SBResultsView, #superclass : #SBExploriantsView, - #instVars : [ - 'variants' - ], #category : #'Sandblocks-Core' } @@ -45,10 +42,24 @@ SBResultsView >> allWatchesIn: aCollectionOfMethodBlocks [ aMethodBlock containedExampleWatches collect: #asInactiveCopy]) flatten ] +{ #category : #building } +SBResultsView >> applyButtonFor: aPermutation [ + + self flag: #todo. "should check if there were any changes to the variants before applying -jb" + ^ SBButton new + icon: (SBIcon iconCheck + size: 6.0 sbScaled; + color: (Color r: 0.0 g: 1 b: 0.0)) + label: 'Apply Permutation' + do: [aPermutation apply]; + makeSmall; + cornerStyle: #squared +] + { #category : #building } SBResultsView >> buildAllPossibleResults [ - | permutations activeExamples watchMethodBlocks | + | permutations activeExamples watchMethodBlocks variants | self flag: #todo. "don't calculate all variants a second time (first time being the variants view) -jb" variants := (self allMethodBlocksContainingVariants collect: #containedVariants) flatten. watchMethodBlocks := self allMethodBlocksContainingWatches. @@ -65,11 +76,13 @@ SBResultsView >> buildAllPossibleResults [ { #category : #building } SBResultsView >> buildPermutationFor: aPermutation collectingWatchesFrom: aCollectionOfMethodBlocks [ - self block addMorphBack: (self titleMorphForPermutation: aPermutation). + self block addMorphBack: (SBOwnTextMorph new contents: aPermutation asString). + self block addMorphBack: (self applyButtonFor: aPermutation). + self block addMorphBack: ( - self containerRow - addMorphBack: ((self containerRow listDirection: #leftToRight) - addAllMorphsBack: (self allWatchesIn: aCollectionOfMethodBlocks))). + (self containerRow listDirection: #leftToRight) + addAllMorphsBack: (self allWatchesIn: aCollectionOfMethodBlocks)). + self block addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2) ] @@ -84,18 +97,20 @@ SBResultsView >> initialize [ ] { #category : #building } -SBResultsView >> titleMorphForPermutation: aPermutation [ - - "collecting instead of calling (a active name), ', ', (b active name) in fold - as one variant only will not return a string but a variant" - ^ SBOwnTextMorph new contents: ( - (aPermutation referencedVariants collect: [:aVariant | - (aVariant blockAt: (aPermutation at: aVariant id)) name]) - fold: [:a :b | a, ', ', b ]) +SBResultsView >> updateButton [ + + ^ SBButton new + icon: SBIcon iconRotateLeft + label: 'Re-Generate' + do: [self visualize]; + cornerStyle: #squared ] { #category : #actions } SBResultsView >> visualize [ + self clean. + + self block addMorphBack: self updateButton. self buildAllPossibleResults ] diff --git a/packages/Sandblocks-Core/SBVariantsView.class.st b/packages/Sandblocks-Core/SBVariantsView.class.st index 6e0ea858..1dfde0b6 100644 --- a/packages/Sandblocks-Core/SBVariantsView.class.st +++ b/packages/Sandblocks-Core/SBVariantsView.class.st @@ -26,5 +26,7 @@ SBVariantsView >> initialize [ { #category : #actions } SBVariantsView >> visualize [ + self clean. + self allMethodBlocksContainingVariants do: [:aSBStMethod | self buildMethodSectionFor: aSBStMethod] ] diff --git a/packages/Sandblocks-Smalltalk/SBPermutation.class.st b/packages/Sandblocks-Smalltalk/SBPermutation.class.st index 605212dc..9b1188a9 100644 --- a/packages/Sandblocks-Smalltalk/SBPermutation.class.st +++ b/packages/Sandblocks-Smalltalk/SBPermutation.class.st @@ -35,12 +35,34 @@ SBPermutation class >> allPermutationsOf: aCollectionOfVariants [ ] +{ #category : #actions } +SBPermutation >> apply [ + + self referencedVariants do: [:aVariant | aVariant switchToAlternative: (self at: aVariant id)]. + (Set newFrom: (referencedVariants collect: #containingArtefact thenSelect: #isMethod)) + do: [:aMethodBlock | SBEditor current save: aMethodBlock tryFixing: true quick: true]. +] + +{ #category : #converting } +SBPermutation >> asString [ + + "collecting instead of calling (a active name), ', ', (b active name) in fold + as one variant only will not return a string but a variant" + ^ (self referencedVariants collect: [:aVariant | + (aVariant blockAt: (self at: aVariant id)) name]) + fold: [:a :b | a, ', ', b ] + + +] + { #category : #accessing } SBPermutation >> referencedVariants [ + ^ referencedVariants ] { #category : #accessing } SBPermutation >> referencedVariants: anObject [ + referencedVariants := anObject ] From 5176c2ef0aeaae7e7b3cb529e2c2099c92eae0db Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Tue, 12 Sep 2023 17:26:48 +0200 Subject: [PATCH 09/15] Can now reapply modify expression in exploriant watches --- .../SBExampleWatch.class.st | 31 +++++++++++++++++-- .../Sandblocks-Core/SBExploriants.class.st | 12 +++++++ .../Sandblocks-Core/SBResultsView.class.st | 10 +++++- 3 files changed, 49 insertions(+), 4 deletions(-) diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st index 208106b9..dda80798 100644 --- a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st @@ -115,8 +115,7 @@ SBExampleWatch >> applyModifyExpressionOnValues [ anExampleDisplayPair value reportValues: (self modifiedValuesFor: anExampleDisplayPair key) name: (anExampleDisplayPair key ifNotNil: #label ifNil: ['']). - anExampleDisplayPair value updateDisplay. - ] + anExampleDisplayPair value updateDisplay] ] { #category : #callbacks } @@ -211,6 +210,18 @@ SBExampleWatch >> exampleStopped: anExample [ exampleToDisplay removeKey: anExample] ] +{ #category : #accessing } +SBExampleWatch >> exampleToDisplay: anExampleToDisplayDict [ + + exampleToDisplay := anExampleToDisplayDict +] + +{ #category : #accessing } +SBExampleWatch >> exampleToValues: anExampleToCollectionOfObjectsDict [ + + exampleToValues := anExampleToCollectionOfObjectsDict +] + { #category : #accessing } SBExampleWatch >> expression [ @@ -296,6 +307,13 @@ SBExampleWatch >> isWatch [ ^ true ] +{ #category : #copying } +SBExampleWatch >> keepKeysDeepCopyValuesOf: aDictionary [ + + ^ Dictionary newFrom: ( + aDictionary associations collect: [:aKeyValuePair | aKeyValuePair key -> aKeyValuePair value sbSnapshot ]) +] + { #category : #layout } SBExampleWatch >> layoutCommands [ @@ -383,6 +401,7 @@ SBExampleWatch >> valuesForExample: anExample [ SBExampleWatch >> veryDeepCopyWith: deepCopier [ " assure that copies of us have a unique id " + " disregarding deep copy of dictionaries to avoid duplicating examples" | new oldExampleDisplays oldExampleValues | oldExampleDisplays := exampleToDisplay. oldExampleValues := exampleToValues. @@ -391,8 +410,14 @@ SBExampleWatch >> veryDeepCopyWith: deepCopier [ new := super veryDeepCopyWith: deepCopier. exampleToDisplay := oldExampleDisplays. - exampleToValues := exampleToValues. + exampleToValues := oldExampleValues. + new newIdentifier. + new exampleToDisplay: (Dictionary newFrom: + (exampleToDisplay keys withIndexCollect: [:anExample :i | anExample -> (new submorphs at: (i + 1))])). + new exampleToValues: (Dictionary newFrom: ( + oldExampleValues associations collect: [:aKeyValuePair | aKeyValuePair key -> aKeyValuePair value sbSnapshot ])). + ^ new ] diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st index c14573be..9926653f 100644 --- a/packages/Sandblocks-Core/SBExploriants.class.st +++ b/packages/Sandblocks-Core/SBExploriants.class.st @@ -48,6 +48,18 @@ SBExploriants >> initialize [ vResizing: #shrinkWrap ] +{ #category : #testing } +SBExploriants >> isArtefact [ + + ^ true +] + +{ #category : #'as yet unclassified' } +SBExploriants >> saveTryFixing: aFixBoolean quick: aQuickBoolean [ + + ^ true +] + { #category : #actions } SBExploriants >> visualize [ diff --git a/packages/Sandblocks-Core/SBResultsView.class.st b/packages/Sandblocks-Core/SBResultsView.class.st index 4aa32e56..f7aa9d47 100644 --- a/packages/Sandblocks-Core/SBResultsView.class.st +++ b/packages/Sandblocks-Core/SBResultsView.class.st @@ -69,7 +69,8 @@ SBResultsView >> buildAllPossibleResults [ [ permutations do: [:aPermutation | SBActiveVariantPermutation value: aPermutation. activeExamples do: #basicRunSynchronously. - self buildPermutationFor: aPermutation collectingWatchesFrom: watchMethodBlocks]] + self buildPermutationFor: aPermutation collectingWatchesFrom: watchMethodBlocks]. + self resetWatchesToOriginalPermutationRunning: activeExamples] forkAt: Processor userSchedulingPriority ] @@ -96,6 +97,13 @@ SBResultsView >> initialize [ self visualize ] +{ #category : #building } +SBResultsView >> resetWatchesToOriginalPermutationRunning: activeExamples [ + + SBActiveVariantPermutation value: nil. + activeExamples do: #basicRunSynchronously +] + { #category : #building } SBResultsView >> updateButton [ From f74b2b5213cbc65ccb052d8acd4faf0e106684eb Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Tue, 12 Sep 2023 18:44:48 +0200 Subject: [PATCH 10/15] Adds extra check before assuming compiledMethod of SBStBasicMethod is not self --- packages/Sandblocks-Core/SBExploriantsView.class.st | 10 +++++----- packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st | 4 +++- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/packages/Sandblocks-Core/SBExploriantsView.class.st b/packages/Sandblocks-Core/SBExploriantsView.class.st index 2ca58a9e..bdfc7e66 100644 --- a/packages/Sandblocks-Core/SBExploriantsView.class.st +++ b/packages/Sandblocks-Core/SBExploriantsView.class.st @@ -61,8 +61,8 @@ SBExploriantsView >> containerRow [ changeTableLayout; listDirection: #leftToRight; layoutInset: 8; - cellGap: 8; - cellInset: 5; + cellGap: 3; + cellInset: 3; borderWidth: 0 ] @@ -85,9 +85,9 @@ SBExploriantsView >> initialize [ changeTableLayout; color: Color white; listDirection: #topToBottom; - layoutInset: 8; - cellGap: 8; - cellInset: 5; + layoutInset: 3; + cellGap: 4; + cellInset: 2; hResizing: #shrinkWrap; vResizing: #shrinkWrap) ] diff --git a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st index 77b88ccf..fffef494 100644 --- a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st @@ -23,7 +23,9 @@ SBStBasicMethod class >> selector: aSymbol arguments: aCollection class: aClass { #category : #comparing } SBStBasicMethod >> = anotherSBStBasicMethod [ - ^ anotherSBStBasicMethod class = self class and: [anotherSBStBasicMethod compiledMethod equivalentTo: self compiledMethod] + ^ anotherSBStBasicMethod class == self class + and: [anotherSBStBasicMethod compiledMethod ~= anotherSBStBasicMethod] + and: [anotherSBStBasicMethod compiledMethod equivalentTo: self compiledMethod] ] { #category : #accessing } From 6107a8b65d7728bdafee57c6fafe7c753274c481 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Mon, 18 Sep 2023 15:09:40 +0200 Subject: [PATCH 11/15] Exploriants as tab view --- .../SBExampleWatch.class.st | 12 -------- .../Sandblocks-Core/SBExploriants.class.st | 6 ++-- .../SBExploriantsView.class.st | 8 ++++- packages/Sandblocks-Core/SBTabView.class.st | 2 +- .../SBPermutation.class.st | 2 +- .../Sandblocks-Smalltalk/SBVariant.class.st | 30 +++++++++++++++---- 6 files changed, 36 insertions(+), 24 deletions(-) diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st index dda80798..a984e2ab 100644 --- a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st @@ -132,20 +132,8 @@ SBExampleWatch >> asInactiveCopy [ ^ (self veryDeepCopy) beInactive. ] -{ #category : #accessing } -SBExampleWatch >> beActive [ - - - self flag: #todo. "action for debugging, remove later. bc when applying modification and - then turning inactive, the already modified values are seen as the ground truth. - is aber allgemein ein problemchen....eig sollten die watchviews die wahren values haben und nur - die modifizierten anzeigen." - isActive := true -] - { #category : #accessing } SBExampleWatch >> beInactive [ - isActive := false ] diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st index 9926653f..6b491ddf 100644 --- a/packages/Sandblocks-Core/SBExploriants.class.st +++ b/packages/Sandblocks-Core/SBExploriants.class.st @@ -1,6 +1,6 @@ Class { #name : #SBExploriants, - #superclass : #SBBlock, + #superclass : #SBTabView, #instVars : [ 'watchMethodBlocks', 'variants', @@ -63,7 +63,5 @@ SBExploriants >> saveTryFixing: aFixBoolean quick: aQuickBoolean [ { #category : #actions } SBExploriants >> visualize [ - self submorphs copy do: #delete. - - self addMorphBack: SBExploriantsView asTabView. + self namedBlocks: SBExploriantsView getTabs activeIndex: 1 ] diff --git a/packages/Sandblocks-Core/SBExploriantsView.class.st b/packages/Sandblocks-Core/SBExploriantsView.class.st index bdfc7e66..ca655991 100644 --- a/packages/Sandblocks-Core/SBExploriantsView.class.st +++ b/packages/Sandblocks-Core/SBExploriantsView.class.st @@ -7,7 +7,7 @@ Class { { #category : #'instance creation' } SBExploriantsView class >> asTabView [ - ^ SBTabView + ^ SBExploriants namedBlocks: (self subclasses collect: #new) activeIndex: 1 ] @@ -19,6 +19,12 @@ SBExploriantsView class >> block: aSBBlock named: aString [ self shouldNotImplement ] +{ #category : #'instance creation' } +SBExploriantsView class >> getTabs [ + + ^ self subclasses collect: #new +] + { #category : #accessing } SBExploriantsView >> allCompiledMethodsContainingClass: aClass [ diff --git a/packages/Sandblocks-Core/SBTabView.class.st b/packages/Sandblocks-Core/SBTabView.class.st index 11b2d5ff..d94f08cd 100644 --- a/packages/Sandblocks-Core/SBTabView.class.st +++ b/packages/Sandblocks-Core/SBTabView.class.st @@ -377,7 +377,7 @@ SBTabView >> removeCurrentTab [ { #category : #tabs } SBTabView >> setActive: aNamedBlock [ - self sandblockEditor do: + SBEditor current do: (self switchCommandFor: (self namedBlocks indexOf: aNamedBlock ifAbsent: 1)) ] diff --git a/packages/Sandblocks-Smalltalk/SBPermutation.class.st b/packages/Sandblocks-Smalltalk/SBPermutation.class.st index 9b1188a9..c410de51 100644 --- a/packages/Sandblocks-Smalltalk/SBPermutation.class.st +++ b/packages/Sandblocks-Smalltalk/SBPermutation.class.st @@ -49,7 +49,7 @@ SBPermutation >> asString [ "collecting instead of calling (a active name), ', ', (b active name) in fold as one variant only will not return a string but a variant" ^ (self referencedVariants collect: [:aVariant | - (aVariant blockAt: (self at: aVariant id)) name]) + aVariant name, ': ', (aVariant blockAt: (self at: aVariant id)) name]) fold: [:a :b | a, ', ', b ] diff --git a/packages/Sandblocks-Smalltalk/SBVariant.class.st b/packages/Sandblocks-Smalltalk/SBVariant.class.st index 1c56c817..1b270ee9 100644 --- a/packages/Sandblocks-Smalltalk/SBVariant.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariant.class.st @@ -156,6 +156,14 @@ SBVariant >> blockAt: anIndex [ ^ self widget blockAt: anIndex ] +{ #category : #accessing } +SBVariant >> codeFor: aNamedBlock [ + + ^ (aNamedBlock block submorphs size > 1) + ifTrue: [aNamedBlock block lastSubmorph] + ifFalse: [nil] +] + { #category : #accessing } SBVariant >> color [ @@ -242,22 +250,32 @@ SBVariant >> namedBlocks [ { #category : #actions } SBVariant >> replaceSelfWithBlock: aNamedBlock [ + | command | "As deleting the last tab also deletes the tab view, we gotta recreate it" self widget: (SBTabView namedBlocks: {aNamedBlock} activeIndex: 1). self addMorphBack: widget. - self sandblockEditor do: (SBUnwrapConsecutiveCommand new + command := (self codeFor: widget active) + ifNil: [SBDeleteCommand new target: self] + ifNotNil: [SBUnwrapConsecutiveCommand new target: self; - unwrapped: {widget activeBlock lastSubmorph}) + unwrapped: {(self codeFor: widget active)}]. + + self sandblockEditor do: command ] { #category : #actions } SBVariant >> replaceSelfWithChosen [ - self sandblockEditor do: (SBUnwrapConsecutiveCommand new + | command | + command := (self codeFor: widget active) + ifNil: [SBDeleteCommand new target: self] + ifNotNil: [SBUnwrapConsecutiveCommand new target: self; - unwrapped: {self activeBlock lastSubmorph}) + unwrapped: {(self codeFor: widget active)}]. + + self sandblockEditor do: command ] { #category : #initialization } @@ -306,7 +324,9 @@ SBVariant >> writeSourceOn: aStream [ do: [:aNamedBlock | aNamedBlock name storeOn: aStream. aStream nextPutAll: ' -> ['. - aNamedBlock block lastSubmorph writeSourceOn: aStream. + (self codeFor: aNamedBlock) + ifNotNil: [(self codeFor: aNamedBlock) writeSourceOn: aStream] + ifNil: [aStream nextPutAll: ' ']. aStream nextPut: $]. ] separatedBy: [aStream nextPut: $.]. From 1c409aa11393822b6c062c1cf68fff4fac47b15a Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Mon, 18 Sep 2023 16:12:23 +0200 Subject: [PATCH 12/15] Cleanup --- .../Sandblocks-Babylonian/SBExample.class.st | 29 +++++++++---------- .../SBExampleWatch.class.st | 6 ---- .../Sandblocks-Core/SBExploriants.class.st | 7 +---- .../SBExploriantsView.class.st | 8 ----- .../Sandblocks-Core/SBResultsView.class.st | 21 +++++--------- .../Sandblocks-Core/SBVariantsView.class.st | 8 ++--- .../SBPermutation.class.st | 9 ++---- .../Sandblocks-Smalltalk/SBVariant.class.st | 5 ++-- .../SBVariantProxy.class.st | 5 ++-- .../Sandblocks-Watch/SBWatchView.class.st | 10 ------- 10 files changed, 35 insertions(+), 73 deletions(-) diff --git a/packages/Sandblocks-Babylonian/SBExample.class.st b/packages/Sandblocks-Babylonian/SBExample.class.st index 859aa8a9..fa241a6e 100644 --- a/packages/Sandblocks-Babylonian/SBExample.class.st +++ b/packages/Sandblocks-Babylonian/SBExample.class.st @@ -40,7 +40,7 @@ SBExample class >> matches: aMessage [ and: [#('example:args:label:' 'example:args:label:assert:') includes: aMessage selector]] ] -{ #category : #'as yet unclassified' } +{ #category : #constants } SBExample class >> matchingSelectors [ ^ #(#self:args:label: #self:args:label:assert: #example:args:label: #example:args:label:assert:) @@ -125,19 +125,6 @@ SBExample >> assertionBlock [ ^ self submorphCount > 7 ifTrue: [self submorphs ninth] ifFalse: [nil] ] -{ #category : #'as yet unclassified' } -SBExample >> basicRunSynchronously [ - - | returned | - self sendStartNotification. - - SBExecutionEnvironment value: self. - [returned := self evaluate] on: Error do: [:e | self scheduleLastError: e. "^ self ?" ]. - self scheduleLastError: nil. - - self sendFinishNotification. -] - { #category : #'as yet unclassified' } SBExample >> click: anEvent [ @@ -416,7 +403,6 @@ SBExample >> runOnlyThis [ { #category : #'as yet unclassified' } SBExample >> runSetup [ - Transcript show: 'i', Character cr. self containingArtefact valid ifFalse: [^ self]. processRunning ifTrue: [^ self]. currentProcess ifNotNil: #terminate. @@ -426,6 +412,19 @@ SBExample >> runSetup [ returnValue clear. ] +{ #category : #'as yet unclassified' } +SBExample >> runSynchronouslyIgnoreReturn [ + + | returned | + self sendStartNotification. + + SBExecutionEnvironment value: self. + [returned := self evaluate] on: Error do: [:e | self scheduleLastError: e]. + self scheduleLastError: nil. + + self sendFinishNotification. +] + { #category : #'as yet unclassified' } SBExample >> scheduleLastError: anError [ diff --git a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st index a984e2ab..c45b8b30 100644 --- a/packages/Sandblocks-Babylonian/SBExampleWatch.class.st +++ b/packages/Sandblocks-Babylonian/SBExampleWatch.class.st @@ -26,12 +26,6 @@ SBExampleWatch class >> matches: aBlock [ ^ (aBlock receiver satisfies: #(notNil isBinding)) and: [aBlock receiver contents = self name] and: [aBlock selector = self matchingSelectors first] ] -{ #category : #constants } -SBExampleWatch class >> matchingSelector [ - - ^ #report:for:modifying: -] - { #category : #constants } SBExampleWatch class >> matchingSelectors [ diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Core/SBExploriants.class.st index 6b491ddf..447e7450 100644 --- a/packages/Sandblocks-Core/SBExploriants.class.st +++ b/packages/Sandblocks-Core/SBExploriants.class.st @@ -1,11 +1,6 @@ Class { #name : #SBExploriants, #superclass : #SBTabView, - #instVars : [ - 'watchMethodBlocks', - 'variants', - 'activeExamples' - ], #classInstVars : [ 'uniqueInstance' ], @@ -54,7 +49,7 @@ SBExploriants >> isArtefact [ ^ true ] -{ #category : #'as yet unclassified' } +{ #category : #'artefact protocol' } SBExploriants >> saveTryFixing: aFixBoolean quick: aQuickBoolean [ ^ true diff --git a/packages/Sandblocks-Core/SBExploriantsView.class.st b/packages/Sandblocks-Core/SBExploriantsView.class.st index ca655991..8542cee8 100644 --- a/packages/Sandblocks-Core/SBExploriantsView.class.st +++ b/packages/Sandblocks-Core/SBExploriantsView.class.st @@ -4,14 +4,6 @@ Class { #category : #'Sandblocks-Core' } -{ #category : #'instance creation' } -SBExploriantsView class >> asTabView [ - - ^ SBExploriants - namedBlocks: (self subclasses collect: #new) - activeIndex: 1 -] - { #category : #'instance creation' } SBExploriantsView class >> block: aSBBlock named: aString [ diff --git a/packages/Sandblocks-Core/SBResultsView.class.st b/packages/Sandblocks-Core/SBResultsView.class.st index f7aa9d47..e22504cc 100644 --- a/packages/Sandblocks-Core/SBResultsView.class.st +++ b/packages/Sandblocks-Core/SBResultsView.class.st @@ -45,7 +45,6 @@ SBResultsView >> allWatchesIn: aCollectionOfMethodBlocks [ { #category : #building } SBResultsView >> applyButtonFor: aPermutation [ - self flag: #todo. "should check if there were any changes to the variants before applying -jb" ^ SBButton new icon: (SBIcon iconCheck size: 6.0 sbScaled; @@ -68,23 +67,19 @@ SBResultsView >> buildAllPossibleResults [ [ permutations do: [:aPermutation | SBActiveVariantPermutation value: aPermutation. - activeExamples do: #basicRunSynchronously. + activeExamples do: #runSynchronouslyIgnoreReturn. self buildPermutationFor: aPermutation collectingWatchesFrom: watchMethodBlocks]. - self resetWatchesToOriginalPermutationRunning: activeExamples] - forkAt: Processor userSchedulingPriority + self resetWatchesToOriginalPermutationRunning: activeExamples] forkAt: Processor userSchedulingPriority ] { #category : #building } SBResultsView >> buildPermutationFor: aPermutation collectingWatchesFrom: aCollectionOfMethodBlocks [ - self block addMorphBack: (SBOwnTextMorph new contents: aPermutation asString). - self block addMorphBack: (self applyButtonFor: aPermutation). - - self block addMorphBack: ( - (self containerRow listDirection: #leftToRight) - addAllMorphsBack: (self allWatchesIn: aCollectionOfMethodBlocks)). - - self block addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2) + self block addAllMorphsBack: { SBOwnTextMorph new contents: aPermutation asString. + self applyButtonFor: aPermutation. + (self containerRow listDirection: #leftToRight) + addAllMorphsBack: (self allWatchesIn: aCollectionOfMethodBlocks). + LineMorph from: 0@0 to: 50@0 color: Color black width: 2} ] { #category : #initialization } @@ -101,7 +96,7 @@ SBResultsView >> initialize [ SBResultsView >> resetWatchesToOriginalPermutationRunning: activeExamples [ SBActiveVariantPermutation value: nil. - activeExamples do: #basicRunSynchronously + activeExamples do: #runSynchronouslyIgnoreReturn ] { #category : #building } diff --git a/packages/Sandblocks-Core/SBVariantsView.class.st b/packages/Sandblocks-Core/SBVariantsView.class.st index 1dfde0b6..402a5662 100644 --- a/packages/Sandblocks-Core/SBVariantsView.class.st +++ b/packages/Sandblocks-Core/SBVariantsView.class.st @@ -7,10 +7,10 @@ Class { { #category : #building } SBVariantsView >> buildMethodSectionFor: aSBStMethod [ - self block addMorphBack: aSBStMethod methodHeader copy. - self block addMorphBack: (self containerRow - addAllMorphsBack: (aSBStMethod containedVariants collect: #asProxy)). - self block addMorphBack: (LineMorph from: 0@0 to: 50@0 color: Color black width: 2). + self block addAllMorphsBack: {aSBStMethod methodHeader copy. + self containerRow + addAllMorphsBack: (aSBStMethod containedVariants collect: #asProxy). + LineMorph from: 0@0 to: 50@0 color: Color black width: 2} ] { #category : #initialization } diff --git a/packages/Sandblocks-Smalltalk/SBPermutation.class.st b/packages/Sandblocks-Smalltalk/SBPermutation.class.st index c410de51..e39cbb03 100644 --- a/packages/Sandblocks-Smalltalk/SBPermutation.class.st +++ b/packages/Sandblocks-Smalltalk/SBPermutation.class.st @@ -1,5 +1,5 @@ " -helper class w/ synctactic sugars for variant -> alternative index dictionary +A helper class with synctactic sugars for variant id -> alternative index dictionary " Class { #name : #SBPermutation, @@ -14,13 +14,8 @@ Class { { #category : #utils } SBPermutation class >> allPermutationsOf: aCollectionOfVariants [ - "Returns a Collection of Collections containing indexes of alternatives, - e.g. a collection of two Variants, with A having 2 alternatives and B having 3, would result in - #( (A->1 B->1) (A->1 B->2) (A->1 B->3) - (A->2 B->1) (A->2 B->2) (A->2 B->3))" | permutations | - permutations := (1 to: aCollectionOfVariants first alternativesCount) - collect: [:anIndex | {anIndex}]. + permutations := (1 to: aCollectionOfVariants first alternativesCount) collect: #asArray. (2 to: aCollectionOfVariants size) do: [:i | | alternatives | alternatives := (aCollectionOfVariants at: i) alternativesCount. diff --git a/packages/Sandblocks-Smalltalk/SBVariant.class.st b/packages/Sandblocks-Smalltalk/SBVariant.class.st index 1b270ee9..f4418aac 100644 --- a/packages/Sandblocks-Smalltalk/SBVariant.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariant.class.st @@ -66,7 +66,7 @@ SBVariant class >> named: aString alternatives: aCollectionOfNamedBlocks activeI { #category : #'instance creation' } SBVariant class >> named: aString associations: aCollectionOfAssociations activeIndex: aNumber id: uuid [ - aNumber > 0 ifFalse: [^ nil]. + aNumber <= 0 ifTrue: [^ nil]. ^ SBActiveVariantPermutation value ifNil: [(aCollectionOfAssociations at: aNumber) value value] ifNotNil: [(aCollectionOfAssociations at: (SBActiveVariantPermutation value at: uuid)) value value]. @@ -141,7 +141,8 @@ SBVariant >> alternativesEqual: otherAlternatives [ areSame := true. ^ self alternatives size = otherAlternatives size and: [ (1 to: self alternatives size) do: [:index | - areSame := areSame and: [(self alternatives at: index) = (otherAlternatives at: index)]]. areSame] + areSame := areSame and: [(self alternatives at: index) = (otherAlternatives at: index)]]. + areSame] ] { #category : #converting } diff --git a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st index e3accdba..d2a66d42 100644 --- a/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st +++ b/packages/Sandblocks-Smalltalk/SBVariantProxy.class.st @@ -8,7 +8,7 @@ Class { #category : #'Sandblocks-Smalltalk' } -{ #category : #'as yet unclassified' } +{ #category : #'instance creation' } SBVariantProxy class >> for: aVariant [ ^ self new for: aVariant @@ -97,7 +97,9 @@ SBVariantProxy >> updateOriginalWithOwnValues [ | variantThatNeedsChanging | variantThatNeedsChanging := self containedMethod detectVariant: original. + variantThatNeedsChanging ifNil: [self delete. ^ self]. + original replaceBy: (original := self firstSubmorph copyBlock). variantThatNeedsChanging replaceValuesFrom: original copyBlock. self sandblockEditor markChanged: self containedMethod @@ -109,7 +111,6 @@ SBVariantProxy >> updateSelfAfterMethodUpdate: newMethod [ | variantThatMaybeChanged | variantThatMaybeChanged := newMethod detectVariant: original. - "orignal variant has been deleted" variantThatMaybeChanged ifNil: [self delete. ^ self]. (variantThatMaybeChanged sourceString ~= self firstSubmorph sourceString) diff --git a/packages/Sandblocks-Watch/SBWatchView.class.st b/packages/Sandblocks-Watch/SBWatchView.class.st index f2fc01cd..506853c2 100644 --- a/packages/Sandblocks-Watch/SBWatchView.class.st +++ b/packages/Sandblocks-Watch/SBWatchView.class.st @@ -234,16 +234,6 @@ SBWatchView >> reportValues: aCollectionOfObjects [ Project current addDeferredUIMessage: [self updateDisplay]] ] -{ #category : #display } -SBWatchView >> reset [ - - self useDisplay: self defaultDisplay. - updateScheduled := false. - watchValues := LinkedList new. - count contents: '0'. - -] - { #category : #accessing } SBWatchView >> scrollBarHeight [ From 07fccfc4a244d203fbb2b8baa00168a0907ddeb8 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Mon, 18 Sep 2023 18:59:06 +0200 Subject: [PATCH 13/15] Fixes recursion in SbStBasicMethod >> = --- packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st index fffef494..d5c1b783 100644 --- a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st @@ -24,7 +24,7 @@ SBStBasicMethod class >> selector: aSymbol arguments: aCollection class: aClass SBStBasicMethod >> = anotherSBStBasicMethod [ ^ anotherSBStBasicMethod class == self class - and: [anotherSBStBasicMethod compiledMethod ~= anotherSBStBasicMethod] + and: [anotherSBStBasicMethod compiledMethod class ~= self class] and: [anotherSBStBasicMethod compiledMethod equivalentTo: self compiledMethod] ] From f1877293c0cfae19a09e7e7ac88162bf19655298 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Thu, 21 Sep 2023 16:24:51 +0200 Subject: [PATCH 14/15] Removes individual = for SBStBasicMethod --- packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st | 8 -------- 1 file changed, 8 deletions(-) diff --git a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st index d5c1b783..fbc65076 100644 --- a/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st +++ b/packages/Sandblocks-Smalltalk/SBStBasicMethod.class.st @@ -20,14 +20,6 @@ SBStBasicMethod class >> selector: aSymbol arguments: aCollection class: aClass body: aBlock asSandblock ] -{ #category : #comparing } -SBStBasicMethod >> = anotherSBStBasicMethod [ - - ^ anotherSBStBasicMethod class == self class - and: [anotherSBStBasicMethod compiledMethod class ~= self class] - and: [anotherSBStBasicMethod compiledMethod equivalentTo: self compiledMethod] -] - { #category : #accessing } SBStBasicMethod >> actualReceiver [ From 381f337bec0d7d867b9504e4bc32e18376d078f9 Mon Sep 17 00:00:00 2001 From: Joana Bergsiek Date: Wed, 11 Oct 2023 13:48:34 +0200 Subject: [PATCH 15/15] recategorisation --- .../SBExploriants.class.st | 2 +- .../SBExploriantsView.class.st | 2 +- .../SBResultsView.class.st | 2 +- .../SBVariantsView.class.st | 2 +- .../SBPermutation.class.st | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) rename packages/{Sandblocks-Core => Sandblocks-Babylonian}/SBExploriants.class.st (96%) rename packages/{Sandblocks-Core => Sandblocks-Babylonian}/SBExploriantsView.class.st (98%) rename packages/{Sandblocks-Core => Sandblocks-Babylonian}/SBResultsView.class.st (98%) rename packages/{Sandblocks-Core => Sandblocks-Babylonian}/SBVariantsView.class.st (94%) rename packages/{Sandblocks-Smalltalk => Sandblocks-Utils}/SBPermutation.class.st (98%) diff --git a/packages/Sandblocks-Core/SBExploriants.class.st b/packages/Sandblocks-Babylonian/SBExploriants.class.st similarity index 96% rename from packages/Sandblocks-Core/SBExploriants.class.st rename to packages/Sandblocks-Babylonian/SBExploriants.class.st index 447e7450..2a43ff42 100644 --- a/packages/Sandblocks-Core/SBExploriants.class.st +++ b/packages/Sandblocks-Babylonian/SBExploriants.class.st @@ -4,7 +4,7 @@ Class { #classInstVars : [ 'uniqueInstance' ], - #category : #'Sandblocks-Core' + #category : #'Sandblocks-Babylonian' } { #category : #accessing } diff --git a/packages/Sandblocks-Core/SBExploriantsView.class.st b/packages/Sandblocks-Babylonian/SBExploriantsView.class.st similarity index 98% rename from packages/Sandblocks-Core/SBExploriantsView.class.st rename to packages/Sandblocks-Babylonian/SBExploriantsView.class.st index 8542cee8..ccfa77f5 100644 --- a/packages/Sandblocks-Core/SBExploriantsView.class.st +++ b/packages/Sandblocks-Babylonian/SBExploriantsView.class.st @@ -1,7 +1,7 @@ Class { #name : #SBExploriantsView, #superclass : #SBNamedBlock, - #category : #'Sandblocks-Core' + #category : #'Sandblocks-Babylonian' } { #category : #'instance creation' } diff --git a/packages/Sandblocks-Core/SBResultsView.class.st b/packages/Sandblocks-Babylonian/SBResultsView.class.st similarity index 98% rename from packages/Sandblocks-Core/SBResultsView.class.st rename to packages/Sandblocks-Babylonian/SBResultsView.class.st index e22504cc..e3116543 100644 --- a/packages/Sandblocks-Core/SBResultsView.class.st +++ b/packages/Sandblocks-Babylonian/SBResultsView.class.st @@ -1,7 +1,7 @@ Class { #name : #SBResultsView, #superclass : #SBExploriantsView, - #category : #'Sandblocks-Core' + #category : #'Sandblocks-Babylonian' } { #category : #accessing } diff --git a/packages/Sandblocks-Core/SBVariantsView.class.st b/packages/Sandblocks-Babylonian/SBVariantsView.class.st similarity index 94% rename from packages/Sandblocks-Core/SBVariantsView.class.st rename to packages/Sandblocks-Babylonian/SBVariantsView.class.st index 402a5662..2ff68c30 100644 --- a/packages/Sandblocks-Core/SBVariantsView.class.st +++ b/packages/Sandblocks-Babylonian/SBVariantsView.class.st @@ -1,7 +1,7 @@ Class { #name : #SBVariantsView, #superclass : #SBExploriantsView, - #category : #'Sandblocks-Core' + #category : #'Sandblocks-Babylonian' } { #category : #building } diff --git a/packages/Sandblocks-Smalltalk/SBPermutation.class.st b/packages/Sandblocks-Utils/SBPermutation.class.st similarity index 98% rename from packages/Sandblocks-Smalltalk/SBPermutation.class.st rename to packages/Sandblocks-Utils/SBPermutation.class.st index e39cbb03..5b56c6c2 100644 --- a/packages/Sandblocks-Smalltalk/SBPermutation.class.st +++ b/packages/Sandblocks-Utils/SBPermutation.class.st @@ -8,7 +8,7 @@ Class { #instVars : [ 'referencedVariants' ], - #category : #'Sandblocks-Smalltalk' + #category : #'Sandblocks-Utils' } { #category : #utils }