]> gitweb.factorcode.org Git - factor.git/blob - basis/vlists/vlists.factor
Use factor.com to get stdout
[factor.git] / basis / vlists / vlists.factor
1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors assocs grouping kernel math parser
4 persistent.assocs persistent.sequences sequences
5 sequences.private vectors vocabs.loader ;
6 IN: vlists
7
8 TUPLE: vlist
9 { length array-capacity read-only }
10 { vector vector read-only } ;
11
12 : <vlist> ( -- vlist ) 0 V{ } clone vlist boa ; inline
13
14 M: vlist length length>> ;
15
16 M: vlist nth-unsafe vector>> nth-unsafe ;
17
18 <PRIVATE
19
20 : >vlist< ( vlist -- len vec )
21     [ length>> ] [ vector>> ] bi ; inline
22
23 : unshare ( len vec -- len vec' )
24     clone [ set-length ] 2keep ; inline
25
26 PRIVATE>
27
28 M: vlist ppush
29     >vlist<
30     2dup length = [ unshare ] unless
31     [ [ 1 + swap ] dip push ] keep vlist boa ;
32
33 ERROR: empty-vlist-error ;
34
35 M: vlist ppop
36     [ empty-vlist-error ]
37     [ [ length>> 1 - ] [ vector>> ] bi vlist boa ] if-empty ;
38
39 M: vlist clone
40     [ length>> ] [ vector>> >vector ] bi vlist boa ;
41
42 M: vlist equal?
43     over vlist? [ sequence= ] [ 2drop f ] if ;
44
45 : >vlist ( seq -- vlist )
46     [ length ] [ >vector ] bi vlist boa ; inline
47
48 M: vlist like
49     drop dup vlist? [ >vlist ] unless ;
50
51 INSTANCE: vlist immutable-sequence
52
53 SYNTAX: VL{ \ } [ >vlist ] parse-literal ;
54
55 TUPLE: valist { vlist vlist read-only } ;
56
57 : <valist> ( -- valist ) <vlist> valist boa ; inline
58
59 M: valist assoc-size vlist>> length 2/ ;
60
61 : valist-at ( key i array -- value ? )
62     over 0 >= [
63         3dup nth-unsafe = [
64             [ 1 + ] dip nth-unsafe nip t
65         ] [
66             [ 2 - ] dip valist-at
67         ] if
68     ] [ 3drop f f ] if ; inline recursive
69
70 M: valist at*
71     vlist>> >vlist< [ 2 - ] [ underlying>> ] bi* valist-at ;
72
73 M: valist new-at
74     vlist>> ppush ppush valist boa ;
75
76 M: valist >alist
77     vlist>> 2 <groups> [ { } like ] map ;
78
79 : >valist ( assoc -- valist )
80     >alist concat >vlist valist boa ; inline
81
82 M: valist assoc-like
83     drop dup valist? [ >valist ] unless ;
84
85 INSTANCE: valist assoc
86
87 SYNTAX: VA{ \ } [ >valist ] parse-literal ;
88
89 { "vlists" "prettyprint" } "vlists.prettyprint" require-when