factor/library/quotations.factor

37 lines
1.1 KiB
Factor
Raw Normal View History

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-18 01:08:09 -04:00
USING: arrays generic kernel-internals math namespaces sequences
sequences-internals words ;
2006-08-07 15:41:31 -04:00
M: wrapper equal?
2006-05-18 01:08:09 -04:00
over wrapper? [ [ wrapped ] 2apply = ] [ 2drop f ] if ;
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 ;
2006-05-15 01:01:47 -04:00
2006-08-15 21:23:05 -04:00
: >quotation ( seq -- quot )
2006-07-24 00:20:08 -04:00
[ quotation? ] [ <quotation> ] >sequence ; inline
2006-05-16 16:50:51 -04:00
M: quotation like drop dup quotation? [ >quotation ] unless ;
2006-05-15 01:01:47 -04:00
2006-08-15 21:23:05 -04:00
: make-dip ( quot n -- newquot )
2006-05-15 01:01:47 -04:00
dup \ >r <array> -rot \ r> <array> append3 >quotation ;
2006-08-15 21:23:05 -04:00
: unit ( obj -- quot ) 1array >quotation ;
2006-05-15 01:01:47 -04:00
2006-08-15 21:23:05 -04:00
GENERIC: literalize ( obj -- newobj )
2006-05-18 01:08:09 -04:00
M: object literalize ;
M: word literalize <wrapper> ;
M: wrapper literalize <wrapper> ;
: curry ( obj quot -- newquot )
[ swap literalize , % ] [ ] make ;
2006-05-15 01:01:47 -04:00
2006-08-15 21:23:05 -04:00
: alist>quot ( default assoc -- quot )
2006-05-15 01:01:47 -04:00
[ [ first2 swap % , , \ if , ] [ ] make ] each ;