forked from factor/factor
-
Notifications
You must be signed in to change notification settings - Fork 3
/
nibble-arrays.factor
73 lines (50 loc) · 1.83 KB
/
nibble-arrays.factor
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math kernel sequences sequences.private byte-arrays
alien prettyprint.custom parser accessors locals ;
IN: nibble-arrays
TUPLE: nibble-array
{ length array-capacity read-only }
{ underlying byte-array read-only } ;
<PRIVATE
CONSTANT: nibble BIN: 1111
: nibbles>bytes ( m -- n ) 1 + 2/ ; inline
: byte/nibble ( n -- shift n' )
[ 1 bitand 2 shift ] [ -1 shift ] bi ; inline
: get-nibble ( n byte -- nibble )
swap neg shift nibble bitand ; inline
:: set-nibble ( value n byte -- byte' )
byte nibble n shift bitnot bitand
value n shift
bitor ; inline
: nibble@ ( n nibble-array -- shift n' byte-array )
[ >fixnum byte/nibble ] [ underlying>> ] bi* ; inline
PRIVATE>
: <nibble-array> ( n -- nibble-array )
dup nibbles>bytes <byte-array> nibble-array boa ; inline
M: nibble-array length length>> ;
M: nibble-array nth-unsafe
nibble@ nth-unsafe get-nibble ;
M: nibble-array set-nth-unsafe
nibble@ [ nth-unsafe set-nibble ] 2keep set-nth-unsafe ;
M: nibble-array clone
[ length>> ] [ underlying>> clone ] bi nibble-array boa ;
: >nibble-array ( seq -- nibble-array )
T{ nibble-array } clone-like ; inline
M: nibble-array like
drop dup nibble-array? [ >nibble-array ] unless ;
M: nibble-array new-sequence drop <nibble-array> ;
M: nibble-array equal?
over nibble-array? [ sequence= ] [ 2drop f ] if ;
M: nibble-array resize
[ drop ] [
[ nibbles>bytes ] [ underlying>> ] bi*
resize-byte-array
] 2bi
nibble-array boa ;
M: nibble-array byte-length length nibbles>bytes ;
SYNTAX: N{ \ } [ >nibble-array ] parse-literal ;
INSTANCE: nibble-array sequence
M: nibble-array pprint-delims drop \ N{ \ } ;
M: nibble-array >pprint-sequence ;
M: nibble-array pprint* pprint-object ;