1 ! Copyright (C) 2006, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays sequences sequences.private
4 kernel kernel.private math assocs quotations.private
10 : uncurry dup 2 slot swap 3 slot ; inline
12 : uncompose dup 2 slot swap 3 slot ; inline
16 M: quotation call (call) ;
18 M: curry call uncurry call ;
20 M: compose call uncompose slip call ;
23 over wrapper? [ [ wrapped>> ] bi@ = ] [ 2drop f ] if ;
25 UNION: callable quotation curry compose ;
28 over callable? [ sequence= ] [ 2drop f ] if ;
30 M: quotation length array>> length ;
32 M: quotation nth-unsafe array>> nth-unsafe ;
34 : >quotation ( seq -- quot )
35 >array array>quotation ; inline
37 M: callable like drop dup quotation? [ >quotation ] unless ;
39 INSTANCE: quotation immutable-sequence
41 : 1quotation ( obj -- quot ) 1array >quotation ;
43 GENERIC: literalize ( obj -- wrapped )
45 M: object literalize ;
47 M: wrapper literalize <wrapper> ;
49 M: curry length quot>> length 1+ ;
52 over zero? [ nip obj>> literalize ] [ >r 1- r> quot>> nth ] if ;
54 INSTANCE: curry immutable-sequence
57 [ first>> length ] [ second>> length ] bi + ;
59 M: compose virtual-seq first>> ;
62 2dup first>> length < [
65 [ first>> length - ] [ second>> ] bi
68 INSTANCE: compose virtual-sequence