Paste: shadows

Author: kenanb
Mode: factor
Date: Sun, 24 Apr 2011 22:10:28
Plain Text | 
QUALIFIED: sets
QUALIFIED: classes

SYMBOL: +shadowed+

: (assoc-slots) ( slots... length seq -- assoc ) 
    [ narray reverse! ] dip swap zip ; inline

: (assoc-slots-to-initial) ( seq class -- assoc ) 
    initial-values reverse! zip ;

: (extract-slot-values) ( initial-slot-assoc slot-assoc length -- slots... )
    [ assoc-union! reverse! [ last ] map ] dip firstn ; inline

MACRO: shadowed-boa ( class -- tuple ) 
    [
        all-slots [ name>> ] map 
        [ reverse! sets:members ] keep
        [ [ length ] bi@ ] 2keep swapd
    ] keep
   '[ _ _ (assoc-slots) _ _ _
        [ (assoc-slots-to-initial) -rot (extract-slot-values) ] 
        [ boa ] bi 
    ] ;

: mark-shadowed-slots ( tuple -- marked )
    +shadowed+ over dup classes:class all-slots dup
    [ name>> ] map duplicates sets:members
    [  '[ name>> _ = ] filter but-last
      [ offset>> set-slot ] 2 nwith each
    ] 3 nwith each  ;

Annotation: another version, but problematic

Author: kenanb
Mode: factor
Date: Mon, 25 Apr 2011 17:02:16
Plain Text | 
QUALIFIED: sets

: duplicated-slots ( class -- seq ) 
    all-slots [ name>> ] map 
    duplicates sets:members ;

: shadowed-slot-offsets ( class -- seq ) 
    [ duplicated-slots ] 
    [ all-slots ] bi 
    [ 
        [ name>> = ] with filter 
        but-last [ offset>> ] map 
    ] curry map ;

: number-of-slots ( class -- number ) all-slots length ;

: (shadowed-boa) ( class -- quot ) 
    [
        [ shadowed-slot-offsets flatten natural-sort reverse! ] 
        [ initial-values ]
        [ number-of-slots 1 - ] tri 
       '[ 2 - [ _ nth _ ] keep - '[ _ 1quotation _ ndip ] ] map concat
    ] 
    [ 
        1quotation 
    ] bi compose ;

MACRO: shadowed-boa ( class -- tuple )
    (shadowed-boa) [ boa ] compose ;

Annotation: works like a charm :)

Author: kenanb
Mode: factor
Date: Mon, 25 Apr 2011 17:09:45
Plain Text | 
QUALIFIED: sets

: duplicated-slots ( class -- seq ) 
    all-slots [ name>> ] map 
    duplicates sets:members ;

: shadowed-slot-offsets ( class -- seq ) 
    [ duplicated-slots ] 
    [ all-slots ] bi 
    [ 
        [ name>> = ] with filter 
        but-last [ offset>> ] map 
    ] curry map ;

: number-of-slots ( class -- number ) all-slots length ;

: (shadowed-boa) ( class -- quot ) 
    [
        [ shadowed-slot-offsets flatten natural-sort reverse! ] 
        [ initial-values ]
        [ number-of-slots 1 - ] tri 
       '[ 2 - [ _ nth _ ] keep - '[ [ _ ] _ ndip ] ] map concat
    ] 
    [ 
        [ ] curry 
    ] bi compose ;

MACRO: shadowed-boa ( class -- tuple )
    (shadowed-boa) [ boa ] compose ;

Annotation: better indentation for mark-shadowed-slots

Author: kenanb
Mode: factor
Date: Mon, 25 Apr 2011 17:12:49
Plain Text | 
: mark-shadowed-slots ( tuple -- marked )
    +shadowed+ over dup 
    classes:class all-slots dup
    [ name>> ] map duplicates sets:members
    [  
     '[ name>> _ = ] filter but-last
      [ offset>> set-slot ] 2 nwith each
    ] 3 nwith each  ;

Annotation: mark-shadowed-slots refactored

Author: kenanb
Mode: factor
Date: Mon, 25 Apr 2011 17:56:15
Plain Text | 
: mark-shadowed-slots ( tuple -- 'tuple ) 
    [ class shadowed-slot-offsets flatten +shadowed+ ] 
    [ '[ _ _ rot set-slot ] each ] 
    [ ] tri ;

Annotation: mark-shadowed refactored

Author: kenanb
Mode: factor
Date: Mon, 25 Apr 2011 18:09:00
Plain Text | 
QUALIFIED: sets
QUALIFIED: classes
QUALIFIED: sequences.deep

SYMBOL: +shadow+

: (duplicated-slots) ( class -- seq ) 
    all-slots [ name>> ] map 
    duplicates sets:members ;

: shadowed-slot-offsets ( class -- seq ) 
    [ (duplicated-slots) ] 
    [ all-slots ] bi 
    [ 
        [ name>> = ] with filter 
        but-last [ offset>> ] map 
    ] curry map sequences.deep:flatten ;

: number-of-slots ( class -- number ) all-slots length ;

: (shadowed-boa) ( class -- quot ) 
    [
        [ shadowed-slot-offsets natural-sort reverse! ] 
        [ initial-values ]
        [ number-of-slots 1 - ] tri 
       '[ 2 - [ _ nth _ ] keep - '[ [ _ ] _ ndip ] ] map concat
    ] 
    [ 
        [ ] curry 
    ] bi compose ;

MACRO: shadowed-boa ( class -- tuple )
    (shadowed-boa) [ boa ] compose ;

: mark-shadowed ( tuple -- 'tuple ) 
    [ classes:class shadowed-slot-offsets +shadow+ ] 
    [ '[ _ _ rot set-slot ] each ] 
    [ ] tri ;

Annotation: added >quotation to ensure word will run if no shadows at all

Author: kenanb
Mode: factor
Date: Mon, 25 Apr 2011 19:18:30
Plain Text | 
QUALIFIED: sets
QUALIFIED: classes
QUALIFIED: sequences.deep

SYMBOL: +shadow+

: (duplicated-slots) ( class -- seq ) 
    all-slots [ name>> ] map 
    duplicates sets:members ;

: shadowed-slot-offsets ( class -- seq ) 
    [ (duplicated-slots) ] 
    [ all-slots ] bi 
    [ 
        [ name>> = ] with filter 
        but-last [ offset>> ] map 
    ] curry map sequences.deep:flatten ;

: number-of-slots ( class -- number ) all-slots length ;

: (shadowed-boa) ( class -- quot ) 
    [
        [ shadowed-slot-offsets natural-sort reverse! ] 
        [ initial-values ]
        [ number-of-slots 1 - ] tri 
       '[ 2 - [ _ nth _ ] keep - '[ [ _ ] _ ndip ] ] map concat >quotation
    ] 
    [ 
        [ ] curry 
    ] bi compose ;

MACRO: shadowed-boa ( class -- tuple )
    (shadowed-boa) [ boa ] compose ;

: mark-shadowed ( tuple -- 'tuple ) 
    [ classes:class shadowed-slot-offsets +shadow+ ] 
    [ '[ _ _ rot set-slot ] each ] 
    [ ] tri ;

New Annotation

Summary:
Author:
Mode:
Body: