Add STRUCT: syntax to alien.endian. Test and document the changes.

basis/alien/endian/endian-docs.factor

@@ -1,8 +1,61 @@
 ! Copyright (C) 2011 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel math quotations ;
+USING: help.markup help.syntax kernel math quotations
+classes.struct ;
 IN: alien.endian
 
+HELP: BE-PACKED-STRUCT:
+{ $description "Defines a packed " { $link struct } " where endian-unaware types become big-endian types. Note that endian-aware types will override the big-endianness of this " { $link struct } " declaration; little-endian types will stay little-endian. On big-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
+{ $unchecked-example
+    "! When run on a big-endian platform, this struct should prettyprint the same as defined"
+    "! The output of this example is from a little-endian platform"
+    "USE: alien.endian"
+    "BE-PACKED-STRUCT: s1 { a char[7] } { b int } ;"
+    "\\ s1 see"
+    "USING: alien.c-types alien.endian classes.struct ;
+IN: scratchpad
+STRUCT: s1 { a char[7] } { b be32 initial: 0 } ;"
+} ;
+
+HELP: BE-STRUCT:
+{ $description "Defines a " { $link struct } " where endian-unaware types become big-endian types. Note that endian-aware types will override the big-endianness of this " { $link struct } " declaration; little-endian types will stay little-endian. On big-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
+{ $unchecked-example
+    "! When run on a big-endian platform, this struct should prettyprint the same as defined"
+    "! The output of this example is from a little-endian platform"
+    "USE: alien.endian"
+    "BE-STRUCT: s1 { a int } { b le32 } ;"
+    "\\ s1 see"
+    "USING: alien.c-types alien.endian classes.struct ;
+IN: scratchpad
+STRUCT: s1 { a be32 initial: 0 } { b le32 initial: 0 } ;"
+} ;
+
+HELP: LE-PACKED-STRUCT:
+{ $description "Defines a packed " { $link struct } " where endian-unaware types become little-endian types. Note that endian-aware types will override the little-endianness of this " { $link struct } " declaration; big-endian types will stay big-endian. On little-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
+{ $unchecked-example
+    "! When run on a little-endian platform, this struct should prettyprint the same as defined"
+    "! The output of this example is from a little-endian platform"
+    "USE: alien.endian"
+    "LE-PACKED-STRUCT: s1 { a char[7] } { b int } ;"
+    "\\ s1 see"
+    "USING: alien.c-types alien.endian classes.struct ;
+IN: scratchpad
+STRUCT: s1 { a char[7] } { b int initial: 0 } ;"
+} ;
+
+HELP: LE-STRUCT:
+{ $description "Defines a " { $link struct } " where endian-unaware types become little-endian types. Note that endian-aware types will override the little-endianness of this " { $link struct } " declaration; big-endian types will stay big-endian. On little-endian platforms, the endian-unaware types will not change since they are the correct endianness already." }
+{ $unchecked-example
+    "! When run on a little-endian platform, this struct should prettyprint the same as defined"
+    "! The output of this example is from a little-endian platform"
+    "USE: alien.endian"
+    "LE-STRUCT: s1 { a int } { b be32 } ;"
+    "\\ s1 see"
+    "USING: alien.c-types alien.endian classes.struct ;
+IN: scratchpad
+STRUCT: s1 { a int initial: 0 } { b be32 initial: 0 } ;"
+} ;
+
 HELP: be16
 { $var-description "Signed bit-endian 16-bit." } ;
 
@@ -85,6 +138,13 @@ ARTICLE: "alien.endian" "Alien endian-aware types"
     ule16
     ule32
     ule64
+}
+"Syntax for making endian-aware structs out of native types:"
+{ $subsections
+    POSTPONE: LE-STRUCT:
+    POSTPONE: BE-STRUCT:
+    POSTPONE: LE-PACKED-STRUCT:
+    POSTPONE: BE-PACKED-STRUCT:
 } ;
 
 ABOUT: "alien.endian"

basis/alien/endian/endian-tests.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2011 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.endian classes.struct io
-io.encodings.binary io.streams.byte-array kernel tools.test ;
+io.encodings.binary io.streams.byte-array kernel tools.test
+alien.c-types ;
 IN: alien.endian.tests
 
 STRUCT: endian-struct
@@ -94,3 +95,147 @@ CONSTANT: endian-bytes-f0 B{
 
 [ t ]
 [ endian-test-struct-f0 binary [ write ] with-byte-writer endian-bytes-f0 = ] unit-test
+
+LE-STRUCT: le-endian-struct
+    { a ule16 }
+    { b le16 }
+    { c ube16 }
+    { d be16 }
+    { e ule32 }
+    { f le32 }
+    { g ube32 }
+    { h be32 }
+    { i ule64 }
+    { j le64 }
+    { k ube64 }
+    { l be64 } ;
+
+[ t ]
+[
+    endian-bytes-0f le-endian-struct memory>struct
+    binary [ write ] with-byte-writer endian-bytes-0f =
+] unit-test
+
+[ t ]
+[
+    endian-bytes-f0 le-endian-struct memory>struct
+    binary [ write ] with-byte-writer endian-bytes-f0 =
+] unit-test
+
+
+BE-STRUCT: be-endian-struct
+    { a ule16 }
+    { b le16 }
+    { c ube16 }
+    { d be16 }
+    { e ule32 }
+    { f le32 }
+    { g ube32 }
+    { h be32 }
+    { i ule64 }
+    { j le64 }
+    { k ube64 }
+    { l be64 } ;
+
+[ t ]
+[
+    endian-bytes-0f be-endian-struct memory>struct
+    binary [ write ] with-byte-writer endian-bytes-0f =
+] unit-test
+
+[ t ]
+[
+    endian-bytes-f0 be-endian-struct memory>struct
+    binary [ write ] with-byte-writer endian-bytes-f0 =
+] unit-test
+
+LE-STRUCT: le-override-struct
+    { a ushort }
+    { b short }
+    { c ube16 }
+    { d be16 }
+    { e uint }
+    { f int }
+    { g ube32 }
+    { h be32 }
+    { i ulonglong }
+    { j longlong }
+    { k ube64 }
+    { l be64 } ;
+
+[ t ]
+[
+    endian-bytes-0f le-override-struct memory>struct
+    binary [ write ] with-byte-writer endian-bytes-0f =
+] unit-test
+
+[ t ]
+[
+    endian-bytes-f0 le-override-struct memory>struct
+    binary [ write ] with-byte-writer endian-bytes-f0 =
+] unit-test
+
+BE-STRUCT: be-override-struct
+    { a ule16 }
+    { b le16 }
+    { c ushort }
+    { d short }
+    { e ule32 }
+    { f le32 }
+    { g uint }
+    { h int }
+    { i ule64 }
+    { j le64 }
+    { k ulonglong }
+    { l longlong } ;
+
+[ t ]
+[
+    endian-bytes-0f be-override-struct memory>struct
+    binary [ write ] with-byte-writer endian-bytes-0f =
+] unit-test
+
+[ t ]
+[
+    endian-bytes-f0 be-override-struct memory>struct
+    binary [ write ] with-byte-writer endian-bytes-f0 =
+] unit-test
+
+
+LE-PACKED-STRUCT: le-packed-struct
+    { a char[7] }
+    { b int } ;
+
+[ t ]
+[
+    B{ 0 0 0 0 0 0 0  3 0 0 0 } [
+        le-packed-struct memory>struct
+        binary [ write ] with-byte-writer
+    ] keep =
+] unit-test
+
+[ 3 ]
+[
+    B{ 0 0 0 0 0 0 0  3 0 0 0 } le-packed-struct memory>struct
+    b>>
+] unit-test
+
+
+BE-PACKED-STRUCT: be-packed-struct
+    { a char[7] }
+    { b int } ;
+
+[ t ]
+[
+    B{ 0 0 0 0 0 0 0  0 0 0 3 } [
+        be-packed-struct memory>struct
+        binary [ write ] with-byte-writer
+    ] keep =
+] unit-test
+
+[ 3 ]
+[
+    B{ 0 0 0 0 0 0 0  0 0 0 3 } be-packed-struct memory>struct
+    b>>
+] unit-test
+

basis/alien/endian/endian.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2011 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.accessors alien.c-types combinators
+USING: accessors alien alien.accessors alien.c-types alien.data
-compiler.units endian fry generalizations kernel macros math
+classes.struct.private combinators compiler.units endian fry
-namespaces sequences words alien.data ;
+generalizations kernel macros math namespaces sequences words
+arrays slots ;
 QUALIFIED-WITH: alien.c-types ac
 IN: alien.endian
 
@@ -35,6 +36,12 @@ SYMBOLS: le8 be8 ule8 ube8
 ule16 ule32 ule64 ube16 ube32 ube64
 le16 le32 le64 be16 be32 be64 ;
 
+: endian-c-type? ( symbol -- ? )
+    {
+        le8 be8 ule8 ube8 ule16 ule32 ule64
+        ube16 ube32 ube64 le16 le32 le64 be16 be32 be64
+    } member? ;
+
 ERROR: unknown-endian-c-type symbol ;
 
 : endian-c-type>c-type-symbol ( symbol -- symbol' )
@@ -82,3 +89,62 @@ ERROR: unknown-endian-c-type symbol ;
     8 t \ le64 typedef-le
     8 t \ be64 typedef-be
 ] with-compilation-unit
+
+! pair: { le be }
+: pair>c-type ( pair -- c-type )
+    [ native-endianness get big-endian = ] dip first2 ? ;
+
+! endian is desired endian type. if we match endianness, return the c type
+! otherwise return the opposite of our endianness
+: endian-slot ( endian c-type pair -- endian-slot )
+    [ native-endianness get = ] 2dip rot [ drop ] [ nip pair>c-type ] if ;
+    
+ERROR: unsupported-endian-type endian slot ;
+
+: slot>endian-slot ( endian slot -- endian-slot )
+    dup array? [
+        first2 [ slot>endian-slot ] dip 2array
+    ] [
+        {
+            { [ dup char = ] [ 2drop char ] }
+            { [ dup uchar = ] [ 2drop uchar ] }
+            { [ dup ac:short = ] [ { le16 be16 } endian-slot ] }
+            { [ dup ushort = ] [ { ule16 ube16 } endian-slot ] }
+            { [ dup int = ] [ { le32 be32 } endian-slot ] }
+            { [ dup uint = ] [ { ule32 ube32 } endian-slot ] }
+            { [ dup longlong = ] [ { le64 be64 } endian-slot ] }
+            { [ dup ulonglong = ] [ { ule64 ube64 } endian-slot ] }
+            { [ dup endian-c-type? ] [ nip ] }
+            [ unsupported-endian-type ]
+        } cond
+    ] if ;
+
+: set-endian-slots ( endian slots -- slot-specs )
+    [ [ slot>endian-slot ] change-type ] with map ;
+
+: define-endian-struct-class ( class slots endian -- )
+    swap make-slots set-endian-slots
+    [ compute-struct-offsets ] [ struct-alignment ]
+    (define-struct-class) ;
+
+: define-endian-packed-struct-class ( class slots endian -- )
+    swap make-packed-slots set-endian-slots
+    [ compute-struct-offsets ] [ drop 1 ]
+    (define-struct-class) ;
+
+SYNTAX: LE-STRUCT:
+    parse-struct-definition
+    little-endian define-endian-struct-class ;
+
+SYNTAX: BE-STRUCT:
+    parse-struct-definition
+    big-endian define-endian-struct-class ;
+
+SYNTAX: LE-PACKED-STRUCT:
+    parse-struct-definition
+    little-endian define-endian-packed-struct-class ;
+
+SYNTAX: BE-PACKED-STRUCT:
+    parse-struct-definition
+    big-endian define-endian-packed-struct-class ;
+