1 ! Copyright (C) 2006, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays kernel kernel.private math sequences
4 sequences.private slots.private ;
8 { array array read-only initial: { } }
12 PRIMITIVE: jit-compile ( quot -- )
13 PRIMITIVE: quot-compiled? ( quot -- ? )
14 PRIMITIVE: quotation-code ( quot -- start end )
17 PRIMITIVE: array>quotation ( array -- quot )
19 : uncurry ( curry -- obj quot )
20 { curry } declare dup 2 slot swap 3 slot ; inline
22 : uncompose ( compose -- quot quot2 )
23 { compose } declare dup 2 slot swap 3 slot ; inline
27 M: quotation call (call) ;
29 M: curry call uncurry call ;
31 M: compose call uncompose [ call ] dip call ;
34 over wrapper? [ [ wrapped>> ] same? ] [ 2drop f ] if ;
36 UNION: callable quotation curry compose ;
39 over callable? [ sequence= ] [ 2drop f ] if ;
41 M: quotation length array>> length ;
43 M: quotation nth-unsafe array>> nth-unsafe ;
45 : >quotation ( seq -- quot )
46 >array array>quotation ; inline
48 M: callable like drop dup quotation? [ >quotation ] unless ;
50 INSTANCE: quotation immutable-sequence
52 : 1quotation ( obj -- quot ) 1array array>quotation ;
54 GENERIC: literalize ( obj -- wrapped )
56 M: object literalize ;
58 M: wrapper literalize <wrapper> ;
60 M: curry length quot>> length 1 + ;
64 [ nip obj>> literalize ]
65 [ [ 1 - ] dip quot>> nth ]
68 INSTANCE: curry immutable-sequence
71 [ first>> length ] [ second>> length ] bi + ;
73 M: compose virtual-exemplar first>> ;
76 2dup first>> length < [
79 [ first>> length - ] [ second>> ] bi
82 INSTANCE: compose virtual-sequence