use map-reduce instead of unclip reduce, "Why do we need this?" --> we don't

db4
Doug Coleman 2009-04-06 17:32:20 -05:00
parent dd43df655f
commit 77f99eb70c
2 changed files with 2 additions and 8 deletions

View File

@ -21,12 +21,12 @@ CONSTANT: epsilon T{ tagged-epsilon { tag t } }
TUPLE: concatenation first second ; TUPLE: concatenation first second ;
: <concatenation> ( seq -- concatenation ) : <concatenation> ( seq -- concatenation )
[ epsilon ] [ unclip [ concatenation boa ] reduce ] if-empty ; [ epsilon ] [ [ ] [ concatenation boa ] map-reduce ] if-empty ;
TUPLE: alternation first second ; TUPLE: alternation first second ;
: <alternation> ( seq -- alternation ) : <alternation> ( seq -- alternation )
unclip [ alternation boa ] reduce ; [ ] [ alternation boa ] map-reduce ;
TUPLE: star term ; TUPLE: star term ;
C: <star> star C: <star> star

View File

@ -11,12 +11,7 @@ TUPLE: transition-table transitions start-state final-states ;
H{ } clone >>transitions H{ } clone >>transitions
H{ } clone >>final-states ; H{ } clone >>final-states ;
: maybe-initialize-key ( key hashtable -- )
! Why do we have to do this?
2dup key? [ 2drop ] [ [ H{ } clone ] 2dip set-at ] if ;
:: (set-transition) ( from to obj hash -- ) :: (set-transition) ( from to obj hash -- )
to condition? [ to hash maybe-initialize-key ] unless
from hash at from hash at
[ [ to obj ] dip set-at ] [ [ to obj ] dip set-at ]
[ to obj associate from hash set-at ] if* ; [ to obj associate from hash set-at ] if* ;
@ -25,7 +20,6 @@ TUPLE: transition-table transitions start-state final-states ;
transitions>> (set-transition) ; transitions>> (set-transition) ;
:: (add-transition) ( from to obj hash -- ) :: (add-transition) ( from to obj hash -- )
to hash maybe-initialize-key
from hash at from hash at
[ [ to obj ] dip push-at ] [ [ to obj ] dip push-at ]
[ to 1vector obj associate from hash set-at ] if* ; [ to 1vector obj associate from hash set-at ] if* ;