2006-05-15 01:01:47 -04:00
|
|
|
! Copyright (C) 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
IN: kernel
|
2006-05-16 16:50:51 -04:00
|
|
|
USING: arrays kernel-internals math namespaces sequences
|
2006-05-15 18:15:35 -04:00
|
|
|
sequences-internals ;
|
2006-05-15 01:01:47 -04:00
|
|
|
|
2006-05-16 16:50:51 -04:00
|
|
|
M: quotation clone (clone) ;
|
|
|
|
M: quotation length array-capacity ;
|
|
|
|
M: quotation nth bounds-check nth-unsafe ;
|
|
|
|
M: quotation set-nth bounds-check set-nth-unsafe ;
|
|
|
|
M: quotation nth-unsafe >r >fixnum r> array-nth ;
|
|
|
|
M: quotation set-nth-unsafe >r >fixnum r> set-array-nth ;
|
|
|
|
M: quotation resize resize-array ;
|
2006-05-15 01:01:47 -04:00
|
|
|
|
2006-05-16 16:50:51 -04:00
|
|
|
: >quotation ( seq -- array ) [ <quotation> ] >sequence ; inline
|
|
|
|
|
|
|
|
M: quotation like drop dup quotation? [ >quotation ] unless ;
|
2006-05-15 01:01:47 -04:00
|
|
|
|
|
|
|
: make-dip ( quot n -- quot )
|
|
|
|
dup \ >r <array> -rot \ r> <array> append3 >quotation ;
|
|
|
|
|
|
|
|
: unit ( a -- [ a ] ) 1array >quotation ;
|
|
|
|
|
2006-05-16 16:50:51 -04:00
|
|
|
: curry ( obj quot -- quot ) >r literalize unit r> append ;
|
2006-05-15 01:01:47 -04:00
|
|
|
|
|
|
|
: alist>quot ( default alist -- quot )
|
|
|
|
[ [ first2 swap % , , \ if , ] [ ] make ] each ;
|