extra/self/slots/slots.factor

   1
   2 USING: kernel words lexer parser sequences accessors self ;
   3
   4 IN: self.slots
   5
   6 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   7
   8 : define-self-slot-reader ( slot -- )
   9   [ "->" append current-vocab create dup set-word ]
  10   [ ">>" append search [ self> ] swap suffix      ] bi
  11   (( -- value )) define-declared ;
  12
  13 : define-self-slot-writer ( slot -- )
  14   [ "->" prepend current-vocab create dup set-word ]
  15   [ ">>" prepend search [ self> swap ] swap suffix [ drop ] append ] bi
  16   (( value -- )) define-declared ;
  17
  18 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  19
  20 : define-self-slot-accessors ( class -- )
  21   "slots" word-prop
  22   [ name>> ] map
  23   [ [ define-self-slot-reader ] [ define-self-slot-writer ] bi ] each ;
  24
  25 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  26
  27 : SELF-SLOTS: scan-word define-self-slot-accessors ; parsing