[Help-smalltalk] [PATCH] Fix conversion of comments

[Paolo Bonzini]

The conversion script had two problems related to comments:

- Comments inside doits were discarded

- Comments at the beginning of a doit didn't work (only those in the 
first doit worked)

Handling these is just a matter of (respectively) adding another public 
interface to RBFormatter, and creating another kind of EmittedEntity to 
print the comments.  However, in both cases doing so exposed an 
interesting problem.

The comments are stored relative to the original source code stream 
(using "stream position" in the scanner), and it is assumed that "node 
source copyFrom: a to: b" retrieves the text of the comment.  So, if a 
comment appears at the beginning of a doit, but not the first doit, the 
comment is stored as appearing, say, at bytes 10000 to 10200.

However, the RBFormatter requires the source code to be stored as a 
String (see #newLinesFor:startingAt:).  This is a problem because it 
requires each RBMethodNode to store the entire contents of the file!  It 
is true that we could use the same collection over and over, but it 
ain't pretty.

The solution is to store only the source code of the doit, but using a 
MappedCollection to remap the indices.  Then, say the source code of the 
doit might be at bytes 9900 to 10300: it is stored into a String with 
401 elements, but the MappedCollection makes sure that doing "node 
source copyFrom: 10000 to: 10200" works and extracts bytes 101 to 301 of 
the source code.

There is also another problem in the way comments were associated to $! 
(they ended up in the wrong method).  The solution is not really 
pleasing, but I plan to extract the parsing of doits into a subclass of 
RBParser (since this is code written by me and not present in the 
original refactoring browser code), which makes it more acceptable.

Paolo

2007-06-07  Paolo Bonzini  <address@hidden>

        * compiler/RBFormatter.st: Add #formatAll:.
        * compiler/RBParser.st: Fixes to doit parsing.
        * kernel/StreamOps.st: Add #copyFrom:to: to ConcatenatedStream.
        * scripts/Convert.st: Handle comments properly, using #formatAll:
        and handling toplevel comments independently.

--- orig/compiler/RBFormatter.st
+++ mod/compiler/RBFormatter.st
@@ -31,6 +31,10 @@ firstLineLength
        ifTrue: [codeStream position]
        ifFalse: [firstLineLength]!
 
+formatAll: anArray
+    self formatStatements: anArray.
+    ^codeStream contents!
+
 format: aNode 
     self visitNode: aNode.
     ^codeStream contents!
@@ -274,8 +278,9 @@ formatStatementCommentFor: aNode 
            self formatComment: (source copyFrom: each first to: each last)]!
 
 formatStatementsFor: aSequenceNode 
-    | statements |
-    statements := aSequenceNode statements.
+    self formatStatements: aSequenceNode statements!
+
+formatStatements: statements
     statements isEmpty ifTrue: [^self].
     1 to: statements size - 1
        do: 


--- orig/compiler/RBParser.st
+++ mod/compiler/RBParser.st
@@ -261,29 +261,33 @@ parseDoits
     " Parses the stuff to be executed until a
         ! <class expression> methodsFor: <category string> ! "
 
-    | node method start stop comments asd |
+    | node method start stop comments source |
 
     [
-               self atEnd ifTrue: [ ^false ].
-               comments := scanner getComments.
-               start := comments isNil
-               ifTrue: [ asd := true. currentToken start - 2 ]
-               ifFalse: [ asd := false. comments first first - 2 ].
-               
-               tags := nil.
-        node := self parseStatements: false.
-        comments notNil
-            ifTrue: [ node comments isNil ifTrue: [ node comments: #() ].
-                         node comments: comments, node comments ].
+       self atEnd ifTrue: [ ^false ].
+       comments := scanner getComments.
+       start := comments isNil
+               ifTrue: [ currentToken start - 1 ]
+               ifFalse: [ comments first first - 2 ].
+       
+       tags := nil.
+       node := self parseStatements: false.
+       node comments isNil
+           ifTrue: [ node comments: comments ]
+           ifFalse: [
+               comments isNil ifFalse: [ node comments: node comments, 
comments ] ].
 
         "One -1 accounts for base-1 vs. base-0 (as above), the
          other drops the bang because we have a one-token lookahead."
-               stop := currentToken start - 2.
+       stop := currentToken start - 2.
 
         method := RBMethodNode selectorParts: #() arguments: #().
-        method source: (scanner stream segmentFrom: start to: stop).
+        source := scanner stream copyFrom: start to: stop.
+       source := MappedCollection collection: source map: (1 - start to: stop).
+        method source: source.
         node parent: method.
 
+        scanner stripSeparators.           "gobble doit terminating bang"
         self step.           "gobble doit terminating bang"
                node statements size > 0 and: [ self evaluate: node ]
                
@@ -358,9 +362,11 @@ parseMethodDefinitionList
        stop := currentToken start - 2.
         node source: (scanner stream segmentFrom: start to: stop).
 
+        scanner stripSeparators.
         self step.           "gobble method terminating bang"
         self compile: node
     ].
+    scanner stripSeparators.
     self step.
     self endMethodList
 !
@@ -705,12 +711,13 @@ ignoreComments
     saveComments := false!
 
 next
-    | token |
+    | token ch |
     buffer reset.
     tokenStart := stream position.
+    ch := currentCharacter.
     characterType == #eof ifTrue: [^RBToken start: tokenStart + 1].    "The 
EOF token should occur after the end of input"
     token := self scanToken.
-    self stripSeparators.
+    ch == $! ifFalse: [ self stripSeparators ].
     ^token!
 
 nextPut: anObject 


--- orig/kernel/StreamOps.st
+++ mod/kernel/StreamOps.st
@@ -150,6 +150,17 @@ position: anInteger
     curPos := anInteger - startPos
 !
 
+copyFrom: start to: end
+    "needed to do the documentation"
+    | adjust stream |
+    self atEnd.
+    end + 1 = start ifTrue: [ ^'' ].
+    end <= startPos
+       ifTrue: [ stream := last. adjust := lastStart ]
+       ifFalse: [ stream := streams first. adjust := startPos ].
+    ^stream copyFrom: (start - adjust max: 0) to: end - adjust
+!
+
 segmentFrom: start to: end
     "needed to do the documentation"
     | adjust stream |


--- orig/scripts/Convert.st
+++ mod/scripts/Convert.st
@@ -38,6 +38,22 @@ Object subclass: EmittedEntity [  
     ]
 ]
 
+EmittedEntity subclass: EmittedComments [
+    | comments |
+    EmittedComments class >> comments: aCollection source: aString [
+       ^self new comments: (aCollection collect: [ :c |
+           aString copyFrom: c first to: c last ])
+    ]
+
+    emitTo: outStream [
+       comments do: [ :c | outStream nextPutAll: c; nl; nl ]
+    ]
+
+    comments: anArray [
+       comments := anArray
+   ]
+]
+
 EmittedEntity subclass: EmittedClass [
     | class methodsToEmit classMethodsToEmit isComplete |
     
@@ -97,15 +113,15 @@ EmittedEntity subclass: EmittedEval [
     ] 
     
     emitTo: aStream [
-        aStream nextPutAll: 'Eval ['; nl; space: 4.
-        statements do: [ :each | self emitStatement: each To: aStream ]
-                   separatedBy: [ aStream nextPut: $.; nl; space: 4 ].
+       | formatter |
+        aStream nextPutAll: 'Eval ['.
+       formatter := STInST.RBFormatter new.
+       formatter indent: 1 while: [
+           formatter indent.
+            aStream nextPutAll: (formatter formatAll: statements).
+       ].
         aStream nl; nextPut: $]; nl; nl.
     ]
-    
-    emitStatement: aStatement To: aStream [
-       aStream nextPutAll: (STInST.RBFormatter new format: aStatement)
-    ]
 ]
 
 
@@ -149,12 +165,8 @@ STInST.STClassLoader subclass: SyntaxCon
         <category: 'overrides'>
 
        "FIXME: there's a bug in RBParser.st"
-       stuffToEmit isEmpty ifTrue: [
-            node comments do: 
-                 [ :c | outStream
-                            nextPutAll: 
-                                (node source copyFrom: c first to: c last);
-                            nl; nl ] ].
+       node comments isEmpty ifFalse: [
+           stuffToEmit add: (EmittedComments comments: node comments source: 
node source) ].
 
         ^super evaluate: node
     ]
@@ -170,15 +182,18 @@ STInST.STClassLoader subclass: SyntaxCon
             ifFalse: [ self addMethod: method toExtensionClass: currentClass ]
     ]
     
+    lastIsEval [
+        <category: 'collecting entities'>
+
+        ^stuffToEmit notEmpty and: [ stuffToEmit last isKindOf: EmittedEval ]
+    ]
+
     unknown: node [
         <category: 'collecting entities'>
         
         | eval statement |
 
-        (stuffToEmit size > 0)
-            ifTrue: [ (stuffToEmit last isKindOf: EmittedEval)
-                        ifFalse: [ stuffToEmit add: (EmittedEval new) ] ]
-            ifFalse: [ stuffToEmit add: (EmittedEval new) ].
+       self lastIsEval ifFalse: [ stuffToEmit add: (EmittedEval new) ].
             
         eval := stuffToEmit last.
         eval addStatement: node.