basis/functors/backend/backend.factor

   1 USING: accessors arrays assocs generic.standard kernel
   2 lexer locals.types namespaces parser quotations vocabs.parser
   3 words classes.tuple ;
   4 IN: functors.backend
   5
   6 DEFER: functor-words
   7 \ functor-words [ H{ } clone ] initialize
   8
   9 SYNTAX: FUNCTOR-SYNTAX:
  10     scan-word
  11     gensym [ parse-definition define-syntax ] keep
  12     swap name>> \ functor-words get-global set-at ;
  13
  14 : functor-words ( -- assoc )
  15     \ functor-words get-global ;
  16
  17 : scan-param ( -- obj ) scan-object literalize ;
  18
  19 : >string-param ( string -- string/param )
  20     dup search dup lexical? [ nip ] [ drop ] if ;
  21
  22 : scan-string-param ( -- name/param )
  23     scan-token >string-param ;
  24
  25 : scan-c-type-param ( -- c-type/param )
  26     (scan-token) dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;
  27
  28 : define* ( word def -- ) over set-word define ;
  29
  30 : define-declared* ( word def effect -- )
  31     pick set-word define-declared ;
  32
  33 : define-simple-generic* ( word effect -- )
  34     over set-word define-simple-generic ;
  35
  36 : define-tuple-class* ( class superclass slots -- )
  37     pick set-word define-tuple-class ;