unmaintained/alien/marshall/syntax/syntax.factor

   1 ! Copyright (C) 2009 Jeremy Hughes.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.inline alien.inline.types alien.marshall
   4 combinators effects generalizations kernel locals make namespaces
   5 quotations sequences words alien.marshall.structs lexer parser
   6 vocabs.parser multiline ;
   7 IN: alien.marshall.syntax
   8
   9 :: marshalled-function ( name types effect -- word quot effect )
  10     name types effect factor-function
  11     [ in>> ]
  12     [ out>> types [ pointer-to-non-const-primitive? ] filter append ]
  13     bi <effect>
  14     [
  15         [
  16             types [ marshaller ] map , \ spread , ,
  17             types length , \ nkeep ,
  18             types [ out-arg-unmarshaller ] map
  19             effect out>> dup empty?
  20             [ drop ] [ first unmarshaller prefix ] if
  21             , \ spread ,
  22         ] [ ] make
  23     ] dip ;
  24
  25 : define-c-marshalled ( name types effect body -- )
  26     [
  27         [ marshalled-function define-declared ]
  28         [ prototype-string ] 3bi
  29     ] dip append-function-body c-strings get push ;
  30
  31 : define-c-marshalled' ( name effect body -- )
  32     [
  33         [ in>> ] keep
  34         [ marshalled-function define-declared ]
  35         [ out>> prototype-string' ] 3bi
  36     ] dip append-function-body c-strings get push ;
  37
  38 SYNTAX: CM-FUNCTION:
  39     function-types-effect parse-here define-c-marshalled ;
  40
  41 SYNTAX: M-FUNCTION:
  42     function-types-effect marshalled-function define-declared ;
  43
  44 SYNTAX: M-STRUCTURE:
  45     scan current-vocab parse-definition
  46     define-marshalled-struct ;
  47
  48 SYNTAX: CM-STRUCTURE:
  49     scan current-vocab parse-definition
  50     [ define-marshalled-struct ] [ nip define-c-struct ] 3bi ;