Merge branch 'master' of git://factorcode.org/git/factor

diff --combined basis/struct-arrays/struct-arrays.factor
index 38dab33f0e1471ca716eba079acd95dcbbcad67f,3f8cba56e2913aaa673e371c46d8afb4c9790ef7..390a03455d75d63066bf4f30fc2a56a17993f7f8
--- 1/basis/struct-arrays/struct-arrays.factor
--- 2/basis/struct-arrays/struct-arrays.factor
+++ b/basis/struct-arrays/struct-arrays.factor
@@@ -1,8 -1,7 +1,8 @@@
  ! Copyright (C) 2008 Slava Pestov.
  ! See http://factorcode.org/license.txt for BSD license.
  USING: accessors alien alien.c-types alien.structs byte-arrays
 -classes.struct kernel libc math parser sequences sequences.private ;
 +classes.struct kernel libc math parser sequences
 +sequences.private words fry memoize compiler.units ;
  IN: struct-arrays
  
  : c-type-struct-class ( c-type -- class )
@@@ -12,8 -11,7 +12,8 @@@ TUPLE: struct-arra
  { underlying c-ptr read-only }
  { length array-capacity read-only }
  { element-size array-capacity read-only }
 -{ class read-only } ;
 +{ class read-only }
 +{ ctor read-only } ;
  
  M: struct-array length length>> ; inline
  M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
@@@ -22,62 -20,47 +22,62 @@@
      [ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline
  
  M: struct-array nth-unsafe
 -    [ (nth-ptr) ] [ class>> dup struct-class? ] bi [ memory>struct ] [ drop ] if ; inline
 +    [ (nth-ptr) ] [ ctor>> ] bi execute( alien -- object ) ; inline
  
  M: struct-array set-nth-unsafe
      [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline
  
 +: (struct-element-constructor) ( c-type -- word )
 +    [
 +        "struct-array-ctor" f <word>
 +        [
 +            swap dup struct-class?
 +            [ '[ _ memory>struct ] [ ] like ] [ drop [ ] ] if
 +            (( alien -- object )) define-inline
 +        ] keep
 +    ] with-compilation-unit ;
 +
 +! Foldable memo word. This is an optimization; by precompiling a
 +! constructor for array elements, we avoid memory>struct's slow path.
 +MEMO: struct-element-constructor ( c-type -- word )
 +    (struct-element-constructor) ; foldable
 +
 +: <direct-struct-array> ( alien length c-type -- struct-array )
 +    [ heap-size ] [ c-type-struct-class ] [ struct-element-constructor ]
 +    tri struct-array boa ; inline
 +
  M: struct-array new-sequence
 -    [ element-size>> [ * (byte-array) ] 2keep ]
 -    [ class>> ] bi struct-array boa ; inline
 +    [ element-size>> * (byte-array) ] [ length>> ] [ class>> ] tri
 +    <direct-struct-array> ; inline
  
  M: struct-array resize ( n seq -- newseq )
 -    [ [ element-size>> * ] [ underlying>> ] bi resize ]
 -    [ [ element-size>> ] [ class>> ] bi ] 2bi
 -    struct-array boa ;
 +    [ [ element-size>> * ] [ underlying>> ] bi resize ] [ class>> ] 2bi
 +    <direct-struct-array> ; inline
  
  : <struct-array> ( length c-type -- struct-array )
 -    [ heap-size [ * <byte-array> ] 2keep ]
 -    [ c-type-struct-class ] bi struct-array boa ; inline
 +    [ heap-size * <byte-array> ] 2keep <direct-struct-array> ; inline
  
  ERROR: bad-byte-array-length byte-array ;
  
  : byte-array>struct-array ( byte-array c-type -- struct-array )
 -    [ heap-size [
 +    [
 +        heap-size
          [ dup length ] dip /mod 0 =
          [ drop bad-byte-array-length ] unless
 -    ] keep ] [ c-type-struct-class ] bi struct-array boa ; inline
 -
 -: <direct-struct-array> ( alien length c-type -- struct-array )
 -    [ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
 +    ] keep <direct-struct-array> ; inline
  
  : malloc-struct-array ( length c-type -- struct-array )
      [ heap-size calloc ] 2keep <direct-struct-array> ; inline
  
  INSTANCE: struct-array sequence
  
- M: struct-type <c-type-array> ( len c-type -- array )
-     dup c-type-array-constructor
+ M: struct-type <c-array> ( len c-type -- array )
+     dup c-array-constructor
      [ execute( len -- array ) ]
      [ <struct-array> ] ?if ; inline
  
- M: struct-type <c-type-direct-array> ( alien len c-type -- array )
-     dup c-type-direct-array-constructor
+ M: struct-type <c-direct-array> ( alien len c-type -- array )
+     dup c-direct-array-constructor
      [ execute( alien len -- array ) ]
      [ <direct-struct-array> ] ?if ; inline
  
@@@ -88,6 -71,9 +88,9 @@@
  SYNTAX: struct-array{
      \ } scan-word [ >struct-array ] curry parse-literal ;
  
+ SYNTAX: struct-array@
+     scan-word [ scan-object scan-object ] dip <direct-struct-array> parsed ;
+ 
  USING: vocabs vocabs.loader ;
  
  "prettyprint" vocab [ "struct-arrays.prettyprint" require ] when