classes classes.builtin classes.tuple classes.tuple.private
kernel.private vocabs vocabs.loader source-files definitions
slots classes.union classes.intersection classes.predicate
-compiler.units bootstrap.image.private io.files accessors combinators ;
+compiler.units bootstrap.image.private io.files accessors
+combinators ;
IN: bootstrap.primitives
"Creating primitives and basic runtime structures..." print flush
} prepare-slots define-tuple-class
"curry" "kernel" lookup
-[ f "inline" set-word-prop ]
-[ ]
-[ tuple-layout [ <tuple-boa> ] curry ] tri
+{
+ [ f "inline" set-word-prop ]
+ [ make-flushable ]
+ [ ]
+ [ tuple-layout [ <tuple-boa> ] curry ] tri
+} cleave
(( obj quot -- curry )) define-declared
"compose" "kernel" create
} prepare-slots define-tuple-class
"compose" "kernel" lookup
-[ f "inline" set-word-prop ]
-[ ]
-[ tuple-layout [ <tuple-boa> ] curry ] tri
+{
+ [ f "inline" set-word-prop ]
+ [ make-flushable ]
+ [ ]
+ [ tuple-layout [ <tuple-boa> ] curry ] tri
+} cleave
(( quot1 quot2 -- compose )) define-declared
! Sub-primitive words
slots.private ;
IN: quotations
+<PRIVATE
+
+: uncurry dup 3 slot swap 4 slot ; inline
+
+: uncompose dup 3 slot swap 4 slot ; inline
+
+PRIVATE>
+
M: quotation call (call) ;
-M: curry call dup 3 slot swap 4 slot call ;
+M: curry call uncurry call ;
-M: compose call dup 3 slot swap 4 slot slip call ;
+M: compose call uncompose slip call ;
M: wrapper equal?
over wrapper? [ [ wrapped>> ] bi@ = ] [ 2drop f ] if ;