byte-length method for classes.struct STRUCTs

diff --git a/extra/classes/struct/struct-tests.factor b/extra/classes/struct/struct-tests.factor
index 5da1714803fdfe2bc4c6730f1e04755c58ee112a..272b8eb1290c4e3ebcabf833ca17375c6e640914 100644 (file)
--- a/extra/classes/struct/struct-tests.factor
+++ b/extra/classes/struct/struct-tests.factor
@@ -30,6 +30,7 @@ STRUCT: struct-test-bar
     { foo struct-test-foo } ;
 
 [ 12 ] [ struct-test-foo heap-size ] unit-test
+[ 12 ] [ struct-test-foo <struct> byte-length ] unit-test
 [ 16 ] [ struct-test-bar heap-size ] unit-test
 [ 123 ] [ struct-test-foo <struct> y>> ] unit-test
 [ 123 ] [ struct-test-bar <struct> foo>> y>> ] unit-test

diff --git a/extra/classes/struct/struct.factor b/extra/classes/struct/struct.factor
index 51df296f1a24ac7d039e8ae4fc568609bbe89ca6..7d4eed80af244219374f64984ef0eaada1594d9f 100644 (file)
--- a/extra/classes/struct/struct.factor
+++ b/extra/classes/struct/struct.factor
@@ -94,6 +94,10 @@ M: struct-class writer-quot
     [ \ struct-slot-values create-method-in ]
     [ struct-slot-values-quot ] bi define ;
 
+: (define-byte-length-method) ( class -- )
+    [ \ byte-length create-method-in ]
+    [ heap-size \ drop swap [ ] 2sequence ] bi define ;
+
 ! Struct as c-type
 
 : slot>field ( slot -- field )
@@ -172,6 +176,10 @@ M: struct-class heap-size
         over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
     ] each ;
 
+: (struct-methods) ( class -- )
+    [ (define-struct-slot-values-method) ]
+    [ (define-byte-length-method) ] bi ;
+
 : (struct-word-props) ( class slots size align -- )
     [
         [ "struct-slots" set-word-prop ]
@@ -181,7 +189,7 @@ M: struct-class heap-size
     [ "struct-align" set-word-prop ] tri-curry*
     [ tri ] 3curry
     [ dup struct-prototype "prototype" set-word-prop ]
-    [ (define-struct-slot-values-method) ] tri ;
+    [ (struct-methods) ] tri ;
 
 : check-struct-slots ( slots -- )
     [ c-type>> c-type drop ] each ;