basis/alien/syntax/syntax.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov, Alex Chapman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays alien alien.c-types alien.structs
   4 alien.arrays alien.strings kernel math namespaces parser
   5 sequences words quotations math.parser splitting grouping
   6 effects prettyprint prettyprint.sections prettyprint.backend
   7 assocs combinators lexer strings.parser ;
   8 IN: alien.syntax
   9
  10 <PRIVATE
  11
  12 : parse-arglist ( return seq -- types effect )
  13     2 group dup keys swap values [ "," ?tail drop ] map
  14     rot dup "void" = [ drop { } ] [ 1array ] if <effect> ;
  15
  16 : function-quot ( type lib func types -- quot )
  17     [ alien-invoke ] 2curry 2curry ;
  18
  19 : define-function ( return library function parameters -- )
  20     >r pick r> parse-arglist
  21     pick create-in dup reset-generic
  22     >r >r function-quot r> r>
  23     -rot define-declared ;
  24
  25 PRIVATE>
  26
  27 : indirect-quot ( function-ptr-quot return types abi -- quot )
  28     [ alien-indirect ] 3curry compose ;
  29
  30 : define-indirect ( abi return function-ptr-quot function-name parameters -- )
  31     >r pick r> parse-arglist
  32     rot create-in dup reset-generic
  33     >r >r swapd roll indirect-quot r> r>
  34     -rot define-declared ;
  35
  36 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
  37
  38 : ALIEN: scan string>number <alien> parsed ; parsing
  39
  40 : BAD-ALIEN <bad-alien> parsed ; parsing
  41
  42 : LIBRARY: scan "c-library" set ; parsing
  43
  44 : FUNCTION:
  45     scan "c-library" get scan ";" parse-tokens
  46     [ "()" subseq? not ] filter
  47     define-function ; parsing
  48
  49 : TYPEDEF:
  50     scan scan typedef ; parsing
  51
  52 : TYPEDEF-IF:
  53     scan-word execute scan scan rot [ typedef ] [ 2drop ] if ; parsing
  54
  55 : C-STRUCT:
  56     scan in get
  57     parse-definition
  58     >r 2dup r> define-struct-early
  59     define-struct ; parsing
  60
  61 : C-UNION:
  62     scan in get parse-definition define-union ; parsing
  63
  64 : C-ENUM:
  65     ";" parse-tokens
  66     dup length
  67     [ >r create-in r> 1quotation define ] 2each ;
  68     parsing
  69
  70 M: alien pprint*
  71     {
  72         { [ dup expired? ] [ drop \ BAD-ALIEN pprint-word ] }
  73         { [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
  74         [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ]
  75     } cond ;
  76
  77 M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;