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