bitwise equal? for struct objects

basis/classes/struct/struct-tests.factor

@@ -4,7 +4,7 @@ alien.structs.fields alien.syntax ascii classes.struct combinators
 destructors io.encodings.utf8 io.pathnames io.streams.string
 kernel libc literals math multiline namespaces prettyprint
 prettyprint.config see sequences specialized-arrays.ushort
-system tools.test ;
+system tools.test combinators.short-circuit ;
 IN: classes.struct.tests
 
 <<
@@ -138,6 +138,25 @@ UNION-STRUCT: struct-test-float-and-bits
     }
 } ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
 
+STRUCT: struct-test-equality-1
+    { x int } ;
+STRUCT: struct-test-equality-2
+    { y int } ;
+
+[ t ] [
+    [
+        struct-test-equality-1 <struct> 5 >>x
+        struct-test-equality-1 malloc-struct &free 5 >>x =
+    ] with-destructors
+] unit-test
+
+[ f ] [
+    [
+        struct-test-equality-1 <struct> 5 >>x
+        struct-test-equality-2 malloc-struct &free 5 >>y =
+    ] with-destructors
+] unit-test
+
 STRUCT: struct-test-ffi-foo
     { x int }
     { y int } ;

basis/classes/struct/struct.factor

@@ -2,10 +2,10 @@
 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 ;
+combinators combinators.short-circuit 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
 
@@ -28,6 +28,12 @@ PREDICATE: struct-class < tuple-class
 M: struct >c-ptr
     2 slot { c-ptr } declare ; inline
 
+M: struct equal?
+    {
+        [ [ class ] bi@ = ]
+        [ [ >c-ptr ] [ [ >c-ptr ] [ byte-length ] bi ] bi* memory= ]
+    } 2&& ;
+
 : memory>struct ( ptr class -- struct )
     over c-ptr? [ swap \ c-ptr bad-slot-value ] unless
     tuple-layout <tuple> [ 2 set-slot ] keep ;

basis/libc/libc.factor

@@ -83,6 +83,12 @@ PRIVATE>
 : memcpy ( dst src size -- )
     "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
 
+: memcmp ( a b size -- cmp )
+    "int" "libc" "memcmp" { "void*" "void*" "ulong" } alien-invoke ;
+
+: memory= ( a b size -- ? )
+    memcmp 0 = ;
+
 : strlen ( alien -- len )
     "size_t" "libc" "strlen" { "char*" } alien-invoke ;