Refactor curry/compose a bit for upcoming frontend changes
parent
a881ce01ae
commit
9e685d7ac4
|
@ -6,7 +6,8 @@ sequences strings vectors words quotations assocs layouts
|
|||
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
|
||||
|
@ -310,9 +311,12 @@ tuple
|
|||
} 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
|
||||
|
@ -323,9 +327,12 @@ tuple
|
|||
} 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
|
||||
|
|
|
@ -5,11 +5,19 @@ kernel kernel.private math assocs quotations.private
|
|||
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 ;
|
||||
|
|
Loading…
Reference in New Issue