2008-09-10 21:07:07 -04:00
|
|
|
! Copyright (C) 2003, 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2012-07-19 12:35:28 -04:00
|
|
|
USING: assocs kernel sequences namespaces ;
|
2008-09-10 21:07:07 -04:00
|
|
|
IN: make
|
|
|
|
|
|
|
|
SYMBOL: building
|
|
|
|
|
2012-07-19 12:35:28 -04:00
|
|
|
<PRIVATE
|
|
|
|
|
|
|
|
: make-sequence ( quot exemplar -- seq )
|
2008-09-10 21:07:07 -04:00
|
|
|
[
|
2012-07-21 13:44:54 -04:00
|
|
|
32 swap new-resizable [
|
|
|
|
building [ call ] with-variable
|
|
|
|
] keep
|
|
|
|
] keep like ; inline
|
2008-09-10 21:07:07 -04:00
|
|
|
|
2012-07-19 12:35:28 -04:00
|
|
|
: make-assoc ( quot exemplar -- assoc )
|
2012-07-21 13:44:54 -04:00
|
|
|
5 swap new-assoc [
|
|
|
|
building [ call ] with-variable
|
|
|
|
] keep ; inline
|
2012-07-19 12:35:28 -04:00
|
|
|
|
|
|
|
PRIVATE>
|
|
|
|
|
|
|
|
: make ( quot exemplar -- seq )
|
|
|
|
dup sequence? [ make-sequence ] [ make-assoc ] if ; inline
|
|
|
|
|
2008-09-10 21:07:07 -04:00
|
|
|
: , ( elt -- ) building get push ;
|
|
|
|
|
|
|
|
: % ( seq -- ) building get push-all ;
|
2012-07-19 12:35:28 -04:00
|
|
|
|
|
|
|
: ,, ( value key -- ) building get set-at ;
|
|
|
|
|
|
|
|
: %% ( assoc -- ) building get swap assoc-union! drop ;
|
2012-07-19 20:47:50 -04:00
|
|
|
|
|
|
|
: ,+ ( n key -- ) building get at+ ;
|