specialized-arrays, specialized-vectors: fix some code duplication and prettyprinting
Slava Pestov
parent
dfb07601fa
commit
5cdb67d571
|
|
@ -1,9 +1,10 @@
|
|||
IN: specialized-arrays.tests
|
||||
USING: tools.test alien.syntax specialized-arrays
|
||||
specialized-arrays sequences alien.c-types accessors
|
||||
kernel arrays combinators compiler classes.struct
|
||||
specialized-arrays.private sequences alien.c-types accessors
|
||||
kernel arrays combinators compiler compiler.units classes.struct
|
||||
combinators.smart compiler.tree.debugger math libc destructors
|
||||
sequences.private ;
|
||||
sequences.private multiline eval words vocabs namespaces
|
||||
assocs prettyprint ;
|
||||
|
||||
SPECIALIZED-ARRAY: int
|
||||
SPECIALIZED-ARRAY: bool
|
||||
|
|
@ -106,3 +107,43 @@ SPECIALIZED-ARRAY: fixed-string
|
|||
[ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [
|
||||
ALIEN: 123 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
|
||||
] unit-test
|
||||
|
||||
! Ensure that byte-length works with direct arrays
|
||||
[ 400 ] [
|
||||
ALIEN: 123 100 <direct-int-array> byte-length
|
||||
] unit-test
|
||||
|
||||
! Test prettyprinting
|
||||
[ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
|
||||
[ "int-array@ f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
|
||||
|
||||
! If the C type doesn't exist, don't generate a vocab
|
||||
[ ] [
|
||||
[ "__does_not_exist__" specialized-array-vocab forget-vocab ] with-compilation-unit
|
||||
"__does_not_exist__" c-types get delete-at
|
||||
] unit-test
|
||||
|
||||
[
|
||||
<"
|
||||
IN: specialized-arrays.tests
|
||||
USING: specialized-arrays ;
|
||||
|
||||
SPECIALIZED-ARRAY: __does_not_exist__ "> eval( -- )
|
||||
] must-fail
|
||||
|
||||
[ ] [
|
||||
<"
|
||||
IN: specialized-arrays.tests
|
||||
USING: classes.struct specialized-arrays ;
|
||||
|
||||
STRUCT: __does_not_exist__ { x int } ;
|
||||
|
||||
SPECIALIZED-ARRAY: __does_not_exist__
|
||||
"> eval( -- )
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"__does_not_exist__-array{"
|
||||
"__does_not_exist__" specialized-array-vocab lookup
|
||||
deferred?
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien alien.c-types assocs byte-arrays classes
|
||||
compiler.units functors io kernel lexer libc math
|
||||
math.vectors.specialization namespaces parser
|
||||
prettyprint.custom sequences sequences.private strings summary
|
||||
vocabs vocabs.loader vocabs.parser words ;
|
||||
compiler.units functors kernel lexer libc math
|
||||
math.vectors.specialization namespaces parser prettyprint.custom
|
||||
sequences sequences.private strings summary vocabs vocabs.loader
|
||||
vocabs.parser words fry combinators ;
|
||||
IN: specialized-arrays
|
||||
|
||||
MIXIN: specialized-array
|
||||
|
|
@ -86,8 +86,12 @@ M: A resize
|
|||
] [ drop ] 2bi
|
||||
<direct-A> ; inline
|
||||
|
||||
M: A byte-length underlying>> length ; inline
|
||||
M: A byte-length length T heap-size * ; inline
|
||||
|
||||
M: A direct-array-syntax drop \ A@ ;
|
||||
|
||||
M: A pprint-delims drop \ A{ \ } ;
|
||||
|
||||
M: A >pprint-sequence ;
|
||||
|
||||
SYNTAX: A{ \ } [ >A ] parse-literal ;
|
||||
|
|
@ -100,34 +104,30 @@ A T c-type-boxed-class f specialize-vector-words
|
|||
;FUNCTOR
|
||||
|
||||
: underlying-type ( c-type -- c-type' )
|
||||
dup c-types get at string? [
|
||||
c-types get at underlying-type
|
||||
] when ;
|
||||
dup c-types get at {
|
||||
{ [ dup not ] [ drop no-c-type ] }
|
||||
{ [ dup string? ] [ nip underlying-type ] }
|
||||
[ drop ]
|
||||
} cond ;
|
||||
|
||||
: specialized-array-vocab ( c-type -- vocab )
|
||||
"specialized-arrays.instances." prepend ;
|
||||
|
||||
: defining-array-message ( type -- )
|
||||
"quiet" get [ drop ] [
|
||||
"Generating specialized " " arrays..." surround print
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: define-array-vocab ( type -- vocab )
|
||||
underlying-type
|
||||
dup specialized-array-vocab vocab
|
||||
[ ] [
|
||||
[ defining-array-message ]
|
||||
: generate-vocab ( vocab-name quot -- vocab )
|
||||
[ dup vocab [ ] ] dip '[
|
||||
[
|
||||
[
|
||||
dup specialized-array-vocab
|
||||
[ define-array ] with-current-vocab
|
||||
_ with-current-vocab
|
||||
] with-compilation-unit
|
||||
]
|
||||
[ specialized-array-vocab ]
|
||||
tri
|
||||
] ?if ;
|
||||
] keep
|
||||
] ?if ; inline
|
||||
|
||||
: define-array-vocab ( type -- vocab )
|
||||
underlying-type
|
||||
[ specialized-array-vocab ] [ '[ _ define-array ] ] bi
|
||||
generate-vocab ;
|
||||
|
||||
M: string require-c-array define-array-vocab drop ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types assocs compiler.units functors
|
||||
growable io kernel lexer namespaces parser prettyprint.custom
|
||||
growable kernel lexer namespaces parser prettyprint.custom
|
||||
sequences specialized-arrays specialized-arrays.private strings
|
||||
vocabs vocabs.parser ;
|
||||
QUALIFIED: vectors.functor
|
||||
|
|
@ -44,27 +44,12 @@ INSTANCE: V S
|
|||
: specialized-vector-vocab ( type -- vocab )
|
||||
"specialized-vectors.instances." prepend ;
|
||||
|
||||
: defining-vector-message ( type -- )
|
||||
"quiet" get [ drop ] [
|
||||
"Generating specialized " " vectors..." surround print
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: define-vector-vocab ( type -- vocab )
|
||||
: define-vector-vocab ( type -- vocab )
|
||||
underlying-type
|
||||
dup specialized-vector-vocab vocab
|
||||
[ ] [
|
||||
[ defining-vector-message ]
|
||||
[
|
||||
[
|
||||
dup specialized-vector-vocab
|
||||
[ define-vector ] with-current-vocab
|
||||
] with-compilation-unit
|
||||
]
|
||||
[ specialized-vector-vocab ]
|
||||
tri
|
||||
] ?if ;
|
||||
[ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi
|
||||
generate-vocab ;
|
||||
|
||||
SYNTAX: SPECIALIZED-VECTOR:
|
||||
scan
|
||||
|
|
|
|||
Loading…
Reference in New Issue