! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators.short-circuit
-continuations fry kernel namespaces quotations sequences sets
-generalizations slots locals.types splitting math
-locals.rewrite.closures generic words combinators locals smalltalk.ast
-smalltalk.compiler.lexenv smalltalk.compiler.assignment
-smalltalk.compiler.return smalltalk.selectors smalltalk.classes ;
+USING: accessors arrays assocs combinators continuations
+generic kernel locals.types math quotations sequences
+sequences.generalizations sets smalltalk.ast smalltalk.classes
+smalltalk.compiler.assignment smalltalk.compiler.lexenv
+smalltalk.compiler.return smalltalk.selectors splitting words ;
IN: smalltalk.compiler
GENERIC: compile-ast ( lexenv ast -- quot )
: compile-arguments ( lexenv ast -- quot )
arguments>> [ compile-ast ] with map [ ] join ;
+: compile-new ( lexenv ast -- quot )
+ [ receiver>> compile-ast ]
+ [ compile-arguments ] 2bi
+ [ new ] 3append ;
+
: compile-ifTrue:ifFalse: ( lexenv ast -- quot )
[ receiver>> compile-ast ]
[ compile-arguments ] 2bi
M: ast-message-send compile-ast
dup selector>> {
{ "ifTrue:ifFalse:" [ compile-ifTrue:ifFalse: ] }
+ { "new" [ compile-new ] }
[
drop
[ compile-arguments ]
: block-lexenv ( block -- lexenv )
[ [ arguments>> ] [ temporaries>> ] bi append ]
- [ body>> [ assigned-locals ] map concat unique ] bi
+ [ body>> [ assigned-locals ] map concat fast-set ] bi
'[
- dup dup _ key?
- [ <local-reader> ]
- [ <local> ]
- if
+ dup dup _ in? [ <local-reader> ] [ <local> ] if
] H{ } map>assoc
dup
[ nip local-reader? ] assoc-filter
[ lexenv self>> suffix ] dip <lambda> ;
: compile-method-body ( lexenv block -- quot )
- [ [ (compile-method-body) ] [ arguments>> length 1+ ] bi ] 2keep
+ [ [ (compile-method-body) ] [ arguments>> length 1 + ] bi ] 2keep
make-return ;
: compile-method ( lexenv ast-method -- )
nip
[
[ name>> ] [ superclass>> ] [ ivars>> ] tri
- define-class <class-lexenv>
+ define-class <class-lexenv>
]
[ methods>> ] bi
[ compile-method ] with each
M: ast-foreign compile-ast
nip
- [ class>> dup ":" split1 lookup [ ] [ no-word ] ?if ]
+ [ class>> dup ":" split1 lookup-word [ ] [ no-word ] ?if ]
[ name>> ] bi define-foreign
[ nil ] ;
: compile-smalltalk ( statement -- quot )
[ empty-lexenv ] dip [ compile-sequence nip 0 ]
- 2keep make-return ;
\ No newline at end of file
+ 2keep make-return ;