[Help-smalltalk] [patch] Behaviors understand method nodes as source code

[Stephen Compall]

smalltalk--backstage--2.2--patch-48
    Behaviors understand method nodes as source code

This lets the #compile: methods on Behaviors accept method nodes, 
skipping the parsing step in those cases.  It also includes some fixes 
for STCompiler I found while making it.

--
;;; Stephen Compall ** http://scompall.nocandysw.com/blog **
But you know how reluctant paranormal phenomena are to reveal
themselves when skeptics are present. --Robert Sheaffer, SkI 9/2003

2007-07-16  Stephen Compall  <address@hidden>

        * kernel/Behavior.st: Use #compileString:ifError: instead of
        #compileString: in #compile:ifError:.  Remove vacuous "code class
        == String" case in compile methods.

        * packages/stinst/parser/STCompiler.st: Add #canCompile: to
        STCompiler class.
        (#compileBoolean:) Don't put receiver's bytecodes if refusing to
        optimize the given message send.
        (#compileTimesRepeat:, #compileLoop:): Likewise.

        * packages/stinst/compiler/StartCompiler.st: Allow method nodes to
        be given directly to Behavior's compile methods, by checking
        whether the compilerClass can directly compile the given `code'
        object.


--- orig/kernel/Behavior.st
+++ mod/kernel/Behavior.st
@@ -216,7 +216,7 @@
      Else, return a CompiledMethod result of compilation"
     (code isKindOf: WriteStream)
        ifTrue: [ ^self compileString: code readStream ].
-    ((code isKindOf: Stream) or: [ code class == String ])
+    (code isKindOf: Stream)
        ifTrue: [ ^self compileString: code ].
 
     ^self compileString: code asString
@@ -224,14 +224,14 @@
 
 compile: code ifError: block
     "Compile method source.  If there are parsing errors, invoke
-     exception block, 'block' passing file name, line number and error.
-     description. Return a CompiledMethod result of compilation"
+     exception block, 'block' passing file name, line number and
+     error.  Return a CompiledMethod result of compilation"
     (code isKindOf: WriteStream)
-       ifTrue: [ ^self compileString: code readStream ].
-    ((code isKindOf: Stream) or: [ code class == String ])
-       ifTrue: [ ^self compileString: code ].
+       ifTrue: [ ^self compileString: code readStream ifError: block ].
+    (code isKindOf: Stream)
+       ifTrue: [ ^self compileString: code ifError: block ].
 
-    ^self compileString: code asString
+    ^self compileString: code asString ifError: block
 !
 
 compile: code notifying: requestor


--- orig/packages/stinst/compiler/StartCompiler.st
+++ mod/packages/stinst/compiler/StartCompiler.st
@@ -300,7 +300,42 @@
        ]
 !
 
+compile: code
+    "Compile code as method source, which may be a stream, a parse
+     node, or anything that responds to #asString.  If there are
+     parsing errors, answer nil.  Else, answer a CompiledMethod, the
+     result of compilation."
+    ^self compile: code ifError: [:f :l :m | nil]
+!
+
+compile: code ifError: block
+    "Compile code as method source, which may be a stream, a parse
+     node, or anything that responds to #asString.  If there are
+     parsing errors, invoke exception block, 'block' passing file
+     name, line number and error.  Answer a CompiledMethod, the result
+     of compilation."
+    (self compilerClass canCompile: code)
+       ifTrue: [| dummyParser |
+                dummyParser := self parserClass new.
+                dummyParser errorBlock: [:m :l |
+                    ^block value: 'a Smalltalk %1' % {code class}
+                           value: l - 1 value: m].
+                ^self compilerClass
+                    compile: code for: self
+                    classified: nil parser: dummyParser].
+    (code isKindOf: WriteStream)
+       ifTrue: [ ^self compileString: code readStream ifError: block ].
+    (code isKindOf: Stream)
+       ifTrue: [ ^self compileString: code ifError: block ].
+
+    ^self compileString: code asString ifError: block
+!
+
 compileString: aString
+    "Compile aString, which should be a string or stream, as a method
+     for my instances, installing it in my method dictionary.  Signal
+     an error if parsing or compilation fail, otherwise answer the
+     resulting CompiledMethod."
     | parser source |
     source := aString isString
        ifTrue: [ aString ]


--- orig/packages/stinst/parser/STCompiler.st
+++ mod/packages/stinst/parser/STCompiler.st
@@ -124,6 +124,12 @@
 
 !STCompiler class methodsFor: 'compilation'!
 
+canCompile: code
+    "Answer whether I know how to compile the given code directly, on
+     behalf of a Behavior."
+    ^(code isKindOf: RBProgramNode) and: [code isMethod]
+!
+
 compile: methodNode for: aBehavior classified: aString parser: aParser
     ^aBehavior
        addSelector: methodNode selector
@@ -735,7 +741,7 @@
 
 compileTimesRepeat: aNode
     | block |
-    aNode receiver acceptVisitor: self.
+    "aNode receiver acceptVisitor: self."
     block := aNode arguments first.
     (block arguments isEmpty and: [
        block body temporaries isEmpty ]) ifFalse: [ ^false ].
@@ -745,7 +751,7 @@
 
 compileLoop: aNode
     | stop step block |
-    aNode receiver acceptVisitor: self.
+    "aNode receiver acceptVisitor: self."
     aNode arguments do: [ :each |
        stop := step.                   "to:"
        step := block.                  "by:"
@@ -763,7 +769,6 @@
 
 compileBoolean: aNode
     | bc1 ret1 bc2 selector |
-    aNode receiver acceptVisitor: self.
     aNode arguments do: [ :each |
         (each arguments isEmpty and: [
            each body temporaries isEmpty ]) ifFalse: [ ^false ].
@@ -776,6 +781,7 @@
                bc2 := self bytecodesFor: each ].
     ].
 
+    aNode receiver acceptVisitor: self.
     selector := aNode selector.
     bc2 isNil ifTrue: [
        "Transform everything into #ifTrue:ifFalse: or #ifFalse:ifTrue:"
@@ -804,7 +810,7 @@
     selector == #ifFalse:ifTrue: ifTrue: [
        ^self compileIfFalse: bc1 returns: ret1 ifTrue: bc2
     ].
-    ^false "What happened?!?"
+    ^self error: 'bad boolean message selector'
 !
 
 compileBoolean: aNode longBranch: bc1 returns: ret1 shortBranch: bc2