[squeak-dev] The Inbox: Compiler-mt.410.mcz

Chris Muller asqueaker at gmail.com
Wed Oct 9 22:07:26 UTC 2019


Virtual high-five, Eliot, for Rectangular Block.   :)

I'm sure you already have your own version, but just in case, I just copied
what I've been using to pretty-print in Rectangular Block to the Inbox.
It's Compiler-cmm.329.  It's not quite perfect, but as close as I could get
it.

Since it's from 2016, it needs to be merged instead of loaded, of course.
No conflicts.

 - Chris





On Tue, Oct 8, 2019 at 1:08 PM Eliot Miranda <eliot.miranda at gmail.com>
wrote:

> Hi Marcel,
>
> On Wed, Sep 4, 2019 at 8:04 AM <commits at source.squeak.org> wrote:
>
>> A new version of Compiler was added to project The Inbox:
>> http://source.squeak.org/inbox/Compiler-mt.410.mcz
>>
>> ==================== Summary ====================
>>
>> Name: Compiler-mt.410
>> Author: mt
>> Time: 4 September 2019, 5:03:52.834738 pm
>> UUID: 7ff9d1f8-5f7a-4077-b11b-ede80ada7d13
>> Ancestors: Compiler-TraitTest.409
>>
>> Fixes ifNil:ifNotNil: decompilation. Please review.
>>
>
> This looks good.  Forgive me but I must say that I wish you would use
> rectangular blocks (a la Beck Smalltalk Best Practice Patterns).  I am a
> visual thinker and find non-rectangular blocks at best irritating.  Blocks
> are objects, not simply syntax, and the use of non-rectangular blocks is
> reminiscent of curly bracket languages, where brackets merely delimit a
> sequence of statements rather than encode an object.
>
> On etiquette I tend to leave formatting as I find it in packages with
> definite owners and clear preferences.  In the Compiler I have a clear
> preference ;-)
>
>
> - Only decompile ifNil:ifNotNil: if temps are not closured across nested
>> blocks. This is the same behavior as #to:(by:)do:, which does not restore
>> #to:(by:)do: if the 'var' or 'limit' are in an outer (outer?) scope. Only
>> relevant if programmers type the optimized source code themselves.
>> - Note that I created a new method in DecompilerConstructor to pass
>> 'tempReadCounts'. #to:(by:)do: is reconstructed in Decompiler, which
>> already has access to 'tempReadCounts'. See Decompiler >> #jump:if: and
>> #convertToDoLoop:.
>>
>> =============== Diff against Compiler-TraitTest.409 ===============
>>
>> Item was added:
>> + ----- Method: AssignmentNode>>ifNilTemporary (in category 'private')
>> -----
>> + ifNilTemporary
>> +       "(temp := object) == nil ifTrue: [...] ifFalse: [...]"
>> +
>> +       ^ self variable!
>>
>> Item was added:
>> + ----- Method: AssignmentNode>>ifNilValue (in category 'private') -----
>> + ifNilValue
>> +       "(temp := object) == nil ifTrue: [...] ifFalse: [...]"
>> +
>> +       ^ self value!
>>
>> Item was changed:
>>   ----- Method: BlockNode>>printTemporaries:on:doPrior: (in category
>> 'printing') -----
>>   printTemporaries: tempSequence on: aStream doPrior: aBlock
>>         "Print any in-scope temporaries.  If there are any evaluate aBlock
>>          prior to printing.  Answer whether any temporaries were printed."
>>         | tempStream seen |
>>         tempSequence ifNil:
>>                 [^false].
>>         tempStream := (String new: 16) writeStream.
>>         "This is for the decompiler which canmot work out which optimized
>> block a particular temp is
>>          local to and hence may produce diplicates as in
>>                 expr ifTrue: [| aTemp | ...] ifFalse: [| aTemp | ...]"
>>         seen := Set new.
>>         tempSequence do:
>>                 [:tempNode |
>>                 tempNode isIndirectTempVector
>>                         ifTrue:
>>                                 [tempNode remoteTemps do:
>>                                         [:tempVariableNode|
>>                                          (tempVariableNode scope >= 0
>> +                                         and: [
>> +                                               "This is for the
>> deocmpiler which may create a block arg when converting
>> +                                               a ifTrue:ifFalse: into a
>> ifNil:ifNotNil: but won't remove it from temporaries"
>> +                                               tempVariableNode
>> isBlockArg not
>> +                                         and: [(seen includes: tempNode
>> key) not]]) ifTrue:
>> -                                         and: [(seen includes: tempNode
>> key) not]) ifTrue:
>>                                                 [tempStream space;
>> nextPutAll: (seen add: tempVariableNode key)]]]
>>                         ifFalse:
>>                                 [(tempNode scope >= -1
>>                                   and: ["This is for the decompiler which
>> may create a block arg when converting
>> +                                               a while into a to:do: but
>> won't remove it from temporaries"
>> -                                               a while into a to:do: but
>> won't remove it form temporaries"
>>                                            tempNode isBlockArg not
>>                                   and: [(seen includes: tempNode key)
>> not]]) ifTrue:
>>                                         [tempStream space; nextPutAll:
>> (seen add: tempNode key)]]].
>>         tempStream position = 0 ifTrue:
>>                 [^false].
>>         aBlock value.
>>         aStream nextPut: $|; nextPutAll: tempStream contents; space;
>> nextPut: $|.
>>         ^true!
>>
>> Item was changed:
>>   ----- Method: Decompiler>>jump:if: (in category 'instruction decoding')
>> -----
>>   jump: dist if: condition
>>
>>         | savePc sign elsePc elseStart end cond ifExpr thenBlock elseBlock
>>           thenJump elseJump condHasValue isIfNil saveStack |
>>         lastJumpIfPcStack addLast: lastPc.
>>         stack last == CascadeFlag ifTrue: [^ [self case: dist] ensure:
>> [lastJumpIfPcStack removeLast]].
>>         elsePc := lastPc.
>>         elseStart := pc + dist.
>>         end := limit.
>>         "Check for bfp-jmp to invert condition.
>>         Don't be fooled by a loop with a null body."
>>         sign := condition.
>>         savePc := pc.
>>         self interpretJump ifNotNil:
>>                 [:elseDist|
>>                  (elseDist >= 0 and: [elseStart = pc]) ifTrue:
>>                          [sign := sign not.  elseStart := pc + elseDist]].
>>         pc := savePc.
>>         ifExpr := stack removeLast.
>>         (isIfNil := stack size > 0 and: [stack last == IfNilFlag]) ifTrue:
>>                 [stack removeLast].
>>         saveStack := stack.
>>         stack := OrderedCollection new.
>>         thenBlock := self blockTo: elseStart.
>>         condHasValue := hasValue or: [isIfNil].
>>         "ensure jump is within block (in case thenExpr returns)"
>>         thenJump := exit <= end ifTrue: [exit] ifFalse: [elseStart].
>>         "if jump goes back, then it's a loop"
>>         thenJump < elseStart
>>                 ifTrue:
>>                         [| blockBody blockArgs savedReadCounts
>> blockBodyReadCounts selector |
>>                          "Must be a while loop...
>>                           thenJump will jump to the beginning of the
>> while expr.  In the case of while's
>>                           with a block in the condition, the while expr
>> should include more than just
>>                           the last expression: find all the statements
>> needed by searching for the node
>>                           with the relevant pc."
>>                         stack := saveStack.
>>                         savedReadCounts := tempReadCounts copy.
>>                         pc := thenJump.
>>                         blockBody := self statementsTo: elsePc.
>>                         blockBodyReadCounts := tempReadCounts.
>>                         savedReadCounts keysAndValuesDo:
>>                                 [:temp :count|
>>                                  blockBodyReadCounts at: temp put:
>> (blockBodyReadCounts at: temp) - count].
>>                         tempReadCounts := savedReadCounts.
>>                         "discard unwanted statements from block"
>>                         blockBody size - 1 timesRepeat: [statements
>> removeLast].
>>                         blockArgs := thenBlock statements = constructor
>> codeEmptyBlock statements
>>                                                         ifTrue: [#()]
>>                                                         ifFalse: [{
>> thenBlock }].
>>                         selector := blockArgs isEmpty
>>                                                         ifTrue: [sign
>> ifTrue: [#whileFalse] ifFalse: [#whileTrue]]
>>                                                         ifFalse: [sign
>> ifTrue: [#whileFalse:] ifFalse: [#whileTrue:]].
>>                         statements addLast:
>>                                 (constructor
>>                                         codeMessage: (constructor
>> codeBlock: blockBody returns: false)
>>                                         selector: (constructor
>> codeSelector: selector code: #macro)
>>                                         arguments: blockArgs).
>>                         pc := elseStart.
>>                         selector == #whileTrue: ifTrue:
>>                                 [self convertToDoLoop:
>> blockBodyReadCounts]]
>>                 ifFalse:
>>                         ["Must be a conditional..."
>>                         elseBlock := self blockTo: thenJump.
>>                         elseJump := exit.
>>                         "if elseJump is backwards, it is not part of the
>> elseExpr"
>>                         elseJump < elsePc ifTrue:
>>                                 [pc := lastPc].
>>                         cond := isIfNil
>>                                                 ifTrue:
>>                                                         [constructor
>>
>> codeMessage: ifExpr ifNilReceiver
>>                                                                 selector:
>> (constructor
>>
>>               codeSelector: (sign ifTrue: [#ifNotNil:] ifFalse: [#ifNil:])
>>
>>               code: #macro)
>>
>> arguments: (Array with: thenBlock)]
>>                                                 ifFalse:
>> +                                                       [(sign ifTrue:
>> [{elseBlock. thenBlock}] ifFalse: [{thenBlock. elseBlock}]) in: [:args |
>> +
>>  (constructor
>> +
>>  decodeIfNilWithReceiver: ifExpr
>> +
>>  selector: #ifTrue:ifFalse:
>> +
>>  arguments: args
>> +
>>  tempReadCounts: tempReadCounts) ifNil: [
>> +
>>        constructor
>> +
>>                codeMessage: ifExpr
>> +
>>                selector: (constructor codeSelector: #ifTrue:ifFalse: code:
>> #macro)
>> +
>>                arguments:       args]]].
>> -                                                       [constructor
>> -
>>  codeMessage: ifExpr
>> -                                                               selector:
>> (constructor codeSelector: #ifTrue:ifFalse: code: #macro)
>> -
>>  arguments:      (sign
>> -
>>                        ifTrue: [{elseBlock. thenBlock}]
>> -
>>                        ifFalse: [{thenBlock. elseBlock}])].
>>                         stack := saveStack.
>>                         condHasValue
>>                                 ifTrue: [stack addLast: cond]
>>                                 ifFalse: [statements addLast: cond]].
>>         lastJumpIfPcStack removeLast.!
>>
>> Item was changed:
>>   ----- Method: DecompilerConstructor>>codeMessage:selector:arguments:
>> (in category 'constructor') -----
>>   codeMessage: receiver selector: selector arguments: arguments
>>         | symbol |
>>         symbol := selector key.
>>         (self
>>                 decodeLiteralVariableValueDereferenceWithReceiver:
>> receiver
>>                 selector: symbol
>>                 arguments: arguments) ifNotNil: [:node| ^node].
>> +
>> -       (self decodeIfNilWithReceiver: receiver
>> -                       selector: symbol
>> -                       arguments: arguments) ifNotNil: [:node| ^node].
>>         ^MessageNode new
>>                         receiver: receiver selector: selector
>>                         arguments: arguments
>>                         precedence: symbol precedence!
>>
>> Item was removed:
>> - ----- Method:
>> DecompilerConstructor>>decodeIfNilWithReceiver:selector:arguments: (in
>> category 'constructor') -----
>> - decodeIfNilWithReceiver: receiver selector: selector arguments:
>> arguments
>> -       receiver ifNil: [ ^nil ].               "For instance, when
>> cascading"
>> -       selector == #ifTrue:ifFalse:
>> -               ifFalse: [^ nil].
>> -       (receiver isMessage: #==
>> -                               receiver: nil
>> -                               arguments: [:argNode | argNode ==
>> NodeNil])
>> -               ifFalse: [^ nil].
>> -       ^ (MessageNode new
>> -                       receiver: receiver
>> -                       selector: (SelectorNode new key: #ifTrue:ifFalse:
>> code: #macro)
>> -                       arguments: arguments
>> -                       precedence: 3)
>> -               noteSpecialSelector: #ifNil:ifNotNil:!
>>
>> Item was added:
>> + ----- Method:
>> DecompilerConstructor>>decodeIfNilWithReceiver:selector:arguments:tempReadCounts:
>> (in category 'constructor') -----
>> + decodeIfNilWithReceiver: receiver selector: selector arguments:
>> arguments tempReadCounts: tempReadCounts
>> +
>> +       | node temp |
>> +       receiver ifNil: [ ^nil ].               "For instance, when
>> cascading"
>> +       selector == #ifTrue:ifFalse:
>> +               ifFalse: [^ nil].
>> +
>> +       (receiver isMessage: #==
>> +                               receiver: nil
>> +                               arguments: [:argNode | argNode ==
>> NodeNil])
>> +               ifFalse: [^ nil].
>> +
>> +       "Like #to:(by:)do:, support only local temps."
>> +       (((temp := receiver ifNilTemporary) isNil or: [tempReadCounts
>> includesKey: temp]) or: [
>> +               "What about 'object ifNotNil: [:o | ]', which as not read
>> the blockArg? Just check that there is no remote vector pointing to it."
>> +               tempReadCounts keys noneSatisfy: [:otherTemp |
>> +                       otherTemp isIndirectTempVector
>> +                               ifTrue: [otherTemp remoteTemps
>> anySatisfy: [:remoteTemp | remoteTemp name = temp name]]
>> +                               ifFalse: [otherTemp name = temp name]]
>> +                       ])
>> +               ifFalse: [^ nil].
>> +
>> +       node := (MessageNode new
>> +                       receiver: receiver
>> +                       selector: (SelectorNode new key: #ifTrue:ifFalse:
>> code: #macro)
>> +                       arguments: arguments
>> +                       precedence: 3).
>> +
>> +       "Reconfigure the message node to #ifNil:ifNotNil:. Note that
>> original* instance variables keep their optimized format. See MessageNode
>> >> #printIfNilNotNil:indent:."
>> +       node
>> +               noteSpecialSelector: #ifNil:ifNotNil:;
>> +               selector: (SelectorNode new key: #ifNil:ifNotNil:).
>> +
>> +       temp ifNil: [^ node].
>> +       temp isTemp ifFalse: [^ node].
>> +
>> +       (arguments second isJust: NodeNil) not ifTrue: [
>> +                       temp beBlockArg.
>> +                       node arguments: {
>> +                               arguments first.
>> +                               arguments second copy arguments: { temp
>> }; yourself } ].
>> +
>> +       ^ node!
>>
>> Item was added:
>> + ----- Method: MessageNode>>ifNilTemporary (in category 'private') -----
>> + ifNilTemporary
>> +
>> +       ^ self ifNilReceiver ifNilTemporary!
>>
>> Item was changed:
>>   ----- Method: MessageNode>>printIfNilNotNil:indent: (in category
>> 'printing') -----
>>   printIfNilNotNil: aStream indent: level
>>
>> +       (arguments first isJust: NodeNil) ifTrue: [
>> +               self printReceiver: receiver ifNilReceiver ifNilValue on:
>> aStream indent: level.
>> +               ^ self printKeywords: #ifNotNil:
>> -       self printReceiver: receiver ifNilReceiver on: aStream indent:
>> level.
>> -
>> -       (arguments first isJust: NodeNil) ifTrue:
>> -               [^ self printKeywords: #ifNotNil:
>>                                 arguments: { arguments second }
>>                                 on: aStream indent: level].
>> +
>> +       (arguments second isJust: NodeNil) ifTrue: [
>> +               self printReceiver: receiver ifNilReceiver on: aStream
>> indent: level.
>> +               ^ self printKeywords: #ifNil:
>> -       (arguments second isJust: NodeNil) ifTrue:
>> -               [^ self printKeywords: #ifNil:
>>                                 arguments: { arguments first }
>>                                 on: aStream indent: level].
>> +
>> +       self printReceiver: receiver ifNilReceiver ifNilValue on: aStream
>> indent: level.
>>         ^ self printKeywords: #ifNil:ifNotNil:
>>                         arguments: arguments
>>                         on: aStream indent: level!
>>
>> Item was changed:
>>   ----- Method: MessageNode>>printWithClosureAnalysisIfNilNotNil:indent:
>> (in category 'printing') -----
>>   printWithClosureAnalysisIfNilNotNil: aStream indent: level
>>
>> +       (arguments first isJust: NodeNil) ifTrue: [
>> +               self printWithClosureAnalysisReceiver: receiver
>> ifNilReceiver ifNilValue on: aStream indent: level.
>> +               ^ self printWithClosureAnalysisKeywords: #ifNotNil:
>> -       self printWithClosureAnalysisReceiver: receiver ifNilReceiver on:
>> aStream indent: level.
>> -
>> -       (arguments first isJust: NodeNil) ifTrue:
>> -               [^self printWithClosureAnalysisKeywords: #ifNotNil:
>>                                 arguments: { arguments second }
>>                                 on: aStream indent: level].
>> +
>> +       (arguments second isJust: NodeNil) ifTrue: [
>> +               self printWithClosureAnalysisReceiver: receiver
>> ifNilReceiver on: aStream indent: level.
>> +               ^ self printWithClosureAnalysisKeywords: #ifNil:
>> -       (arguments second isJust: NodeNil) ifTrue:
>> -               [^self printWithClosureAnalysisKeywords: #ifNil:
>>                                 arguments: { arguments first }
>>                                 on: aStream indent: level].
>> +
>> +       self printWithClosureAnalysisReceiver: receiver ifNilReceiver
>> ifNilValue on: aStream indent: level.
>> +       ^ self printWithClosureAnalysisKeywords: #ifNil:ifNotNil:
>> -       ^self printWithClosureAnalysisKeywords: #ifNil:ifNotNil:
>>                         arguments: arguments
>>                         on: aStream indent: level!
>>
>> Item was added:
>> + ----- Method: ParseNode>>ifNilTemporary (in category 'private') -----
>> + ifNilTemporary
>> +
>> +       ^ nil!
>>
>> Item was added:
>> + ----- Method: ParseNode>>ifNilValue (in category 'private') -----
>> + ifNilValue
>> +
>> +       ^self!
>>
>> Item was changed:
>>   ----- Method: Parser>>parseCue:noPattern:ifFail: (in category 'public
>> access') -----
>>   parseCue: aCue noPattern: noPattern ifFail: aBlock
>>         "Answer a MethodNode for the argument, sourceStream, that is the
>> root of
>>          a parse tree. Parsing is done with respect to the CompilationCue
>> to
>>          resolve variables. Errors in parsing are reported to the cue's
>> requestor;
>>          otherwise aBlock is evaluated. The argument noPattern is a
>> Boolean that is
>>          true if the the sourceStream does not contain a method header
>> (i.e., for DoIts)."
>>
>>         | methNode repeatNeeded myStream s p subSelection |
>>         myStream := aCue sourceStream.
>>         [repeatNeeded := false.
>>          p := myStream position.
>>          s := myStream upToEnd.
>>          myStream position: p.
>> +
>> +        doitFlag := noPattern.
>> +        failBlock:= aBlock.
>>
>>          self encoder init: aCue notifying: self.
>>          self init: myStream cue: aCue failBlock: [^ aBlock value].
>>
>>          subSelection := self interactive and: [cue requestor
>> selectionInterval = (p + 1 to: p + s size)].
>>
>> -        doitFlag := noPattern.
>> -        failBlock:= aBlock.
>>          [methNode := self method: noPattern context: cue context]
>>                 on: ReparseAfterSourceEditing
>>                 do:     [ :ex |
>>                         repeatNeeded := true.
>>                         properties := nil. "Avoid accumulating pragmas
>> and primitives Number"
>>                         myStream := ex newSource
>>                                 ifNil: [subSelection
>>                                                         ifTrue:
>>
>> [ReadStream
>>
>> on: cue requestor text string
>>
>> from: cue requestor selectionInterval first
>>
>> to: cue requestor selectionInterval last]
>>                                                         ifFalse:
>>
>> [ReadStream on: cue requestor text string]]
>>                                 ifNotNil: [:src | myStream := src
>> readStream]].
>>          repeatNeeded] whileTrue:
>>                 [encoder := self encoder class new].
>>         methNode sourceText: s.
>>         ^methNode
>>   !
>>
>>
>>
>
> --
> _,,,^..^,,,_
> best, Eliot
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20191009/c79423a1/attachment-0001.html>


More information about the Squeak-dev mailing list