allow FUNCTION: to parse pointers in the name field
							parent
							
								
									555309ba86
								
							
						
					
					
						commit
						9bb38b870c
					
				| 
						 | 
				
			
			@ -1,27 +1,30 @@
 | 
			
		|||
! Copyright (C) 2008, 2009 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: alien alien.c-types arrays assocs effects grouping kernel
 | 
			
		||||
parser sequences splitting words fry locals lexer namespaces
 | 
			
		||||
summary ;
 | 
			
		||||
summary math ;
 | 
			
		||||
IN: alien.parser
 | 
			
		||||
 | 
			
		||||
ERROR: invalid-c-name name ;
 | 
			
		||||
 | 
			
		||||
M: invalid-c-name summary
 | 
			
		||||
    drop "The C pointer asterisk must be part of the type string." ;
 | 
			
		||||
 | 
			
		||||
: check-c-name ( string -- string )
 | 
			
		||||
    dup [ CHAR: * = ] any? [ invalid-c-name ] when ;
 | 
			
		||||
: normalize-c-arg ( type name -- type' name' )
 | 
			
		||||
    [ length ]
 | 
			
		||||
    [
 | 
			
		||||
        [ CHAR: * = ] trim-head
 | 
			
		||||
        [ length - CHAR: * <array> append ] keep
 | 
			
		||||
    ] bi ;
 | 
			
		||||
 | 
			
		||||
: parse-arglist ( parameters return -- types effect )
 | 
			
		||||
    [ 2 group unzip [ "," ?tail drop check-c-name ] map ]
 | 
			
		||||
    [
 | 
			
		||||
        2 group [ first2 normalize-c-arg 2array ] map
 | 
			
		||||
        unzip [ "," ?tail drop check-c-name ] map
 | 
			
		||||
    ]
 | 
			
		||||
    [ [ { } ] [ 1array ] if-void ]
 | 
			
		||||
    bi* <effect> ;
 | 
			
		||||
 | 
			
		||||
: function-quot ( return library function types -- quot )
 | 
			
		||||
    '[ _ _ _ _ alien-invoke ] ;
 | 
			
		||||
 | 
			
		||||
:: make-function ( return library function parameters -- word quot effect )
 | 
			
		||||
:: make-function ( return! library function! parameters -- word quot effect )
 | 
			
		||||
    return function normalize-c-arg function! return!
 | 
			
		||||
    function check-c-name create-in dup reset-generic
 | 
			
		||||
    return library function
 | 
			
		||||
    parameters return parse-arglist [ function-quot ] dip ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue