new accessors

db4
Doug Coleman 2008-08-29 10:29:11 -05:00
parent f85493e980
commit c6b28c0b3f
2 changed files with 29 additions and 21 deletions

View File

@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
namespaces parser sequences strings words assocs splitting
math.parser cpu.architecture alien alien.accessors quotations
layouts system compiler.units io.files io.encodings.binary
accessors combinators effects continuations ;
accessors combinators effects continuations summary ;
IN: alien.c-types
DEFER: <int>
@ -62,17 +62,19 @@ M: string c-type ( name -- type )
] ?if
] if ;
ERROR: no-boxer ;
M: no-boxer summary drop "No boxer" ;
: c-type-box ( n type -- )
dup c-type-reg-class
swap c-type-boxer [ "No boxer" throw ] unless*
%box ;
[ reg-class>> ]
[ boxer>> [ no-boxer ] unless* ] bi %box ;
ERROR: no-unboxer ;
M: no-unboxer summary drop "No unboxer" ;
: c-type-unbox ( n ctype -- )
dup c-type-reg-class
swap c-type-unboxer [ "No unboxer" throw ] unless*
%unbox ;
[ reg-class>> ]
[ unboxer>> [ no-unboxer ] unless* ] bi %unbox ;
M: string c-type-align c-type c-type-align ;
M: string c-type-align c-type align>> ;
M: string c-type-stack-align? c-type c-type-stack-align? ;
@ -107,27 +109,33 @@ GENERIC: heap-size ( type -- size ) foldable
M: string heap-size c-type heap-size ;
M: c-type heap-size c-type-size ;
M: c-type heap-size size>> ;
GENERIC: stack-size ( type -- size ) foldable
M: string stack-size c-type stack-size ;
M: c-type stack-size c-type-size ;
M: c-type stack-size size>> ;
GENERIC: byte-length ( seq -- n ) flushable
M: byte-array byte-length length ;
ERROR: c-struct-reader ;
M: c-struct-reader summary
drop "Cannot read struct fields with type" ;
: c-getter ( name -- quot )
c-type c-type-getter [
[ "Cannot read struct fields with type" throw ]
] unless* ;
c-type c-type-getter [ c-struct-reader ] unless* ;
ERROR: c-struct-writer ;
M: c-struct-writer summary
drop "Cannot write struct fields with type" ;
: c-setter ( name -- quot )
c-type c-type-setter [
[ "Cannot write struct fields with type" throw ]
] unless* ;
c-type c-type-setter [ c-struct-writer ] unless* ;
: <c-array> ( n type -- array )
heap-size * <byte-array> ; inline
@ -178,13 +186,13 @@ TUPLE: long-long-type < c-type ;
long-long-type new-c-type ;
M: long-long-type unbox-parameter ( n type -- )
c-type-unboxer %unbox-long-long ;
unboxer>> %unbox-long-long ;
M: long-long-type unbox-return ( type -- )
f swap unbox-parameter ;
M: long-long-type box-parameter ( n type -- )
c-type-boxer %box-long-long ;
boxer>> %box-long-long ;
M: long-long-type box-return ( type -- )
f swap box-parameter ;

View File

@ -44,7 +44,7 @@ M: string-type heap-size
drop "void*" heap-size ;
M: string-type c-type-align
drop "void*" c-type-align ;
drop "void*" align>> ;
M: string-type c-type-stack-align?
drop "void*" c-type-stack-align? ;
@ -68,10 +68,10 @@ M: string-type c-type-reg-class
drop int-regs ;
M: string-type c-type-boxer
drop "void*" c-type-boxer ;
drop "void*" boxer>> ;
M: string-type c-type-unboxer
drop "void*" c-type-unboxer ;
drop "void*" unboxer>> ;
M: string-type c-type-boxer-quot
second [ alien>string ] curry [ ] like ;