use reject instead of [ ... not ] filter.

[factor.git] / basis / classes / struct / struct.factor

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 49b338f404ce14c703db3d93e9b092b7726d93e0..5ea31bc7d33c119495fc27cdbe687c9974b821b6 100644 (file)
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -2,14 +2,14 @@
 ! John Benediktsson, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license
 USING: accessors alien alien.c-types alien.data alien.parser
-arrays byte-arrays classes classes.parser
+arrays byte-arrays classes classes.parser classes.private
 classes.struct.bit-accessors classes.tuple classes.tuple.parser
-combinators combinators.smart cpu.architecture fry
-functors.backend generalizations generic.parser kernel
+combinators combinators.smart cpu.architecture definitions fry
+functors.backend generalizations generic generic.parser io kernel
 kernel.private lexer libc locals macros math math.order parser
 quotations sequences slots slots.private specialized-arrays
-stack-checker.dependencies summary vectors vocabs.parser words
-classes.private generic definitions ;
+stack-checker.dependencies summary vectors vocabs.loader
+vocabs.parser words ;
 FROM: delegate.private => group-words slot-group-words ;
 QUALIFIED: math
 IN: classes.struct
@@ -52,7 +52,7 @@ M: struct >c-ptr
 
 M: struct equal?
     over struct? [
-        2dup [ class ] bi@ = [
+        2dup [ class-of ] same? [
             2dup [ >c-ptr ] both?
             [ [ >c-ptr ] [ binary-object ] bi* memory= ]
             [ [ >c-ptr not ] both? ]
@@ -71,6 +71,9 @@ M: struct hashcode*
     ! optimized down to efficient code if it is.
     '[ _ boa ] call( ptr -- struct ) ; inline
 
+: read-struct ( class -- struct )
+    [ heap-size read ] [ memory>struct ] bi ;
+
 <PRIVATE
 : (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien )
     '[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline
@@ -136,11 +139,11 @@ M: struct-bit-slot-spec (writer-quot)
     drop [ >c-ptr ] ;
 
 MACRO: read-struct-slot ( slot -- )
-    dup type>> depends-on-c-type
+    dup type>> add-depends-on-c-type
     (reader-quot) ;
 
 MACRO: write-struct-slot ( slot -- )
-    dup type>> depends-on-c-type
+    dup type>> add-depends-on-c-type
     (writer-quot) ;
 PRIVATE>
 
@@ -149,7 +152,7 @@ M: struct-class boa>object
     [ <struct> ] [ struct-slots ] bi
     [ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
 
-M: struct-class initial-value* <struct> ; inline
+M: struct-class initial-value* <struct> t ; inline
 
 ! Struct slot accessors
 
@@ -173,7 +176,7 @@ TUPLE: struct-c-type < abstract-c-type
 
 INSTANCE: struct-c-type value-type
 
-M: struct-c-type c-type ;
+M: struct-c-type lookup-c-type ;
 
 M: struct-c-type base-type ;
 
@@ -242,12 +245,14 @@ M: struct-bit-slot-spec compute-slot-offset
     1 [ 0 >>offset type>> heap-size max ] reduce ;
 
 : struct-alignment ( slots -- align )
-    [ struct-bit-slot-spec? not ] filter
+    [ struct-bit-slot-spec? ] reject
     1 [ dup offset>> c-type-align-at max ] reduce ;
 
 PRIVATE>
 
-M: struct byte-length class "struct-size" word-prop ; foldable
+: struct-size ( class -- n ) "struct-size" word-prop ; inline
+
+M: struct byte-length class-of struct-size ; inline foldable
 M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inline
 
 ! class definition
@@ -274,7 +279,7 @@ M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inlin
     bi ;
 
 : check-struct-slots ( slots -- )
-    [ type>> c-type drop ] each ;
+    [ type>> lookup-c-type drop ] each ;
 
 : redefine-struct-tuple-class ( class -- )
     [ struct f define-tuple-class ] [ make-final ] bi ;
@@ -318,12 +323,12 @@ PRIVATE>
 ERROR: invalid-struct-slot token ;
 
 : struct-slot-class ( c-type -- class' )
-    c-type c-type-boxed-class
+    lookup-c-type c-type-boxed-class
     dup \ byte-array = [ drop \ c-ptr ] when ;
 
 M: struct-class reset-class
     {
-        [ dup "c-type" word-prop fields>> forget-struct-slot-accessors ]
+        [ dup "c-type" word-prop fields>> forget-slot-accessors ]
         [
             [ forget-struct-slot-values-method ]
             [ forget-clone-method ] bi
@@ -336,16 +341,10 @@ SYMBOL: bits:
 
 <PRIVATE
 
-ERROR: bad-type-for-bits type ;
-
 :: set-bits ( slot-spec n -- slot-spec )
     struct-bit-slot-spec new
         n >>bits
-        slot-spec type>> {
-            { int [ t ] }
-            { uint [ f ] }
-            [ bad-type-for-bits ]
-        } case >>signed?
+        slot-spec type>> c-type-signed >>signed?
         slot-spec name>> >>name
         slot-spec class>> >>class
         slot-spec type>> >>type
@@ -367,7 +366,7 @@ PRIVATE>
 : <struct-slot-spec> ( name c-type attributes -- slot-spec )
     [ struct-slot-spec new ] 3dip
     [ >>name ]
-    [ [ >>type ] [ struct-slot-class >>class ] bi ]
+    [ [ >>type ] [ struct-slot-class init-slot-class ] bi ]
     [ [ dup empty? ] [ peel-off-struct-attributes ] until drop ] tri* ;
 
 <PRIVATE
@@ -426,6 +425,4 @@ FUNCTOR-SYNTAX: STRUCT:
     [ parse-struct-slots` ] [ ] while
     [ >array define-struct-class ] append! ;
 
-USING: vocabs vocabs.loader ;
-
 { "classes.struct" "prettyprint" } "classes.struct.prettyprint" require-when