compile-ast ( lexenv ast -- quot )

Vocabulary

smalltalk.compiler

Inputs

lexenv	an object
ast	an object

Outputs

quot

an object

Definition

IN: smalltalk.compiler

GENERIC: compile-ast ( lexenv ast -- quot )

Methods

USING: arrays generic kernel sequences sequences.generalizations
smalltalk.compiler ;

M: array compile-ast
    dup contains-blocks? [
        [ [ compile-ast ] with map [ ] join ] [ length ] bi
        [ narray ] curry compose
    ] [ M\ array compile-ast (call-next-method) ] if ;


USING: accessors kernel sequences smalltalk.ast
smalltalk.compiler ;

M: ast-assignment compile-ast
    [ value>> compile-ast [ dup ] ]
    [ name>> compile-assignment ] 2bi 3append ;


USING: kernel locals.types smalltalk.ast smalltalk.compiler ;

M: ast-block compile-ast compile-sequence <lambda> [ ] curry ;


USING: accessors combinators kernel sequences smalltalk.ast
smalltalk.compiler smalltalk.selectors ;

M: ast-cascade compile-ast
    [ receiver>> compile-ast ] [
        messages>> [
            [ compile-arguments \ dip ]
            [ selector>> selector>generic ] bi [ ] 3sequence
        ] with map unclip-last [ [ [ drop ] append ] map ] dip
        suffix cleave>quot
    ] 2bi append ;


USING: accessors kernel sequences smalltalk.ast
smalltalk.classes smalltalk.compiler ;

M: ast-class compile-ast
    nip [
        [ name>> ] [ superclass>> ] [ ivars>> ] tri define-class
        <class-lexenv>
    ] [ methods>> ] bi [ compile-method ] with each [ nil ] ;


USING: accessors kernel smalltalk.ast smalltalk.classes
smalltalk.compiler splitting words ;

M: ast-foreign compile-ast
    nip
    [ class>> [ ":" split1 lookup-word ] [ no-word ] ?unless ]
    [ name>> ] bi define-foreign [ nil ] ;


USING: accessors combinators kernel sequences smalltalk.ast
smalltalk.compiler smalltalk.selectors ;

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 ;


USING: accessors kernel smalltalk.ast smalltalk.compiler
smalltalk.compiler.lexenv ;

M: ast-name compile-ast name>> swap lookup-reader ;


USING: accessors continuations kernel quotations sequences
smalltalk.ast smalltalk.compiler ;

M: ast-return compile-ast
    [ value>> compile-ast ] [ drop return>> 1quotation ] 2bi
    [ continue-with ] 3append ;


USING: kernel smalltalk.ast smalltalk.compiler ;

M: ast-sequence compile-ast compile-sequence nip ;


USING: kernel quotations smalltalk.compiler ;

M: object compile-ast nip 1quotation ;


USING: accessors kernel quotations smalltalk.ast
smalltalk.compiler ;

M: self compile-ast drop self>> 1quotation ;