steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix some bugs

db4
Slava Pestov 2008-12-02 00:24:00 -06:00
parent 3b25d04b8a
commit 192a164ef4
4 changed files with 13 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/alien/c-types/c-types.factor
View File

@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math
namespaces make parser sequences strings words assocs splitting namespaces make parser sequences strings words assocs splitting
math.parser cpu.architecture alien alien.accessors quotations math.parser cpu.architecture alien alien.accessors quotations
layouts system compiler.units io.files io.encodings.binary layouts system compiler.units io.files io.encodings.binary
accessors combinators effects continuations ; accessors combinators effects continuations fry ;
IN: alien.c-types IN: alien.c-types
DEFER: <int> DEFER: <int>
@ -240,8 +240,8 @@ M: long-long-type box-return ( type -- )
: define-out ( name -- ) : define-out ( name -- )
[ "alien.c-types" constructor-word ] [ "alien.c-types" constructor-word ]
[ [ [ <c-object> ] curry ] [ c-setter ] bi append ] bi [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ]
define-inline ; bi define-inline ;
: c-bool> ( int -- ? ) : c-bool> ( int -- ? )
zero? not ; zero? not ;

6
basis/alien/strings/strings.factor
View File

@ -3,7 +3,7 @@
USING: arrays sequences kernel accessors math alien.accessors USING: arrays sequences kernel accessors math alien.accessors
alien.c-types byte-arrays words io io.encodings alien.c-types byte-arrays words io io.encodings
io.streams.byte-array io.streams.memory io.encodings.utf8 io.streams.byte-array io.streams.memory io.encodings.utf8
io.encodings.utf16 system alien strings cpu.architecture ; io.encodings.utf16 system alien strings cpu.architecture fry ;
IN: alien.strings IN: alien.strings
GENERIC# alien>string 1 ( c-ptr encoding -- string/f ) GENERIC# alien>string 1 ( c-ptr encoding -- string/f )
@ -77,10 +77,10 @@ M: string-type c-type-unboxer
drop "void*" c-type-unboxer ; drop "void*" c-type-unboxer ;
M: string-type c-type-boxer-quot M: string-type c-type-boxer-quot
second [ alien>string ] curry [ ] like ; second '[ _ alien>string ] ;
M: string-type c-type-unboxer-quot M: string-type c-type-unboxer-quot
second [ string>alien ] curry [ ] like ; second '[ _ string>alien ] ;
M: string-type c-type-getter M: string-type c-type-getter
drop [ alien-cell ] ; drop [ alien-cell ] ;

9
basis/alien/structs/structs.factor
View File

@ -43,20 +43,21 @@ M: struct-type stack-size
struct-type boa struct-type boa
swap typedef ; swap typedef ;
: define-struct-early ( name vocab fields -- fields ) : make-fields ( name vocab fields -- fields )
[ first2 <field-spec> ] with with map ; [ first2 <field-spec> ] with with map ;
: compute-struct-align ( types -- n ) : compute-struct-align ( types -- n )
[ c-type-align ] map supremum ; [ c-type-align ] map supremum ;
: define-struct ( name vocab fields -- ) : define-struct ( name vocab fields -- )
pick [ [
[ 2drop ] [ make-fields ] 3bi
[ struct-offsets ] keep [ struct-offsets ] keep
[ [ type>> ] map compute-struct-align ] keep [ [ type>> ] map compute-struct-align ] keep
[ (define-struct) ] keep [ (define-struct) ] keep
] dip [ swap define-field ] curry each ; ] [ 2drop '[ _ swap define-field ] ] 3bi each ;
: define-union ( name vocab members -- ) : define-union ( name members -- )
[ expand-constants ] map [ expand-constants ] map
[ [ heap-size ] map supremum ] keep [ [ heap-size ] map supremum ] keep
compute-struct-align f (define-struct) ; compute-struct-align f (define-struct) ;

7
basis/alien/syntax/syntax.factor
View File

@ -24,13 +24,10 @@ IN: alien.syntax
scan scan typedef ; parsing scan scan typedef ; parsing
: C-STRUCT: : C-STRUCT:
scan in get scan in get parse-definition define-struct ; parsing
parse-definition
[ 2dup ] dip define-struct-early
define-struct ; parsing
: C-UNION: : C-UNION:
scan in get parse-definition define-union ; parsing scan parse-definition define-union ; parsing
: C-ENUM: : C-ENUM:
";" parse-tokens ";" parse-tokens