diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index d631a91eae..3dba702cf2 100644
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -1,15 +1,17 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: parser kernel locals.private quotations classes.tuple
-classes.tuple.parser make lexer combinators generic words
-interpolate namespaces sequences io.streams.string fry
-classes.mixin ;
+USING: kernel locals.private quotations classes.tuple make
+combinators generic words interpolate namespaces sequences
+io.streams.string fry classes.mixin effects lexer parser
+classes.tuple.parser effects.parser ;
IN: functors
: scan-param ( -- obj )
scan-object dup special? [ literalize ] unless ;
-: define* ( word def -- ) over set-word define ;
+: define* ( word def effect -- ) pick set-word define-declared ;
+
+: DEFINE* ( -- ) effect get parsed \ define* parsed ;
: `TUPLE:
scan-param parsed
@@ -25,21 +27,25 @@ IN: functors
\ define-tuple-class parsed ; parsing
: `M:
+ effect off
scan-param parsed
scan-param parsed
\ create-method parsed
parse-definition parsed
- \ define* parsed ; parsing
+ DEFINE* ; parsing
: `C:
+ effect off
scan-param parsed
scan-param parsed
- [ [ boa ] curry define* ] over push-all ; parsing
+ [ [ boa ] curry ] over push-all
+ DEFINE* ; parsing
: `:
+ effect off
scan-param parsed
parse-definition parsed
- \ define* parsed ; parsing
+ DEFINE* ; parsing
: `INSTANCE:
scan-param parsed
@@ -50,6 +56,9 @@ IN: functors
: `parsing \ parsing parsed ; parsing
+: `(
+ ")" parse-effect effect set ; parsing
+
: (INTERPOLATE) ( accum quot -- accum )
[ scan interpolate-locals ] dip
'[ _ with-string-writer @ ] parsed ;
@@ -69,6 +78,7 @@ DEFER: ;FUNCTOR delimiter
{ "INSTANCE:" POSTPONE: `INSTANCE: }
{ "inline" POSTPONE: `inline }
{ "parsing" POSTPONE: `parsing }
+ { "(" POSTPONE: `( }
} ;
: push-functor-words ( -- )
diff --git a/basis/specialized-arrays/direct/functor/functor.factor b/basis/specialized-arrays/direct/functor/functor.factor
index dd5164b8b4..2cde26b731 100644
--- a/basis/specialized-arrays/direct/functor/functor.factor
+++ b/basis/specialized-arrays/direct/functor/functor.factor
@@ -23,7 +23,7 @@ TUPLE: A
{ underlying alien read-only }
{ length fixnum read-only } ;
-: A boa ; inline
+: ( alien len -- direct-array ) A boa ; inline
M: A length length>> ;
M: A nth-unsafe underlying>> NTH call ;
M: A set-nth-unsafe underlying>> SET-NTH call ;
diff --git a/basis/specialized-arrays/functor/functor.factor b/basis/specialized-arrays/functor/functor.factor
index 8536e6f81a..52977dc22a 100644
--- a/basis/specialized-arrays/functor/functor.factor
+++ b/basis/specialized-arrays/functor/functor.factor
@@ -1,19 +1,25 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: functors sequences sequences.private
-prettyprint.backend kernel words classes math parser
-alien.c-types byte-arrays accessors ;
+USING: functors sequences sequences.private prettyprint.backend
+kernel words classes math parser alien.c-types byte-arrays
+accessors summary ;
IN: specialized-arrays.functor
+ERROR: bad-byte-array-length byte-array type ;
+
+M: bad-byte-array-length summary
+ drop "Byte array length doesn't divide type width" ;
+
FUNCTOR: define-array ( T -- )
-A DEFINES ${T}-array
- DEFINES <${A}>
->A DEFINES >${A}
-A{ DEFINES ${A}{
+A DEFINES ${T}-array
+ DEFINES <${A}>
+>A DEFINES >${A}
+byte-array>A DEFINES byte-array>${A}
+A{ DEFINES ${A}{
-NTH [ T dup c-getter array-accessor ]
-SET-NTH [ T dup c-setter array-accessor ]
+NTH [ T dup c-getter array-accessor ]
+SET-NTH [ T dup c-setter array-accessor ]
WHERE
@@ -21,7 +27,11 @@ TUPLE: A
{ length array-capacity read-only }
{ underlying byte-array read-only } ;
-: dup T A boa ; inline
+: ( n -- specialized-array ) dup T A boa ; inline
+
+: byte-array>A ( byte-array -- specialized-array )
+ dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
+ swap A boa ; inline
M: A clone [ length>> ] [ underlying>> clone ] bi A boa ;
@@ -31,7 +41,7 @@ M: A nth-unsafe underlying>> NTH call ;
M: A set-nth-unsafe underlying>> SET-NTH call ;
-: >A A new clone-like ; inline
+: >A ( seq -- specialized-array ) A new clone-like ; inline
M: A like drop dup A instance? [ >A execute ] unless ;
diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor
index 5810085d47..1ca041191e 100644
--- a/basis/specialized-arrays/specialized-arrays-tests.factor
+++ b/basis/specialized-arrays/specialized-arrays-tests.factor
@@ -1,6 +1,7 @@
IN: specialized-arrays.tests
USING: tools.test specialized-arrays sequences
-specialized-arrays.int speicalized-arrays.bool ;
+specialized-arrays.int specialized-arrays.bool
+specialized-arrays.ushort alien.c-types accessors kernel ;
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
@@ -9,3 +10,9 @@ specialized-arrays.int speicalized-arrays.bool ;
[ 2 ] [ int-array{ 1 2 3 } second ] unit-test
[ t ] [ { t f t } >bool-array underlying>> { 1 0 1 } >int-array underlying>> = ] unit-test
+
+[ ushort-array{ 1234 } ] [
+ little-endian? B{ 210 4 } B{ 4 210 } ? byte-array>ushort-array
+] unit-test
+
+[ B{ 210 4 1 } byte-array>ushort-array ] must-fail