-
Notifications
You must be signed in to change notification settings - Fork 205
/
vlists.factor
89 lines (60 loc) · 1.99 KB
/
vlists.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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
! Copyright (C) 2008 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
USING: accessors assocs grouping kernel math parser
persistent.assocs persistent.sequences sequences
sequences.private vectors vocabs.loader ;
IN: vlists
TUPLE: vlist
{ length array-capacity read-only }
{ vector vector read-only } ;
: <vlist> ( -- vlist ) 0 V{ } clone vlist boa ; inline
M: vlist length length>> ;
M: vlist nth-unsafe vector>> nth-unsafe ;
<PRIVATE
: >vlist< ( vlist -- len vec )
[ length>> ] [ vector>> ] bi ; inline
: unshare ( len vec -- len vec' )
clone [ set-length ] 2keep ; inline
PRIVATE>
M: vlist ppush
>vlist<
2dup length = [ unshare ] unless
[ [ 1 + swap ] dip push ] keep vlist boa ;
ERROR: empty-vlist-error ;
M: vlist ppop
[ empty-vlist-error ]
[ [ length>> 1 - ] [ vector>> ] bi vlist boa ] if-empty ;
M: vlist clone
[ length>> ] [ vector>> >vector ] bi vlist boa ;
M: vlist equal?
over vlist? [ sequence= ] [ 2drop f ] if ;
: >vlist ( seq -- vlist )
[ length ] [ >vector ] bi vlist boa ; inline
M: vlist like
drop dup vlist? [ >vlist ] unless ;
INSTANCE: vlist immutable-sequence
SYNTAX: VL{ \ } [ >vlist ] parse-literal ;
TUPLE: valist { vlist vlist read-only } ;
: <valist> ( -- valist ) <vlist> valist boa ; inline
M: valist assoc-size vlist>> length 2/ ;
: valist-at ( key i array -- value ? )
over 0 >= [
3dup nth-unsafe = [
[ 1 + ] dip nth-unsafe nip t
] [
[ 2 - ] dip valist-at
] if
] [ 3drop f f ] if ; inline recursive
M: valist at*
vlist>> >vlist< [ 2 - ] [ underlying>> ] bi* valist-at ;
M: valist new-at
vlist>> ppush ppush valist boa ;
M: valist >alist
vlist>> 2 <groups> [ { } like ] map ;
: >valist ( assoc -- valist )
>alist concat >vlist valist boa ; inline
M: valist assoc-like
drop dup valist? [ >valist ] unless ;
INSTANCE: valist assoc
SYNTAX: VA{ \ } [ >valist ] parse-literal ;
{ "vlists" "prettyprint" } "vlists.prettyprint" require-when