]> gitweb.factorcode.org Git - factor.git/commitdiff
box elements of struct-arrays when a struct class is used as the element type
authorJoe Groff <arcata@gmail.com>
Wed, 26 Aug 2009 22:19:30 +0000 (17:19 -0500)
committerJoe Groff <arcata@gmail.com>
Wed, 26 Aug 2009 22:19:30 +0000 (17:19 -0500)
basis/alien/structs/structs.factor
basis/classes/struct/struct.factor
basis/struct-arrays/struct-arrays.factor

index d8b2edf39407645335d1efd5f8d66fd374661336..3d9cae1202270ea9bdc997c4bcf4e7fdfa00d077 100755 (executable)
@@ -3,7 +3,7 @@
 USING: accessors arrays assocs generic hashtables kernel kernel.private
 math namespaces parser sequences strings words libc fry
 alien.c-types alien.structs.fields cpu.architecture math.order
-quotations byte-arrays struct-arrays ;
+quotations byte-arrays ;
 IN: alien.structs
 
 TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
@@ -12,16 +12,6 @@ M: struct-type c-type ;
 
 M: struct-type c-type-stack-align? drop f ;
 
-M: struct-type <c-type-array> ( len c-type -- array )
-    dup c-type-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
-    [ execute( alien len -- array ) ]
-    [ <direct-struct-array> ] ?if ; inline
-
 : if-value-struct ( ctype true false -- )
     [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
 
index e9de2f7e3680c3fd1591bade527c5a0b645383e0..81252656a4a1835019dd94f375572473e665e557 100644 (file)
@@ -1,10 +1,10 @@
 ! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.structs alien.structs.fields arrays
-byte-arrays classes classes.parser classes.tuple
-classes.tuple.parser classes.tuple.private combinators
-combinators.smart fry generalizations generic.parser kernel
-kernel.private lexer libc macros make math math.order parser
-quotations sequences slots slots.private struct-arrays
+USING: accessors alien alien.c-types alien.structs
+alien.structs.fields arrays byte-arrays classes classes.parser
+classes.tuple classes.tuple.parser classes.tuple.private
+combinators combinators.smart fry generalizations generic.parser
+kernel kernel.private lexer libc macros make math math.order
+parser quotations sequences slots slots.private struct-arrays
 vectors words ;
 FROM: slots => reader-word writer-word ;
 IN: classes.struct
@@ -236,9 +236,9 @@ SYNTAX: STRUCT:
 SYNTAX: UNION-STRUCT:
     parse-struct-definition define-union-struct-class ;
 
+SYNTAX: S{
+    scan-word dup struct-slots parse-tuple-literal-slots parsed ;
+
 USING: vocabs vocabs.loader ;
 
 "prettyprint" vocab [ "classes.struct.prettyprint" require ] when
-
-SYNTAX: S{
-    scan-word dup struct-slots parse-tuple-literal-slots parsed ;
index c0ac29f99b0ccb2b2a986348658a4469d026bd0d..4243f314d71cb7e31ea174013488c85cb32092b4 100755 (executable)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types byte-arrays kernel libc
-math sequences sequences.private ;
+USING: accessors alien alien.c-types alien.structs byte-arrays
+classes.struct kernel libc math sequences sequences.private ;
 IN: struct-arrays
 
 : c-type-struct-class ( c-type -- class )
@@ -16,11 +16,14 @@ TUPLE: struct-array
 M: struct-array length length>> ;
 M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ;
 
+: (nth-ptr) ( i struct-array -- alien )
+    [ element-size>> * ] [ underlying>> ] bi <displaced-alien> ; inline
+
 M: struct-array nth-unsafe
-    [ element-size>> * ] [ underlying>> ] bi <displaced-alien> ;
+    [ (nth-ptr) ] [ class>> ] bi [ memory>struct ] when* ; inline
 
 M: struct-array set-nth-unsafe
-    [ nth-unsafe swap ] [ element-size>> ] bi memcpy ;
+    [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ;
 
 M: struct-array new-sequence
     [ element-size>> [ * <byte-array> ] 2keep ]
@@ -50,3 +53,14 @@ ERROR: bad-byte-array-length byte-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
+    [ 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
+    [ execute( alien len -- array ) ]
+    [ <direct-struct-array> ] ?if ; inline
+