unmaintained/alien/marshall/structs/structs.factor

   1 ! Copyright (C) 2009 Jeremy Hughes.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types alien.marshall arrays assocs
   4 classes.tuple combinators destructors generalizations generic
   5 kernel libc locals parser quotations sequences slots words
   6 alien.structs lexer vocabs.parser fry effects alien.data ;
   7 IN: alien.marshall.structs
   8
   9 <PRIVATE
  10 : define-struct-accessor ( class name quot -- )
  11     [ "accessors" create create-method dup make-inline ] dip define ;
  12
  13 : define-struct-getter ( class name word type -- )
  14     [ ">>" append \ underlying>> ] 2dip
  15     struct-field-unmarshaller \ call 4array >quotation
  16     define-struct-accessor ;
  17
  18 : define-struct-setter ( class name word type -- )
  19     [ "<<" append ] 2dip
  20     marshaller [ underlying>> ] \ bi* roll 4array >quotation
  21     define-struct-accessor ;
  22
  23 : define-struct-accessors ( class name type reader writer -- )
  24     [ dup define-protocol-slot ] 3dip
  25     [ drop swap define-struct-getter ]
  26     [ nip swap define-struct-setter ] 5 nbi ;
  27
  28 : define-struct-constructor ( class -- )
  29     {
  30         [ name>> "<" prepend ">" append create-word-in ]
  31         [ '[ _ new ] ]
  32         [ name>> '[ _ malloc-struct >>underlying ] append ]
  33         [ name>> 1array ]
  34     } cleave { } swap <effect> define-declared ;
  35 PRIVATE>
  36
  37 :: define-struct-tuple ( name -- )
  38     name create-word-in :> class
  39     class struct-wrapper { } define-tuple-class
  40     class define-struct-constructor
  41     name c-type fields>> [
  42         class swap
  43         {
  44             [ name>> H{ { CHAR: space CHAR: - } } substitute ]
  45             [ type>> ] [ reader>> ] [ writer>> ]
  46         } cleave define-struct-accessors
  47     ] each ;
  48
  49 : define-marshalled-struct ( name vocab fields -- )
  50     [ define-struct ] [ 2drop define-struct-tuple ] 3bi ;