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 ;
9 { length array-capacity read-only }
10 { vector vector read-only } ;
12 : <vlist> ( -- vlist ) 0 V{ } clone vlist boa ; inline
14 M: vlist length length>> ;
16 M: vlist nth-unsafe vector>> nth-unsafe ;
20 : >vlist< ( vlist -- len vec )
21 [ length>> ] [ vector>> ] bi ; inline
23 : unshare ( len vec -- len vec' )
24 clone [ set-length ] 2keep ; inline
30 2dup length = [ unshare ] unless
31 [ [ 1 + swap ] dip push ] keep vlist boa ;
33 ERROR: empty-vlist-error ;
37 [ [ length>> 1 - ] [ vector>> ] bi vlist boa ] if-empty ;
40 [ length>> ] [ vector>> >vector ] bi vlist boa ;
43 over vlist? [ sequence= ] [ 2drop f ] if ;
45 : >vlist ( seq -- vlist )
46 [ length ] [ >vector ] bi vlist boa ; inline
49 drop dup vlist? [ >vlist ] unless ;
51 INSTANCE: vlist immutable-sequence
53 SYNTAX: VL{ \ } [ >vlist ] parse-literal ;
55 TUPLE: valist { vlist vlist read-only } ;
57 : <valist> ( -- valist ) <vlist> valist boa ; inline
59 M: valist assoc-size vlist>> length 2/ ;
61 : valist-at ( key i array -- value ? )
64 [ 1 + ] dip nth-unsafe nip t
68 ] [ 3drop f f ] if ; inline recursive
71 vlist>> >vlist< [ 2 - ] [ underlying>> ] bi* valist-at ;
74 vlist>> ppush ppush valist boa ;
77 vlist>> 2 <groups> [ { } like ] map ;
79 : >valist ( assoc -- valist )
80 >alist concat >vlist valist boa ; inline
83 drop dup valist? [ >valist ] unless ;
85 INSTANCE: valist assoc
87 SYNTAX: VA{ \ } [ >valist ] parse-literal ;
89 { "vlists" "prettyprint" } "vlists.prettyprint" require-when