extra/smalltalk/ast/ast.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays combinators kernel memoize sequences
   4 strings ;
   5 IN: smalltalk.ast
   6
   7 SINGLETONS: nil self super ;
   8
   9 TUPLE: ast-comment { string string } ;
  10 TUPLE: ast-block { arguments array } { temporaries array } { body array } ;
  11 TUPLE: ast-message-send receiver { selector string } { arguments array } ;
  12 TUPLE: ast-message { selector string } { arguments array } ;
  13 TUPLE: ast-cascade receiver { messages array } ;
  14 TUPLE: ast-name { name string } ;
  15 TUPLE: ast-return value ;
  16 TUPLE: ast-assignment { name ast-name } value ;
  17 TUPLE: ast-local-variables { names array } ;
  18 TUPLE: ast-method { name string } { body ast-block } ;
  19 TUPLE: ast-class { name string } { superclass string } { ivars array } { methods array } ;
  20 TUPLE: ast-foreign { class string } { name string } ;
  21 TUPLE: ast-sequence { temporaries array } { body array } ;
  22
  23 ! We treat a sequence of statements like a block in a few places to
  24 ! simplify handling of top-level forms
  25 M: ast-sequence arguments>> drop { } ;
  26
  27 : unclip-temporaries ( statements -- temporaries statements' )
  28     {
  29         { [ dup empty? ] [ { } ] }
  30         { [ dup first ast-local-variables? not ] [ { } ] }
  31         [ unclip names>> ]
  32     } cond swap ;
  33
  34 : <ast-block> ( arguments body -- block )
  35     unclip-temporaries ast-block boa ;
  36
  37 : <ast-sequence> ( body -- block )
  38     unclip-temporaries ast-sequence boa ;
  39
  40 ! The parser parses normal message sends as cascades with one message, but
  41 ! we represent them differently in the AST to simplify generated code in
  42 ! the common case
  43 : <ast-cascade> ( receiver messages -- ast )
  44     dup length 1 =
  45     [ first [ selector>> ] [ arguments>> ] bi ast-message-send boa ]
  46     [ ast-cascade boa ]
  47     if ;
  48
  49 ! Methods return self by default
  50 : <ast-method> ( class arguments body -- method )
  51     self suffix <ast-block> ast-method boa ;
  52
  53 TUPLE: symbol { name string } ;
  54 MEMO: intern ( name -- symbol ) symbol boa ;