factor: trim using lists

[factor.git] / basis / alien / endian / endian.factor

diff --git a/basis/alien/endian/endian.factor b/basis/alien/endian/endian.factor
index b905e4b66b06fbcb503edb605286d49036b43f0b..a8b75c77ae5593a15caac9a437e898313222f1f9 100644 (file)
--- a/basis/alien/endian/endian.factor
+++ b/basis/alien/endian/endian.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2011 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.accessors alien.c-types alien.data
-classes.struct.private combinators compiler.units endian fry
-generalizations kernel macros math namespaces sequences words
-arrays slots ;
-QUALIFIED-WITH: alien.c-types ac
+USING: accessors alien.accessors alien.c-types alien.data arrays
+classes.struct.private combinators compiler.units endian
+generalizations kernel math math.bitwise namespaces sequences
+slots words ;
+QUALIFIED-WITH: alien.c-types c
 IN: alien.endian
 
 ERROR: invalid-signed-conversion n ;
@@ -12,27 +12,19 @@ ERROR: invalid-signed-conversion n ;
 : convert-signed-quot ( n -- quot )
     {
         { 1 [ [ char <ref> char deref ] ] }
-        { 2 [ [ ac:short <ref> ac:short deref ] ] }
+        { 2 [ [ c:short <ref> c:short deref ] ] }
         { 4 [ [ int <ref> int deref ] ] }
         { 8 [ [ longlong <ref> longlong deref ] ] }
         [ invalid-signed-conversion ]
     } case ; inline
 
-<PRIVATE
-
-: byte-mask ( #bits-shift -- mask )
-    [ HEX: ff ] dip shift ; foldable
-
-PRIVATE>
-
 MACRO: byte-reverse ( n signed? -- quot )
     [
         drop
         [
-            dup iota [
+            dup <iota> [
                 [ 1 + - -8 * ] [ nip 8 * ] 2bi
-                [ + ] [ nip byte-mask ] 2bi
-                '[ _ shift _ bitand ]
+                '[ _ shift 0xff bitand _ shift ]
             ] with map
         ] [ 1 - [ bitor ] n*quot ] bi
     ] [
@@ -55,7 +47,7 @@ ERROR: unknown-endian-c-type symbol ;
 : endian-c-type>c-type-symbol ( symbol -- symbol' )
     {
         { [ dup { ule16 ube16 } member? ] [ drop ushort ] }
-        { [ dup { le16 be16 } member? ] [ drop ac:short ] }
+        { [ dup { le16 be16 } member? ] [ drop c:short ] }
         { [ dup { ule32 ube32 } member? ] [ drop uint ] }
         { [ dup { le32 be32 } member? ] [ drop int ] }
         { [ dup { ule64 ube64 } member? ] [ drop ulonglong ] }
@@ -65,9 +57,22 @@ ERROR: unknown-endian-c-type symbol ;
 
 : change-c-type-accessors ( n ? c-type -- c-type' )
     endian-c-type>c-type-symbol "c-type" word-prop clone
-    -rot
-    [ '[ [ _ _ byte-reverse ] compose ] change-getter drop ]
-    [ '[ [ [ _ _ byte-reverse ] 2dip ] prepose ] change-setter ] 3bi ;
+    -rot over 8 = [
+        [
+            nip
+            [
+                [
+                    [ alien-unsigned-4 4 f byte-reverse 32 shift ]
+                    [ 4 + alien-unsigned-4 4 f byte-reverse ] 2bi bitor
+                ]
+            ] dip [ [ 64 >signed ] compose ] when
+            >>getter drop
+        ]
+        [ '[ [ [ _ _ byte-reverse ] 2dip ] prepose ] change-setter ] 3bi
+    ] [
+        [ '[ [ _ _ byte-reverse ] compose ] change-getter drop ]
+        [ '[ [ [ _ _ byte-reverse ] 2dip ] prepose ] change-setter ] 3bi
+    ] if ;
 
 : typedef-endian ( n ? c-type endian -- )
     native-endianness get = [
@@ -106,7 +111,7 @@ ERROR: unknown-endian-c-type symbol ;
 ! 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 )
@@ -114,15 +119,17 @@ ERROR: unsupported-endian-type endian slot ;
         first2 [ slot>endian-slot ] dip 2array
     ] [
         {
+            { [ dup bool = ] [ 2drop bool ] }
             { [ dup char = ] [ 2drop char ] }
             { [ dup uchar = ] [ 2drop uchar ] }
-            { [ dup ac:short = ] [ { le16 be16 } endian-slot ] }
+            { [ dup c: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 ] }
+            { [ dup pointer? ] [ nip ] }
             [ unsupported-endian-type ]
         } cond
     ] if ;
@@ -155,4 +162,3 @@ SYNTAX: LE-PACKED-STRUCT:
 SYNTAX: BE-PACKED-STRUCT:
     parse-struct-definition
     big-endian define-endian-packed-struct-class ;
-