help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [PATCH 2/3] stinst: prepare for rewrite of #(...) parsi


From: Paolo Bonzini
Subject: [Help-smalltalk] [PATCH 2/3] stinst: prepare for rewrite of #(...) parsing
Date: Tue, 7 Jan 2014 12:35:56 +0100

2014-01-07  Paolo Bonzini  <address@hidden>

        * kernel/SeqCollect.st: Add #with:allSatisfy:.

packages/blox/browser:
2014-01-07  Paolo Bonzini  <address@hidden>

        * PCode.st: Add #acceptLiteralArrayNode:.

packages/stinst/parser:
2014-01-07  Paolo Bonzini  <address@hidden>

        * RBFormatter.st: Add #acceptLiteralArrayNode:.
        * RBParseNodes.st: Implement RBLiteralArrayNode.
        * STCompiler.st: Add #acceptLiteralArrayNode:.
---
 ChangeLog                               |   4 +
 kernel/SeqCollect.st                    |  15 +++
 packages/blox/browser/ChangeLog         |   4 +
 packages/blox/browser/PCode.st          |  13 +++
 packages/stinst/parser/ChangeLog        |   5 +
 packages/stinst/parser/RBFormatter.st   |   9 ++
 packages/stinst/parser/RBParseNodes.st  | 158 +++++++++++++++++++++++++++++++-
 packages/stinst/parser/STCompiler.st    |  17 +++-
 packages/visualgst/SyntaxHighlighter.st |   7 ++
 9 files changed, 230 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ea47151..2a71965 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2014-01-07  Paolo Bonzini  <address@hidden>
+
+       * kernel/SeqCollect.st: Add #with:allSatisfy:.
+
 2013-12-14  Holger Hans Peter Freyther  <address@hidden>
 
        * configure.ac: Check for environ with AC_CHECK_DECLS.
diff --git a/kernel/SeqCollect.st b/kernel/SeqCollect.st
index d79ddaa..74ba166 100644
--- a/kernel/SeqCollect.st
+++ b/kernel/SeqCollect.st
@@ -957,6 +957,21 @@ some access and manipulation methods.'>
            do: [:i | aBlock value: (self at: i)]
     ]
 
+    with: aSequenceableCollection allSatisfy: aBlock [
+       "Evaluate aBlock for each pair of elements took respectively from
+        the receiver and from aSequenceableCollection. Return true if the
+         block returns true for each pair of elements, false otherwise.  Fail
+        if the receiver has not the same size as aSequenceableCollection."
+
+       <category: 'enumerating'>
+       self size = aSequenceableCollection size 
+           ifFalse: [^SystemExceptions.InvalidSize signalOn: 
aSequenceableCollection].
+       1 to: self size do: [:i |
+            (aBlock value: (self at: i) value: (aSequenceableCollection at: i))
+                ifFalse: [^false]].
+        ^true
+    ]
+
     with: aSequenceableCollection do: aBlock [
        "Evaluate aBlock for each pair of elements took respectively from
         the receiver and from aSequenceableCollection. Fail if the receiver
diff --git a/packages/blox/browser/ChangeLog b/packages/blox/browser/ChangeLog
index 1c1ddee..557908f 100644
--- a/packages/blox/browser/ChangeLog
+++ b/packages/blox/browser/ChangeLog
@@ -1,3 +1,7 @@
+2014-01-07  Paolo Bonzini  <address@hidden>
+
+       * PCode.st: Add #acceptLiteralArrayNode:.
+
 2010-12-04  Paolo Bonzini  <address@hidden>
 
        * package.xml: Remove now superfluous <file> tags.
diff --git a/packages/blox/browser/PCode.st b/packages/blox/browser/PCode.st
index 3efa9ca..d85b78f 100644
--- a/packages/blox/browser/PCode.st
+++ b/packages/blox/browser/PCode.st
@@ -372,6 +372,19 @@ STInST.STInST.RBProgramNodeVisitor subclass: 
SyntaxHighlighter [
                 widget highlightAs: #special at: semi ]"]
     ]
 
+    acceptLiteralArrayNode: aLiteralArrayNode [
+       <category: 'visitor-double dispatching'>
+       widget 
+           highlightAs: #literal
+           from: aLiteralNode start
+           to: aLiteralNode start + 1.
+        super acceptLiteralArrayNode: aLiteralArrayNode
+       widget 
+           highlightAs: #literal
+           from: aLiteralNode stop
+           to: aLiteralNode stop.
+    ]
+
     acceptLiteralNode: aLiteralNode [
        <category: 'visitor-double dispatching'>
        widget 
diff --git a/packages/stinst/parser/ChangeLog b/packages/stinst/parser/ChangeLog
index 4add5b9..a1c35cb 100644
--- a/packages/stinst/parser/ChangeLog
+++ b/packages/stinst/parser/ChangeLog
@@ -1,3 +1,8 @@
+2014-01-07  Paolo Bonzini  <address@hidden>
+
+       * RBFormatter.st: Add #acceptLiteralArrayNode:.
+       * RBParseNodes.st: Implement RBLiteralArrayNode.
+
 2014-01-07  Paolo Bonzini <address@hidden>
 
        * RBParserTests.st: New, extracted from RewriteTests.st.
diff --git a/packages/stinst/parser/RBFormatter.st 
b/packages/stinst/parser/RBFormatter.st
index ddd5215..f57f79d 100644
--- a/packages/stinst/parser/RBFormatter.st
+++ b/packages/stinst/parser/RBFormatter.st
@@ -483,6 +483,15 @@ RBProgramNodeVisitor subclass: RBFormatter [
                    separatedBy: [codeStream nextPut: $;]]
     ]
 
+    acceptLiteralArrayNode: aLiteralArrayNode [
+       <category: 'visitor-double dispatching'>
+       codeStream nextPutAll: '#('.
+       aLiteralArrayNode nodes
+            do: [:each | self visitNode: each]
+           separatedBy: [codeStream nextPut: $ ].
+       codeStream nextPut: $).
+    ]
+
     acceptLiteralNode: aLiteralNode [
        <category: 'visitor-double dispatching'>
        ^self formatLiteral: aLiteralNode token
diff --git a/packages/stinst/parser/RBParseNodes.st 
b/packages/stinst/parser/RBParseNodes.st
index 2600497..fe43987 100644
--- a/packages/stinst/parser/RBParseNodes.st
+++ b/packages/stinst/parser/RBParseNodes.st
@@ -76,6 +76,11 @@ Object subclass: RBProgramNodeVisitor [
        
     ]
 
+    acceptLiteralArrayNode: aLiteralArrayNode [
+       <category: 'visitor-double dispatching'>
+       aLiteralArrayNode nodes do: [:each | self visitNode: each]
+    ]
+
     acceptMessageNode: aMessageNode [
        <category: 'visitor-double dispatching'>
        self visitNode: aMessageNode receiver.
@@ -1839,6 +1844,153 @@ Instance Variables:
 
 
 
+RBValueNode subclass: RBLiteralArrayNode [
+    | left right nodes |
+    
+    <category: 'Refactory-Parser'>
+    <comment: 'RBLiteralArrayNode is an AST node that represents a literal 
array "#(...)".
+
+Instance Variables:
+    nodes   <Array of: RBLiteralNode|RBLiteralArrayNode|RBOptimizedNode>    
the items of the array
+    left    <Integer>    position of #(
+    right    <Integer>    position of )
+
+'>
+
+    RBLiteralArrayNode class >> nodes: anArray [
+       <category: 'instance creation'>
+       ^(self new)
+           nodes: anArray;
+           yourself
+    ]
+
+    RBLiteralArrayNode class >> left: leftInteger nodes: anArray right: 
rightInteger [
+       <category: 'instance creation'>
+       ^(self new)
+           left: leftInteger;
+               nodes: anArray;
+               right: rightInteger;
+           yourself
+    ]
+
+    acceptVisitor: aProgramNodeVisitor [
+       <category: 'visitor'>
+       ^aProgramNodeVisitor acceptLiteralArrayNode: self
+    ]
+
+    compiler: compiler [
+       <category: 'compile-time binding'>
+        nodes do: [:each | each compiler: compiler]
+    ]
+
+    nodes [
+       <category: 'accessing'>
+       ^nodes
+    ]
+
+    nodes: anArray [
+       <category: 'accessing'>
+       nodes := anArray.
+    ]
+
+    children [
+       <category: 'accessing'>
+       ^nodes
+    ]
+
+    left [
+       <category: 'accessing'>
+       ^left
+    ]
+
+    left: anObject [
+       <category: 'accessing'>
+       left := anObject
+    ]
+
+    precedence [
+       <category: 'accessing'>
+       ^0
+    ]
+
+    right [
+       <category: 'accessing'>
+       ^right
+    ]
+
+    right: anObject [
+       <category: 'accessing'>
+       right := anObject
+    ]
+
+    startWithoutParentheses [
+       <category: 'accessing'>
+       ^left
+    ]
+
+    stopWithoutParentheses [
+       <category: 'accessing'>
+       ^right
+    ]
+
+    = anObject [
+       <category: 'comparing'>
+       self == anObject ifTrue: [^true].
+       self class = anObject class ifFalse: [^false].
+       ^self nodes = anObject nodes
+    ]
+
+    equalTo: anObject withMapping: aDictionary [
+       <category: 'comparing'>
+       self class = anObject class ifFalse: [^false].
+       self nodes size = anObject nodes size ifFalse: [^false].
+       ^self nodes with: anObject nodes allSatisfy:
+            [ :n1 :n2 | n1 equalTo: n2 withMapping: aDictionary ]
+    ]
+
+    hash [
+       <category: 'comparing'>
+       ^self nodes hash
+    ]
+
+    postCopy [
+       <category: 'copying'>
+       super postCopy.
+       nodes := nodes collect: [ :each | each copy ]
+    ]
+
+    copyInContext: aDictionary [
+       <category: 'matching'>
+       ^self class nodes: (nodes copyInContext: aDictionary)
+    ]
+
+    match: aNode inContext: aDictionary [
+       <category: 'matching'>
+       aNode class == self class ifFalse: [^false].
+       aNode nodes size == self nodes size ifFalse: [^false].
+       ^self nodes with: aNode nodes allSatisfy:
+           [:ours :theirs | ours match: theirs inContext: aDictionary]
+    ]
+
+    replaceNode: aNode withNode: anotherNode [
+       <category: 'replacing'>
+       nodes keysAndValuesDo: [ :i :each |
+            each == aNode ifTrue: [nodes at: i put: anotherNode]]
+    ]
+
+    directlyUses: aNode [
+       <category: 'testing'>
+       ^nodes anySatisfy: [ :each | each directlyUses: aNode]
+    ]
+
+    references: aVariableName [
+       <category: 'testing'>
+       ^nodes anySatisfy: [ :each | each references: aVariableName]
+    ]
+]
+
+
+
 RBStatementListNode subclass: RBOptimizedNode [
     
     <category: 'Browser-Parser'>
@@ -1851,6 +2003,10 @@ RBOptimizedNode is an AST node that represents ##(...) 
expressions. These expres
        ^aProgramNodeVisitor acceptOptimizedNode: self
     ]
 
+    compiler: compiler [
+       <category: 'compile-time binding'>
+    ]
+
     isImmediate [
        <category: 'testing'>
        ^true
@@ -3140,7 +3296,7 @@ Instance Variables:
 
     matchLiteral: aNode inContext: aDictionary [
        <category: 'matching'>
-       ^aNode class == RBLiteralNode 
+       ^(aNode class == RBLiteralNode or: [aNode class == RBLiteralArrayNode])
            and: [(aDictionary at: self ifAbsentPut: [aNode]) = aNode]
     ]
 
diff --git a/packages/stinst/parser/STCompiler.st 
b/packages/stinst/parser/STCompiler.st
index 098437d..06798e0 100644
--- a/packages/stinst/parser/STCompiler.st
+++ b/packages/stinst/parser/STCompiler.st
@@ -621,11 +621,26 @@ indexed'' bytecode. The resulting stream is
         it represents."
 
        <category: 'visiting RBLiteralNodes'>
-       self depthIncr.
        aNode compiler: self.
+       self depthIncr.
        self pushLiteral: aNode value
     ]
 
+    acceptLiteralArrayNode: aNode [
+       "STLiteralNode has one instance variable, the token for the literal
+        it represents."
+
+       <category: 'visiting RBLiteralNodes'>
+        | value |
+       aNode compiler: self.
+        value := aNode nodes collect: [ :each |
+            each isOptimized
+                ifTrue: [ self class evaluate: each body parser: parser ]
+                ifFalse: [ each value ] ].
+       self depthIncr.
+       self pushLiteral: value
+    ]
+
     acceptAssignmentNode: aNode [
        "First compile the assigned, then the assignment to the assignee..."
 
diff --git a/packages/visualgst/SyntaxHighlighter.st 
b/packages/visualgst/SyntaxHighlighter.st
index 93a008c..84b6dfe 100644
--- a/packages/visualgst/SyntaxHighlighter.st
+++ b/packages/visualgst/SyntaxHighlighter.st
@@ -112,6 +112,13 @@ STInST.STInST.RBProgramNodeVisitor subclass: 
SyntaxHighlighter [
        textBuffer applyTagByName: #literal startOffset: (aLiteralNode start - 
1) endOffset: aLiteralNode stop
     ]
 
+    acceptLiteralArrayNode: aLiteralArrayNode [
+       <category: 'visitor-double dispatching'>
+       textBuffer applyTagByName: #literal startOffset: (aLiteralNode start - 
1) endOffset: aLiteralNode start.
+       super acceptLiteralArrayNode: aLiteralArrayNode.
+       textBuffer applyTagByName: #literal startOffset: (aLiteralNode stop - 
1) endOffset: aLiteralNode stop.
+    ]
+
     acceptMessageNode: aMessageNode [
        <category: 'visitor-double dispatching'>
 
-- 
1.8.4.2





reply via email to

[Prev in Thread] Current Thread [Next in Thread]