Paste: hang on compilation (fry2)

USING: accessors arrays assocs combinators
combinators.short-circuit combinators.smart fry generalizations
kernel lexer make math math.order multiline namespaces parser
prettyprint quotations sequences sequences.deep
sequences.private sets sorting.slots splitting
splitting.monotonic strings.parser ;
IN: fry2

TUPLE: fry-quot seq ;
INSTANCE: fry-quot immutable-sequence

: <fry-quot> ( seq -- fry-quot )
    fry-quot new
        swap >>seq ; inline

M: fry-quot length seq>> length ;
M: fry-quot nth-unsafe seq>> nth-unsafe ;

TUPLE: fry-array seq ;
INSTANCE: fry-array immutable-sequence

: <fry-array> ( seq -- fry-quot )
    fry-array new
        swap >>seq ; inline

M: fry-array length seq>> length ;
M: fry-array nth-unsafe seq>> nth-unsafe ;
M: fry-array like drop { } like ;

MIXIN: frypan
INSTANCE: fry-quot frypan
INSTANCE: fry-array frypan

MIXIN: frier
INSTANCE: fry-quot frier
INSTANCE: fry-array frier

TUPLE: fried seq ;
: <fried> ( obj -- obj )
    fried new
        swap >>seq ; inline

M: fried length seq>> length ;
M: fried nth-unsafe seq>> nth-unsafe ;

INSTANCE: fried immutable-sequence

<<
SYNTAX: FRY[ parse-quotation <fry-quot> suffix! ;
SYNTAX: FRY{ \ } [ >array ] [ parse-until ] dip call <fry-array> suffix! ;
>>

GENERIC: split-fry ( obj -- obj' )
M: object split-fry ;
M: frypan split-fry
    [
        [ { [ { _ @ } member? ] [ frypan? ] } 1|| ] bi@
        2array { { t f } { f f } } member?
    ] monotonic-split
    [ [ split-fry ] map ] map <fried> ;

: process-fry ( seq -- quot )
    [
        split-fry
        [
            dup ?first {
                { [ dup \ _ = ] [
                    drop unclip drop >quotation '[ _ curry ]
                ] }
                { [ dup \ @ = ] [
                    drop unclip drop >quotation '[ _ compose ]
                ] }
                { [ dup fried? ] [
                    drop process-fry
                ] }
                [ drop ]
            } cond
        ] map [ >quotation ] map
    ! ] keep  ! ok
    ] keep drop { } ! XXX: HANGS
    '[ [ _ spread ] _ output>sequence concat ] ; inline recursive