Smalltalk parser work in progress

extra/smalltalk/eval/eval-tests.factor

@@ -1,5 +1,7 @@
 IN: smalltalk.eval.tests
-USING: smalltalk.eval tools.test ;
+USING: smalltalk.eval tools.test io.streams.string ;
 
 [ 3 ] [ "1+2" eval-smalltalk ] unit-test
 [ "HAI" ] [ "(1<10) ifTrue:['HAI'] ifFalse:['BAI']" eval-smalltalk ] unit-test
+[ 7 ] [ "1+2+3;+4" eval-smalltalk ] unit-test
+[ 6 "5\n6\n" ] [ [ "[:x|x print] value: 5; value: 6" eval-smalltalk ] with-string-writer ] unit-test

extra/smalltalk/parser/parser-tests.factor

@@ -228,12 +228,12 @@ test         = <foreign parse-smalltalk LocalVariableDeclarationList>
 [ T{ ast-local-variables f { "i" "j" } } ] [ " |  i j   |" test-LocalVariableDeclarationList ] unit-test
 
 
-EBNF: test-KeywordMessageSend
+EBNF: test-MessageSend
-test         = <foreign parse-smalltalk KeywordMessageSend>
+test         = <foreign parse-smalltalk MessageSend>
 ;EBNF
 
 [ T{ ast-message-send f T{ ast-name f "x" } "foo:bar:" { 1 2 } } ]
-[ "x foo:1 bar:2" test-KeywordMessageSend ] unit-test
+[ "x foo:1 bar:2" test-MessageSend ] unit-test
 
 [
     T{ ast-message-send
@@ -247,7 +247,7 @@ test         = <foreign parse-smalltalk KeywordMessageSend>
         { 10 100 }
     }
 ]
-[ "3 factorial + 4 factorial between: 10 and: 100" test-KeywordMessageSend ] unit-test
+[ "3 factorial + 4 factorial between: 10 and: 100" test-MessageSend ] unit-test
 
 [ T{ ast-sequence f { 1 2 } } ] [ "1. 2" parse-smalltalk ] unit-test
 
@@ -283,4 +283,6 @@ test         = <foreign parse-smalltalk KeywordMessageSend>
 ]
 [ "class Test1 [|a|]. class Test2 extends Test1 [|b|]" parse-smalltalk ] unit-test
 
+[ ] [ "class Foo []. Tests blah " parse-smalltalk drop ] unit-test
+
 [ ] [ "vocab:smalltalk/parser/test.st" ascii file-contents parse-smalltalk drop ] unit-test

extra/smalltalk/parser/parser.factor

@@ -104,7 +104,7 @@ BlockLiteral = "["
                  "|"
                  => [[ args ]]
                 )?:args
-                ExecutableCode:body OptionalWhiteSpace
+                ExecutableCode:body
                 "]" => [[ args >array body ast-block boa ]]
 
 Literal = (ConstantReference
@@ -125,41 +125,38 @@ Operand =       Literal
 UnaryMessage = OptionalWhiteSpace
                UnaryMessageSelector:s !(":")
                => [[ s { } ast-message boa ]]
-UnaryMessageOperand = UnaryMessageSend | Operand
-UnaryMessageSend = UnaryMessageOperand:receiver
-                   UnaryMessage:h
-                   (OptionalWhiteSpace ";" UnaryMessage:m => [[ m ]])*:t
-                   => [[ receiver t h prefix >array <ast-cascade> ]]
 
 BinaryMessage = OptionalWhiteSpace
                 BinaryMessageSelector:selector
                 OptionalWhiteSpace
-                BinaryMessageOperand:rhs
+                (MessageSend | Operand):rhs
                 => [[ selector { rhs } ast-message boa ]]
                                    
-BinaryMessageOperand = BinaryMessageSend | UnaryMessageSend | Operand
+KeywordMessageSegment = Keyword:k OptionalWhiteSpace (BinaryMessageSend | UnaryMessageSend | Operand):arg => [[ { k arg } ]]
-BinaryMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
-                    BinaryMessage:h
-                   (OptionalWhiteSpace ";" BinaryMessage:m => [[ m ]])*:t
-                   => [[ lhs t h prefix >array <ast-cascade> ]]
-
-KeywordMessageSegment = Keyword:k OptionalWhiteSpace BinaryMessageOperand:arg => [[ { k arg } ]]
 KeywordMessage = OptionalWhiteSpace
                  KeywordMessageSegment:h
                  (OptionalWhiteSpace KeywordMessageSegment:s => [[ s ]])*:t
                  => [[ t h prefix unzip [ concat ] dip ast-message boa ]]
-KeywordMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):receiver
-                     OptionalWhiteSpace
-                     KeywordMessage:m
-                     => [[ receiver m 1array <ast-cascade> ]]
 
 Message = BinaryMessage | UnaryMessage | KeywordMessage
 
-MessageSend = (MessageSend | Operand):lhs
+UnaryMessageSend = (MessageSend | Operand):lhs
               Message:h
               (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
               => [[ lhs t h prefix >array <ast-cascade> ]]
 
+BinaryMessageSend = (MessageSend | Operand):lhs
+              Message:h
+              (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
+              => [[ lhs t h prefix >array <ast-cascade> ]]
+
+KeywordMessageSend = (BinaryMessageSend | UnaryMessageSend | Operand):lhs
+              KeywordMessage:h
+              (OptionalWhiteSpace ";" Message:m => [[ m ]])*:t
+              => [[ lhs t h prefix >array <ast-cascade> ]]
+
+MessageSend = BinaryMessageSend | UnaryMessageSend | KeywordMessageSend
+
 Expression = OptionalWhiteSpace
              (MessageSend | Operand):e
              => [[ e ]]
@@ -182,6 +179,7 @@ LocalVariableDeclarationList = OptionalWhiteSpace "|" OptionalWhiteSpace
 ExecutableCode = (LocalVariableDeclarationList)?:locals
                  ((Statement:s OptionalWhiteSpace "." => [[ s ]])*:h
                  FinalStatement:t (".")? => [[ h t suffix ]])?:body
+                 OptionalWhiteSpace
                  => [[ body locals [ suffix ] when* >array ]]
 
 TopLevelForm = ExecutableCode => [[ ast-sequence boa ]]
@@ -201,7 +199,7 @@ MethodHeader =   KeywordMethodHeader
 MethodDeclaration = OptionalWhiteSpace "method" OptionalWhiteSpace MethodHeader:header
         OptionalWhiteSpace "["
         ExecutableCode:code
-        OptionalWhiteSpace "]"
+        "]"
         => [[ header first2 code ast-block boa ast-method boa ]]
 
 ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
@@ -209,7 +207,13 @@ ClassDeclaration = OptionalWhiteSpace "class" OptionalWhiteSpace Identifier:name
         ("extends" OptionalWhiteSpace Identifier:superclass OptionalWhiteSpace => [[ superclass ]])?:superclass
         OptionalWhiteSpace "["
         (OptionalWhiteSpace LocalVariableDeclarationList:l => [[ l names>> ]])?:ivars
-        (MethodDeclaration:h (OptionalWhiteSpace MethodDeclaration:m => [[ m ]])*:t => [[ t h prefix ]])?:methods
+        (MethodDeclaration:h
+         (OptionalWhiteSpace
+          "."
+          OptionalWhiteSpace
+          MethodDeclaration:m => [[ m ]])*:t (".")?
+          => [[ t h prefix ]]
+         )?:methods
         OptionalWhiteSpace "]"
         => [[ name superclass "Object" or ivars >array methods >array ast-class boa ]]
 

extra/smalltalk/parser/test.st

@@ -30,23 +30,23 @@ class TreeNode extends Object [
         output
             nextPutAll: 'long lived tree of depth '; print: maxDepth; tab;
             nextPutAll: ' check: '; print: longLivedTree itemCheck; nl
-    ]
+    ].
 
     method binarytrees [
         self binarytrees: self arg to: self stdout.
         ^''
-    ]
+    ].
 
     method left: leftChild right: rightChild item: anItem [
         left := leftChild.
         right := rightChild.
         item := anItem
-    ]
+    ].
 
     method itemCheck [
         ^left isNil
             ifTrue: [item] ifFalse: [item + (left itemCheck - right itemCheck)]
-    ]
+    ].
 
     method bottomUpTree: anItem depth: anInteger [
         ^(anInteger > 0)
@@ -56,11 +56,11 @@ class TreeNode extends Object [
                     right: (self bottomUpTree: 2*anItem depth: anInteger - 1)
                     item: anItem
             ] ifFalse: [self left: nil right: nil item: anItem]
-    ]
+    ].
 
     method left: leftChild right: rightChild item: anItem [
         ^(super new) left: leftChild right: rightChild item: anItem
     ]
-]
+].
 
 Tests binarytrees