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 : ( 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 : ( 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 ; : ( 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 suffix! ; SYNTAX: FRY{ \ } [ >array ] [ parse-until ] dip call 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 ; : 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