extra/smalltalk/selectors/selectors.factor

   1 ! Copyright (C) 2009, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays combinators effects generic.standard
   4 kernel sequences words lexer ;
   5 IN: smalltalk.selectors
   6
   7 SYMBOLS: unary binary keyword ;
   8
   9 : selector-type ( selector -- type )
  10     {
  11         { [ dup [ "~!@%&*-+=|\\<>,?/" member? ] all? ] [ binary ] }
  12         { [ CHAR: : over member? ] [ keyword ] }
  13         [ unary ]
  14     } cond nip ;
  15
  16 : selector>effect ( selector -- effect )
  17     dup selector-type {
  18         { unary [ drop { } ] }
  19         { binary [ drop { "x" } ] }
  20         { keyword [ [ CHAR: : = ] count "x" <array> ] }
  21     } case "receiver" suffix { "result" } <effect> ;
  22
  23 : selector>generic ( selector -- generic )
  24     [ "selector-" prepend "smalltalk.selectors" create-word dup ]
  25     [ selector>effect ]
  26     bi define-simple-generic ;
  27
  28 SYNTAX: SELECTOR: scan-token selector>generic drop ;