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

typedefs share their original type's pointer definition

db4
Joe Groff 2009-09-15 22:58:07 -05:00
parent 93b12d3ef4
commit 6dc6886bd9
2 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/alien/c-types/c-types-tests.factor
View File

@ -43,7 +43,7 @@ TYPEDEF: int* MyIntArray
TYPEDEF: uchar* MyLPBYTE TYPEDEF: uchar* MyLPBYTE
[ t ] [ { "char*" utf8 } c-type "MyLPBYTE" c-type = ] unit-test [ t ] [ { char* utf8 } c-type "MyLPBYTE" c-type = ] unit-test
[ [
0 B{ 1 2 3 4 } <displaced-alien> <void*> 0 B{ 1 2 3 4 } <displaced-alien> <void*>

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

@ -65,8 +65,8 @@ M: word resolve-pointer-type
dup "pointer-c-type" word-prop dup "pointer-c-type" word-prop
[ ] [ drop void* ] ?if ; [ ] [ drop void* ] ?if ;
M: string resolve-pointer-type M: string resolve-pointer-type
c-types get at dup string? c-types get at dup c-type-name?
[ "*" append ] [ drop void* ] if ; [ resolve-pointer-type ] [ drop void* ] if ;
: resolve-typedef ( name -- type ) : resolve-typedef ( name -- type )
dup c-type-name? [ c-type ] when ; dup c-type-name? [ c-type ] when ;
@ -313,9 +313,17 @@ PREDICATE: typedef-word < c-type-word
M: string typedef ( old new -- ) c-types get set-at ; M: string typedef ( old new -- ) c-types get set-at ;
M: word typedef ( old new -- ) M: word typedef ( old new -- )
{
[ nip define-symbol ] [ nip define-symbol ]
[ name>> typedef ] [ name>> typedef ]
[ swap "c-type" set-word-prop ] 2tri ; [ swap "c-type" set-word-prop ]
[
swap dup word? [
"pointer-c-type" word-prop
"pointer-c-type" set-word-prop
] [ 2drop ] if
]
} 2cleave ;
TUPLE: long-long-type < c-type ; TUPLE: long-long-type < c-type ;