]> gitweb.factorcode.org Git - factor.git/commitdiff
str -> bytes, utility word in endian
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 13 Feb 2009 21:47:48 +0000 (15:47 -0600)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 13 Feb 2009 21:47:48 +0000 (15:47 -0600)
basis/endian/endian.factor

index a832d6c0a29d951699b45068c37d47c664ba1444..a453a7170423469fa914a9663b43b6c95316d856 100755 (executable)
@@ -1,39 +1,39 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types namespaces io.binary fry
-kernel math ;
+kernel math grouping sequences ;
 IN: endian
 
 SINGLETONS: big-endian little-endian ;
 
-: native-endianness ( -- class )
+: compute-native-endianness ( -- class )
     1 <int> *char 0 = big-endian little-endian ? ;
 
 : >signed ( x n -- y )
     2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ;
 
-native-endianness \ native-endianness set-global
+SYMBOL: native-endianness
+native-endianness [ compute-native-endianness ] initialize
 
 SYMBOL: endianness
+endianness [ native-endianness get-global ] initialize
 
-\ native-endianness get-global endianness set-global
-
-HOOK: >native-endian native-endianness ( obj n -- str )
+HOOK: >native-endian native-endianness ( obj n -- bytes )
 
 M: big-endian >native-endian >be ;
 
 M: little-endian >native-endian >le ;
 
-HOOK: unsigned-native-endian> native-endianness ( obj -- str )
+HOOK: unsigned-native-endian> native-endianness ( obj -- bytes )
 
 M: big-endian unsigned-native-endian> be> ;
 
 M: little-endian unsigned-native-endian> le> ;
 
-: signed-native-endian> ( obj n -- str )
+: signed-native-endian> ( obj n -- n' )
     [ unsigned-native-endian> ] dip >signed ;
 
-HOOK: >endian endianness ( obj n -- str )
+HOOK: >endian endianness ( obj n -- bytes )
 
 M: big-endian >endian >be ;
 
@@ -45,13 +45,13 @@ M: big-endian endian> be> ;
 
 M: little-endian endian> le> ;
 
-HOOK: unsigned-endian> endianness ( obj -- str )
+HOOK: unsigned-endian> endianness ( obj -- bytes )
 
 M: big-endian unsigned-endian> be> ;
 
 M: little-endian unsigned-endian> le> ;
 
-: signed-endian> ( obj n -- str )
+: signed-endian> ( obj n -- bytes )
     [ unsigned-endian> ] dip >signed ;
 
 : with-endianness ( endian quot -- )
@@ -65,3 +65,15 @@ M: little-endian unsigned-endian> le> ;
 
 : with-native-endian ( quot -- )
     \ native-endianness get-global swap with-endianness ; inline
+
+: seq>native-endianness ( seq n -- seq' )
+    native-endianness get-global dup endianness get = [
+        2drop
+    ] [
+        [ [ <sliced-groups> ] keep ] dip
+        little-endian = [
+            '[ be> _ >le ] map
+        ] [
+            '[ le> _ >be ] map
+        ] if concat
+    ] if ; inline