dispatch-case-quot ( default assoc -- quot )

Vocabulary

combinators.private

Inputs

default	an object
assoc	an object

Outputs

quot

an object

Definition

USING: assocs kernel math math.order quotations sequences
sequences.private sorting ;

IN: combinators.private

: dispatch-case-quot ( default assoc -- quot )
    swap [
        [ keys [ minimum ] [ maximum ] bi over ]
        [ sort-keys values [ >quotation ] map ] bi
    ] dip dup [
        [ [ [ - ] curry ] dip [ dispatch ] curry compose ] dip [
            [
                [ [ ~quotation~ ] dip ] dip [ between? ] 2curry
                compose
            ] dip
        ] dip [ if ] 2curry compose
    ] dip [ [ [ dup integer? ] ] dip ] dip [ if ] 2curry compose
    ;