Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / extra / smalltalk / compiler / compiler.factor

diff --git a/extra/smalltalk/compiler/compiler.factor b/extra/smalltalk/compiler/compiler.factor
index e61b44ffaea34fde05f289c4832f1b2df5756d76..0c1a5c07d17d21e0073ddfb824ea2a84b309966b 100644 (file)
--- a/extra/smalltalk/compiler/compiler.factor
+++ b/extra/smalltalk/compiler/compiler.factor
@@ -21,11 +21,28 @@ M: ast-name compile-ast name>> swap lookup-reader ;
 : compile-arguments ( lexenv ast -- quot )
     arguments>> [ compile-ast ] with map [ ] join ;
 
-M: ast-message-send compile-ast
-    [ compile-arguments ]
+: compile-new ( lexenv ast -- quot )
+    [ receiver>> compile-ast ]
+    [ compile-arguments ] 2bi
+    [ new ] 3append ;
+
+: compile-ifTrue:ifFalse: ( lexenv ast -- quot )
     [ receiver>> compile-ast ]
-    [ nip selector>> selector>generic ]
-    2tri [ append ] dip suffix ;
+    [ compile-arguments ] 2bi
+    [ if ] 3append ;
+
+M: ast-message-send compile-ast
+    dup selector>> {
+        { "ifTrue:ifFalse:" [ compile-ifTrue:ifFalse: ] }
+        { "new" [ compile-new ] }
+        [
+            drop
+            [ compile-arguments ]
+            [ receiver>> compile-ast ]
+            [ nip selector>> selector>generic ]
+            2tri [ append ] dip suffix
+        ]
+    } case ;
 
 M: ast-cascade compile-ast
     [ receiver>> compile-ast ]
@@ -40,8 +57,8 @@ M: ast-cascade compile-ast
     ] 2bi append ;
 
 M: ast-return compile-ast
-    value>> compile-ast
-    [ return-continuation get continue-with ] append ;
+    [ value>> compile-ast ] [ drop return>> 1quotation ] 2bi
+    [ continue-with ] 3append ;
 
 : (compile-sequence) ( lexenv asts -- quot )
     [ drop [ nil ] ] [
@@ -106,7 +123,7 @@ M: ast-block compile-ast
     [ lexenv self>> suffix ] dip <lambda> ;
 
 : compile-method-body ( lexenv block -- quot )
-    [ [ (compile-method-body) ] [ arguments>> length 1+ ] bi ] keep
+    [ [ (compile-method-body) ] [ arguments>> length 1 + ] bi ] 2keep
     make-return ;
 
 : compile-method ( lexenv ast-method -- )
@@ -115,7 +132,7 @@ M: ast-block compile-ast
     2bi define ;
 
 : <class-lexenv> ( class -- lexenv )
-    <lexenv> swap >>class "self" <local-reader> >>self ;
+    <lexenv> swap >>class "self" <local> >>self "^" <local> >>return ;
 
 M: ast-class compile-ast
     nip
@@ -136,5 +153,5 @@ M: ast-foreign compile-ast
     [ nil ] ;
 
 : compile-smalltalk ( statement -- quot )
-    [ [ empty-lexenv ] dip compile-sequence nip 0 ]
-    keep make-return ;
\ No newline at end of file
+    [ empty-lexenv ] dip [ compile-sequence nip 0 ]
+    2keep make-return ;