Paste: Simplify sequences of shuffle words.

! Copyright (C) 2009 Miles Gould
! See http://factorcode.org/license.txt for BSD license.
! Simplify sequences of shuffle words.
USING: combinators.smart kernel quotations sequences sequences.product
math.ranges assocs arrays ;
IN: tools.shuffle-simplify

: id ( -- ) ;

: shuffles ( -- seq )
{
    drop 2drop 3drop nip 2nip
    dup 2dup 3dup dupd over 2over pick tuck
    swap swapd rot -rot spin roll -roll
} ;

: shuffles-id ( -- seq ) { id } shuffles append ;

! What does a word do if the numbers [0,10] are on the stack?
: behaviour ( quot -- seq )
    10 [0,b] prepend >quotation output>array ; inline

! Get a map of behaviours => shuffle words.
: shuffle-behaviours ( -- assoc )
    shuffles-id [ [ 1quotation behaviour ] keep ] H{ } map>assoc ; inline

! Given a sequence of shuffle words, return either a single shuffle word
! with the same stack effect, or f if none was found.
: simplify ( seq -- seq )
    >quotation behaviour shuffle-behaviours at ; inline

! Find one-word equivalents of all n-word sequences of shuffles, ignoring
! those sequences for which no one-word equivalent exists.
: simplify-all ( n -- seq )
    shuffles <repetition> <product-sequence>
    [ dup simplify ] H{ } map>assoc [ nip ] assoc-filter ; inline

Annotation: Slight cleanup

! Copyright (C) 2009 Miles Gould
! See http://factorcode.org/license.txt for BSD license.
! Generate exhaustive lists of simplifications for sequences of shuffle words.
USING: combinators.smart kernel quotations sequences sequences.product
math.ranges assocs arrays ;
IN: tools.shuffle-simplify

: id ( -- ) ;

: shuffles ( -- seq )
{
    drop 2drop 3drop nip 2nip
    dup 2dup 3dup dupd over 2over pick tuck
    swap swapd rot -rot spin roll -roll
} ;

: shuffles-id ( -- seq ) { id } shuffles append ;

! What does a sequence of words do if the numbers [0,10] are on the stack?
: behaviour ( seq -- seq )
    10 [0,b] prepend >quotation output>array ; inline

! Get a map of behaviours => shuffle words.
: shuffle-behaviours ( -- assoc )
    shuffles-id [ [ 1quotation behaviour ] keep ] H{ } map>assoc ; inline

! Given a sequence of shuffle words, return either a single shuffle word
! with the same stack effect, or f if none was found.
: simplify ( seq -- seq )
    behaviour shuffle-behaviours at ; inline

! Find one-word equivalents of all n-word sequences of shuffles, ignoring
! those sequences for which no one-word equivalent exists.
: simplify-all ( n -- seq )
    shuffles <repetition> <product-sequence>
    [ dup simplify ] H{ } map>assoc [ nip ] assoc-filter ; inline

New Annotation