From 559340117b43e42507317af8778c1be23994190b Mon Sep 17 00:00:00 2001 From: AlexisCnockaert Date: Mon, 2 Dec 2024 15:30:09 +0100 Subject: [PATCH 1/2] Added new feature that allows to leave all variables undeclared if option selected in dialog --- src/AST-Core/ASTVariableNode.class.st | 27 ++++++++++- src/OpalCompiler-Core/OpalCompiler.class.st | 27 ++++++----- src/OpalCompiler-UI/OCCodeReparator.class.st | 50 ++++++++++---------- 3 files changed, 66 insertions(+), 38 deletions(-) diff --git a/src/AST-Core/ASTVariableNode.class.st b/src/AST-Core/ASTVariableNode.class.st index 286f4fe64e1..99530e1f6e5 100644 --- a/src/AST-Core/ASTVariableNode.class.st +++ b/src/AST-Core/ASTVariableNode.class.st @@ -18,6 +18,9 @@ Class { 'variable', 'start' ], + #classVars : [ + 'UndeclaredVariableFlag' + ], #category : 'AST-Core-Nodes', #package : 'AST-Core', #tag : 'Nodes' @@ -69,6 +72,18 @@ ASTVariableNode class >> thisProcessNode [ ^ self named: #thisProcess ] +{ #category : 'accessing' } +ASTVariableNode class >> undeclaredVariableFlag [ + + ^ UndeclaredVariableFlag ifNil: [ nil ] +] + +{ #category : 'settings - accessing' } +ASTVariableNode class >> undeclaredVariableFlag: aBoolean [ + + UndeclaredVariableFlag := aBoolean +] + { #category : 'comparing' } ASTVariableNode >> = anObject [ self == anObject ifTrue: [^true]. @@ -82,6 +97,15 @@ ASTVariableNode >> acceptVisitor: aProgramNodeVisitor [ ^ variable acceptVisitor: aProgramNodeVisitor node: self ] +{ #category : 'action' } +ASTVariableNode >> changeFlag [ + + self class undeclaredVariableFlag + ifFalse: [ self class undeclaredVariableFlag: true ] + "ifTrue: [ self class undeclaredVariableFlag: false ]." + +] + { #category : 'matching' } ASTVariableNode >> copyInContext: aDictionary [ ^ self class named: name @@ -116,7 +140,8 @@ ASTVariableNode >> initialize [ super initialize. variable := UnresolvedVariable instance. name := ''. - start := 0 + start := 0. + self class undeclaredVariableFlag: false ] { #category : 'testing' } diff --git a/src/OpalCompiler-Core/OpalCompiler.class.st b/src/OpalCompiler-Core/OpalCompiler.class.st index 30f3dfb46d4..67d7a828c9c 100644 --- a/src/OpalCompiler-Core/OpalCompiler.class.st +++ b/src/OpalCompiler-Core/OpalCompiler.class.st @@ -303,29 +303,30 @@ OpalCompiler >> checkNotice: aNotice [ signal. ^ true ]. - self requestor ifNotNil: [ - "A requestor is available. We are in quirks mode and are expected to do UI things." - "Reparation menu in quirks mode: + self requestor ifNotNil: [ "A requestor is available. We are in quirks mode and are expected to do UI things.""Reparation menu in quirks mode: * require a requestor (because quirks mode, and also some reparations expect a requestor) * require interactive mode (because GUI) * require method definition becase some reparation assume it's a method body" self isInteractive ifTrue: [ - aNotice reparator ifNotNil: [ :reparator | - | res | - res := reparator - requestor: requestor; - openMenu. - res ifNil: [ ^ true "reparation unneded, let AST as is" ]. - res ifFalse: [ ^ false "operation cancelled, fail" ]. - self parse: requestor text. "some reparation was done, reparse" - ^ nil ] ]. + aNotice node class undeclaredVariableFlag + ifTrue: [ ^ true ] + ifFalse: [ + aNotice reparator ifNotNil: [ :reparator | + | res | + res := reparator + requestor: requestor; + openMenu. + res ifNil: [ ^ true "reparation unneded, let AST as is" ]. + res ifFalse: [ ^ false "operation cancelled, fail" ]. + self parse: requestor text. "some reparation was done, reparse" + ^ nil ] ] ]. "Quirks mode: otherwise, push the error message to the requestor" requestor notify: aNotice messageText , ' ->' at: aNotice position in: aNotice node source. - + "Quirks mode: Then leave" ^ false ]. diff --git a/src/OpalCompiler-UI/OCCodeReparator.class.st b/src/OpalCompiler-UI/OCCodeReparator.class.st index b5bfda2cc8d..e60cc2df1ec 100644 --- a/src/OpalCompiler-UI/OCCodeReparator.class.st +++ b/src/OpalCompiler-UI/OCCodeReparator.class.st @@ -133,7 +133,6 @@ OCCodeReparator >> openMenu [ * Return fail if the user cancel" | alternatives labels actions lines caption choice name interval | - interval := node sourceInterval. name := node name. alternatives := self possibleVariablesFor: name. @@ -147,38 +146,41 @@ OCCodeReparator >> openMenu [ labels add: 'Declare new instance variable'. actions add: [ self declareInstVar: name ] ] ifFalse: [ + labels add: 'Leave all variables undeclared'. + actions add: [ + node changeFlag. + ^ nil ]. labels add: 'Leave variable undeclared'. actions add: [ ^ nil ]. lines add: labels size. labels add: 'Define new class'. - actions - add: [ - [ self defineClass: name asSymbol ] - on: Abort - do: [ self openMenu ] ]. - labels add: 'Declare new global'. - actions add: [ self declareGlobal ]. - requestor isScripting ifFalse: - [labels add: 'Declare new class variable'. - actions add: [ self declareClassVar ]]. + actions add: [ + [ self defineClass: name asSymbol ] + on: Abort + do: [ self openMenu ] ]. + requestor isScripting ifFalse: [ + labels add: 'Declare new class variable'. + actions add: [ self declareClassVar ] ]. labels add: 'Define new trait'. - actions - add: [ - [ self defineTrait: name asSymbol ] - on: Abort - do: [ self openMenu ] ] ]. + actions add: [ + [ self defineTrait: name asSymbol ] + on: Abort + do: [ self openMenu ] ] ]. lines add: labels size. - alternatives - do: [ :each | - labels add: each. - actions - add: [ - self substituteVariable: each atInterval: interval ] ]. + alternatives do: [ :each | + labels add: each. + actions add: [ self substituteVariable: each atInterval: interval ] ]. lines add: labels size. labels add: 'Cancel'. - caption := 'Unknown variable: ' , name , ' please correct, or cancel:'. - choice := MorphicUIManager new chooseFrom: labels lines: lines title: caption. + caption := 'Unknown variable: ' , name + , ' please correct, or cancel:'. + + choice := MorphicUIManager new + chooseFrom: labels + lines: lines + title: caption. (actions at: choice ifAbsent: [ ^ false ]) value. + ^ true ] From d73edc565a0d222525fe8216452962922dc744b3 Mon Sep 17 00:00:00 2001 From: AlexisCnockaert Date: Mon, 2 Dec 2024 15:39:37 +0100 Subject: [PATCH 2/2] fixed little tings --- src/AST-Core/ASTVariableNode.class.st | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/AST-Core/ASTVariableNode.class.st b/src/AST-Core/ASTVariableNode.class.st index 99530e1f6e5..3ecfa511e17 100644 --- a/src/AST-Core/ASTVariableNode.class.st +++ b/src/AST-Core/ASTVariableNode.class.st @@ -75,7 +75,7 @@ ASTVariableNode class >> thisProcessNode [ { #category : 'accessing' } ASTVariableNode class >> undeclaredVariableFlag [ - ^ UndeclaredVariableFlag ifNil: [ nil ] + ^ UndeclaredVariableFlag ] { #category : 'settings - accessing' } @@ -102,7 +102,6 @@ ASTVariableNode >> changeFlag [ self class undeclaredVariableFlag ifFalse: [ self class undeclaredVariableFlag: true ] - "ifTrue: [ self class undeclaredVariableFlag: false ]." ]