steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rewrite integer>bit-array to use locals

db4
Joe Groff 2008-07-06 08:37:16 -07:00
parent 4191882a68
commit b5dc709c02
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
extra/bit-arrays/bit-arrays.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types accessors math alien.accessors kernel USING: alien.c-types accessors math alien.accessors kernel
kernel.private sequences sequences.private byte-arrays kernel.private locals sequences sequences.private byte-arrays
parser prettyprint.backend ; parser prettyprint.backend ;
IN: bit-arrays IN: bit-arrays
@ -72,14 +72,16 @@ M: bit-array byte-length length 7 + -3 shift ;
: ?{ ( parsed -- parsed ) : ?{ ( parsed -- parsed )
\ } [ >bit-array ] parse-literal ; parsing \ } [ >bit-array ] parse-literal ; parsing
: integer>bit-array ( int -- bit-array ) :: integer>bit-array ( n -- bit-array )
dup zero? [ drop 0 <bit-array> ] [ n zero? [ 0 <bit-array> ] [
[ log2 1+ <bit-array> 0 ] keep [let | out [ n log2 1+ <bit-array> ] i! [ 0 ] n'! [ n ] |
[ dup zero? not ] [ [ n' zero? not ] [
[ -8 shift ] [ 255 bitand ] bi n' out underlying>> i 255 bitand set-alien-unsigned-1
-roll [ [ set-alien-unsigned-1 ] 2keep 1+ ] dip n' -8 shift n'!
] [ ] while i 1+ i!
2drop ] [ ] while
out
]
] if ; ] if ;
: bit-array>integer ( bit-array -- int ) : bit-array>integer ( bit-array -- int )