CascadeNode.st
author Claus Gittinger <cg@exept.de>
Tue, 08 Aug 2017 18:22:43 +0200
changeset 4183 4e9dedb504ca
parent 4181 21f00e5abe0a
child 4184 e86cf3691f8c
permissions -rw-r--r--
#BUGFIX by cg class: CascadeNode changed: #evaluateForCascadeIn: avoid recursion error
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
     1
"
4
f6fd83437415 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
104
claus
parents: 103
diff changeset
     3
	      All Rights Reserved
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
     4
7ad01559b262 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
7ad01559b262 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
7ad01559b262 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
7ad01559b262 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
7ad01559b262 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
7ad01559b262 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
7ad01559b262 Initial revision
claus
parents:
diff changeset
    11
"
1079
2a996e0def30 category change
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
    12
"{ Package: 'stx:libcomp' }"
2a996e0def30 category change
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
    13
4181
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    14
"{ NameSpace: Smalltalk }"
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    15
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    16
MessageNode subclass:#CascadeNode
261
0372e948ca2d commentary
Claus Gittinger <cg@exept.de>
parents: 148
diff changeset
    17
	instanceVariableNames:''
0372e948ca2d commentary
Claus Gittinger <cg@exept.de>
parents: 148
diff changeset
    18
	classVariableNames:''
0372e948ca2d commentary
Claus Gittinger <cg@exept.de>
parents: 148
diff changeset
    19
	poolDictionaries:''
0372e948ca2d commentary
Claus Gittinger <cg@exept.de>
parents: 148
diff changeset
    20
	category:'System-Compiler-Support'
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    21
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
    22
20
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    23
!CascadeNode class methodsFor:'documentation'!
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    24
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    25
copyright
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    26
"
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    27
 COPYRIGHT (c) 1989 by Claus Gittinger
104
claus
parents: 103
diff changeset
    28
	      All Rights Reserved
20
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    29
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    30
 This software is furnished under a license and may be used
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    31
 only in accordance with the terms of that license and with the
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    33
 be provided or otherwise made available to, or used by, any
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    34
 other person.  No title to or ownership of the software is
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    35
 hereby transferred.
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    36
"
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    37
!
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    38
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    39
documentation
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    40
"
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    41
    node for parse-trees, representing cascade message sends
261
0372e948ca2d commentary
Claus Gittinger <cg@exept.de>
parents: 148
diff changeset
    42
    This is a helper class for the compiler.
263
3b21d0991eff documentation
Claus Gittinger <cg@exept.de>
parents: 261
diff changeset
    43
3b21d0991eff documentation
Claus Gittinger <cg@exept.de>
parents: 261
diff changeset
    44
    [author:]
3b21d0991eff documentation
Claus Gittinger <cg@exept.de>
parents: 261
diff changeset
    45
        Claus Gittinger
20
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    46
"
f8dd8ba75205 *** empty log message ***
claus
parents: 15
diff changeset
    47
! !
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    48
2693
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    49
!CascadeNode methodsFor:'*VMMaker-C translation'!
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    50
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    51
asTranslatorNodeIn: aTMethod
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    52
        "make a CCodeGenerator equivalent of me"
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    53
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    54
        ^Squeak::TStmtListNode new
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    55
                setArguments: #()
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    56
                statements:
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    57
                        (Array streamContents:
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    58
                                [:s| | receiverNode |
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    59
                                receiverNode := self realReceiver "receiver" asTranslatorNodeIn: aTMethod.   
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    60
                                receiverNode isLeaf ifFalse:
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    61
                                        [| varNode |
2700
f894f188aefc comment/format in: #asTranslatorNodeIn:
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
    62
2693
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    63
                                         varNode := aTMethod newCascadeTempFor: receiverNode.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    64
                                         s nextPut: (Squeak::TAssignmentNode new
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    65
                                                                setVariable: varNode
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    66
                                                                expression: receiverNode).
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    67
                                        receiverNode := varNode].
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    68
                                self messages do:
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    69
                                        [ :msg | s nextPut: ((msg asTranslatorNodeIn: aTMethod) receiver: receiverNode)]]);
2700
f894f188aefc comment/format in: #asTranslatorNodeIn:
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
    70
                comment: ((comments ? #()) firstIfEmpty:nil)
2693
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    71
2700
f894f188aefc comment/format in: #asTranslatorNodeIn:
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
    72
    "Modified: / 14-09-2011 / 10:41:14 / cg"
2693
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    73
!
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    74
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    75
realReceiver
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    76
    "return the real receiver
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    77
     (sigh; ST/X encodes things differently)"
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    78
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    79
    |r|
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    80
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    81
    r := receiver.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    82
    [r isCascade] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    83
        r := r receiver.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    84
    ].
2700
f894f188aefc comment/format in: #asTranslatorNodeIn:
Claus Gittinger <cg@exept.de>
parents: 2693
diff changeset
    85
    ^ r receiver
2693
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    86
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    87
    "Created: / 12-09-2011 / 10:01:48 / cg"
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    88
! !
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
    89
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
    90
!CascadeNode methodsFor:'code generation'!
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    91
104
claus
parents: 103
diff changeset
    92
codeForCascadeOn:aStream inBlock:b for:aCompiler
4181
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    93
    "the old code could lead to a recursion error with
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    94
     long cascades;
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    95
     the new code does not."
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    96
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    97
    "/ old
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    98
    "/ receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
    99
    "/ aStream nextPut:#dup.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   100
    "/ self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   101
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   102
    "/ new
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   103
    |leftMostExpression sequence|
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   104
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   105
    leftMostExpression := receiver.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   106
    sequence := OrderedCollection new.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   107
    [ leftMostExpression isCascade ] whileTrue:[
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   108
        sequence addFirst:leftMostExpression.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   109
        leftMostExpression := leftMostExpression receiver.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   110
    ].
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   111
    
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   112
    leftMostExpression codeForCascadeOn:aStream inBlock:b for:aCompiler.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   113
    sequence do:[:eachCascade |
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   114
        aStream nextPut:#dup.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   115
        eachCascade codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   116
    ].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   117
    aStream nextPut:#dup.
4181
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   118
    self codeSendOn:aStream inBlock:b valueNeeded:false for:aCompiler.
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   119
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   120
    "Modified: / 08-08-2017 / 18:04:48 / cg"
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   121
!
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   122
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   123
codeOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   124
    receiver codeForCascadeOn:aStream inBlock:b for:aCompiler.
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   125
    self codeSendOn:aStream inBlock:b valueNeeded:valueNeeded for:aCompiler
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   126
! !
7ad01559b262 Initial revision
claus
parents:
diff changeset
   127
1035
8848672cb893 category rename
Claus Gittinger <cg@exept.de>
parents: 861
diff changeset
   128
!CascadeNode methodsFor:'enumerating'!
539
69a1cd05c7d6 added node-walk facility (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 263
diff changeset
   129
2693
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   130
messages
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   131
    "helper for parse tree walking"
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   132
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   133
    "/ sigh; ST/X encodes things differently ...
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   134
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   135
    |r nd msgs msg|
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   136
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   137
    msgs := OrderedCollection new.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   138
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   139
    r := receiver.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   140
    [r isCascade] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   141
        r := r receiver.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   142
    ].
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   143
    r := r receiver.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   144
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   145
    nd := self.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   146
    [nd isCascade] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   147
        msg := MessageNode new.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   148
        msg receiver:r selector:nd selector args:nd args lineno:nd lineNumber.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   149
        msgs addFirst:msg.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   150
        nd := nd receiver.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   151
    ].
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   152
    msg := MessageNode new.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   153
    msg receiver:r selector:nd selector args:nd args lineno:nd lineNumber.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   154
    msgs addFirst:msg.
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   155
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   156
    ^ msgs
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   157
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   158
    "Created: / 12-09-2011 / 10:04:31 / cg"
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   159
!
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   160
539
69a1cd05c7d6 added node-walk facility (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 263
diff changeset
   161
nodeDo:anEnumerator
69a1cd05c7d6 added node-walk facility (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 263
diff changeset
   162
    "helper for parse tree walking"
69a1cd05c7d6 added node-walk facility (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 263
diff changeset
   163
542
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   164
    "/ sigh; ST/X encodes things differently ...
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   165
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   166
    |r nd msgs msg|
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   167
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   168
    msgs := OrderedCollection new.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   169
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   170
    r := receiver.
819
83f614a5a77d eliminated isKindOf
Claus Gittinger <cg@exept.de>
parents: 744
diff changeset
   171
    [r isCascade] whileTrue:[
542
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   172
        r := r receiver.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   173
    ].
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   174
    r := r receiver.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   175
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   176
    nd := self.
819
83f614a5a77d eliminated isKindOf
Claus Gittinger <cg@exept.de>
parents: 744
diff changeset
   177
    [nd isCascade] whileTrue:[
542
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   178
        msg := MessageNode new.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   179
        msg receiver:r selector:nd selector args:nd args lineno:nd lineNumber.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   180
        msgs addFirst:msg.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   181
        nd := nd receiver.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   182
    ].
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   183
    msg := MessageNode new.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   184
    msg receiver:r selector:nd selector args:nd args lineno:nd lineNumber.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   185
    msgs addFirst:msg.
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   186
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   187
    ^ anEnumerator doCascade:self receiver:r messages:msgs
539
69a1cd05c7d6 added node-walk facility (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 263
diff changeset
   188
69a1cd05c7d6 added node-walk facility (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 263
diff changeset
   189
    "Created: 19.6.1997 / 16:39:17 / cg"
542
728300bd8861 more ST80 compatibility
Claus Gittinger <cg@exept.de>
parents: 539
diff changeset
   190
    "Modified: 19.6.1997 / 17:32:47 / cg"
539
69a1cd05c7d6 added node-walk facility (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 263
diff changeset
   191
! !
69a1cd05c7d6 added node-walk facility (ST80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 263
diff changeset
   192
1035
8848672cb893 category rename
Claus Gittinger <cg@exept.de>
parents: 861
diff changeset
   193
!CascadeNode methodsFor:'evaluation'!
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   194
1384
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   195
evaluateForCascadeIn:anEnvironment
4183
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   196
    |t argValueArray leftMostExpression sequence|
1384
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   197
1500
3c4cb012b24b Lazy conversion of selector strings to symbols.
Stefan Vogel <sv@exept.de>
parents: 1387
diff changeset
   198
    selector := selector asSymbol.
3c4cb012b24b Lazy conversion of selector strings to symbols.
Stefan Vogel <sv@exept.de>
parents: 1387
diff changeset
   199
1384
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   200
    receiver isSuper ifTrue:[
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   201
        ^ super evaluateForCascadeIn:anEnvironment
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   202
    ].
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   203
4183
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   204
    "/ new code: avoids recursion error for long cascades
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   205
    leftMostExpression := receiver.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   206
    sequence := OrderedCollection new.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   207
    [leftMostExpression isCascade] whileTrue:[
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   208
        sequence addFirst:leftMostExpression.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   209
        leftMostExpression := leftMostExpression receiver.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   210
    ].
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   211
    
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   212
    t := leftMostExpression evaluateForCascadeIn:anEnvironment. 
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   213
    sequence do:[:eachCascadeMessage |
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   214
        |eachSelector eachArgArray eachArgValueArray|
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   215
        
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   216
        eachSelector := eachCascadeMessage selector.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   217
        eachArgArray := eachCascadeMessage arguments.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   218
        eachArgArray size == 0 ifTrue:[
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   219
            t perform:eachSelector.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   220
        ] ifFalse:[
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   221
            eachArgValueArray := eachArgArray collect:[:arg | arg evaluateIn:anEnvironment]. 
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   222
            t perform:eachSelector withArguments:eachArgValueArray.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   223
        ].    
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   224
    ].
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   225
    
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   226
    "/ old code
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   227
"/    t := receiver evaluateForCascadeIn:anEnvironment.
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   228
1384
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   229
    argArray isNil ifTrue:[
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   230
        t perform:selector.
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   231
        ^ t
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   232
    ].
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   233
    argValueArray := argArray collect:[:arg | arg evaluateIn:anEnvironment]. 
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   234
    t perform:selector withArguments:argValueArray.
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   235
    ^ t
4183
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   236
4e9dedb504ca #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 4181
diff changeset
   237
    "Modified: / 08-08-2017 / 18:18:09 / cg"
1384
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   238
!
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   239
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   240
evaluateIn:anEnvironment
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   241
    |t argValueArray|
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   242
1500
3c4cb012b24b Lazy conversion of selector strings to symbols.
Stefan Vogel <sv@exept.de>
parents: 1387
diff changeset
   243
    selector := selector asSymbol.
3c4cb012b24b Lazy conversion of selector strings to symbols.
Stefan Vogel <sv@exept.de>
parents: 1387
diff changeset
   244
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   245
    receiver isSuper ifTrue:[
1384
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   246
        ^ super evaluateIn:anEnvironment
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   247
    ].
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   248
1384
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   249
    t := receiver evaluateForCascadeIn:anEnvironment.
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   250
    argArray isNil ifTrue:[
1344
e181501d8aa0 oops - cascade-evaluation did not return last value
Claus Gittinger <cg@exept.de>
parents: 1079
diff changeset
   251
        ^ t perform:selector.
e181501d8aa0 oops - cascade-evaluation did not return last value
Claus Gittinger <cg@exept.de>
parents: 1079
diff changeset
   252
        "/ t perform:selector. ^ t
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   253
    ].
1384
0db9682870d9 evaluate -> evaluateIn:
Claus Gittinger <cg@exept.de>
parents: 1344
diff changeset
   254
    argValueArray := argArray collect:[:arg | arg evaluateIn:anEnvironment].
140
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   255
    ^ t perform:selector withArguments:argValueArray
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   256
! !
1ef1d1395146 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 135
diff changeset
   257
1079
2a996e0def30 category change
Claus Gittinger <cg@exept.de>
parents: 1035
diff changeset
   258
!CascadeNode methodsFor:'printing & storing'!
15
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   259
1588
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   260
printOn:aStream indent:i 
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   261
    |selectorParts|
15
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   262
1588
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   263
    selectorParts := selector asCollectionOfSubstringsSeparatedBy:$:.
3155
5ab5d8ad71ed Changed usage of deprecated #copyWithoutLast: to #copyButLast:
Stefan Vogel <sv@exept.de>
parents: 2700
diff changeset
   264
    selectorParts last isEmpty ifTrue:[selectorParts := selectorParts copyButLast:1].
2693
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   265
15
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   266
    receiver printOn:aStream indent:i.
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   267
    aStream nextPutAll:'; '.
1588
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   268
    argArray size == 0 ifTrue:[
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   269
        selector printOn:aStream
15
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   270
    ] ifFalse:[
1588
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   271
        argArray 
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   272
            with:selectorParts
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   273
            do:[:arg :selPart | 
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   274
                aStream 
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   275
                    space;
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   276
                    nextPutAll:selPart;
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   277
                    nextPutAll:': '.
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   278
                arg printOn:aStream indent:i + 4 parenthized:(arg precedence <= self precedence).
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   279
            ]
15
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   280
    ]
1588
4c3183dfaa5f printing
Claus Gittinger <cg@exept.de>
parents: 1500
diff changeset
   281
2693
Claus Gittinger <cg@exept.de>
parents: 2593
diff changeset
   282
    "Modified: / 12-09-2011 / 09:46:45 / cg"
15
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   283
! !
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   284
2319
636647549e7c category change
Claus Gittinger <cg@exept.de>
parents: 1588
diff changeset
   285
!CascadeNode methodsFor:'testing'!
744
e871f9f072f8 changes for cascades to super/here semantics.
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
   286
e871f9f072f8 changes for cascades to super/here semantics.
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
   287
isCascade
e871f9f072f8 changes for cascades to super/here semantics.
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
   288
    ^ true
e871f9f072f8 changes for cascades to super/here semantics.
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
   289
e871f9f072f8 changes for cascades to super/here semantics.
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
   290
    "Created: / 16.7.1998 / 20:03:51 / cg"
e871f9f072f8 changes for cascades to super/here semantics.
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
   291
! !
e871f9f072f8 changes for cascades to super/here semantics.
Claus Gittinger <cg@exept.de>
parents: 542
diff changeset
   292
2593
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   293
!CascadeNode methodsFor:'visiting'!
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   294
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   295
acceptVisitor:aVisitor 
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   296
    "Double dispatch back to the visitor, passing my type encoded in
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   297
     the selector (visitor pattern)"
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   298
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   299
    "stub code automatically generated - please change if required"
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   300
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   301
    ^ aVisitor visitCascadeNode:self
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   302
! !
557c0dddfd66 - added acceptVisior:
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 2319
diff changeset
   303
148
ef0e604209ec version method at the end
Claus Gittinger <cg@exept.de>
parents: 140
diff changeset
   304
!CascadeNode class methodsFor:'documentation'!
ef0e604209ec version method at the end
Claus Gittinger <cg@exept.de>
parents: 140
diff changeset
   305
ef0e604209ec version method at the end
Claus Gittinger <cg@exept.de>
parents: 140
diff changeset
   306
version
4181
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   307
    ^ '$Header$'
2319
636647549e7c category change
Claus Gittinger <cg@exept.de>
parents: 1588
diff changeset
   308
!
636647549e7c category change
Claus Gittinger <cg@exept.de>
parents: 1588
diff changeset
   309
636647549e7c category change
Claus Gittinger <cg@exept.de>
parents: 1588
diff changeset
   310
version_CVS
4181
21f00e5abe0a #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 3155
diff changeset
   311
    ^ '$Header$'
148
ef0e604209ec version method at the end
Claus Gittinger <cg@exept.de>
parents: 140
diff changeset
   312
! !
3155
5ab5d8ad71ed Changed usage of deprecated #copyWithoutLast: to #copyButLast:
Stefan Vogel <sv@exept.de>
parents: 2700
diff changeset
   313