Paste: funny combinators

: arity ( quot -- n ) infer [ in>> length ] [ out>> length ] bi - 1+ ;

MACRO: ncleave ( quots n -- )
[ '[ _ '[ _ _ nkeep ] ] map [ ] join ] [ '[ _ ndrop ] ] bi append ;

MACRO: smart-cleave ( quots -- quot )
dup 0 [ arity max ] reduce
[ '[ [ [ _ ] [ arity ] bi* - ] keep '[ _ ndrop @ ] ] map ] keep '[ _ _ ncleave ] ;

SYMBOL: ,
SYMBOL: ]] delimiter
: [[ \ ]] parse-until { , } split [ >quotation ] map parsed \ smart-cleave parsed ; parsing

: id ( a -- b ) ;

MACRO: select ( n m -- quot )
    [ swap - 1+ ] keep
    [ '[ _ nrot ] ] [ 1- '[ [ _ ndrop ] dip ] ] bi* append ;

: @ scan-word parsed \ select parsed ; parsing

SYMBOL: ) delimiter
: ( \ ) parse-until unclip [ >quotation parsed ] [ parsed ] bi* ; parsing