Merge branch 'master' into simd

db4
Slava Pestov 2009-09-08 13:38:14 -05:00
commit aa4307765b
3 changed files with 10 additions and 6 deletions

View File

@ -70,12 +70,16 @@ H{
{ sum { +vector+ -> +scalar+ } } { sum { +vector+ -> +scalar+ } }
} }
SYMBOL: specializations PREDICATE: vector-word < word vector-words key? ;
specializations [ vector-words keys [ V{ } clone ] H{ } map>assoc ] initialize : specializations ( word -- assoc )
dup "specializations" word-prop
[ ] [ V{ } clone [ "specializations" set-word-prop ] keep ] ?if ;
M: vector-word subwords specializations values ;
: add-specialization ( new-word signature word -- ) : add-specialization ( new-word signature word -- )
specializations get at set-at ; specializations set-at ;
: word-schema ( word -- schema ) vector-words at ; : word-schema ( word -- schema ) vector-words at ;
@ -103,7 +107,7 @@ specializations [ vector-words keys [ V{ } clone ] H{ } map>assoc ] initialize
] each ; ] each ;
: find-specialization ( classes word -- word/f ) : find-specialization ( classes word -- word/f )
specializations get at specializations
[ first [ class<= ] 2all? ] with find [ first [ class<= ] 2all? ] with find
swap [ second ] when ; swap [ second ] when ;

View File

@ -45,7 +45,7 @@ T{ error-type
SYMBOL: file SYMBOL: file
: file-failure ( error -- ) : file-failure ( error -- )
f file get f failure ; [ f file get ] keep error-line failure ;
:: (unit-test) ( output input -- error ? ) :: (unit-test) ( output input -- error ? )
[ { } input with-datastack output assert-sequence= f f ] [ t ] recover ; [ { } input with-datastack output assert-sequence= f f ] [ t ] recover ;

View File

@ -97,7 +97,7 @@ M: error-renderer column-titles
M: error-renderer column-alignment drop { 0 1 0 0 } ; M: error-renderer column-alignment drop { 0 1 0 0 } ;
: sort-errors ( seq -- seq' ) : sort-errors ( seq -- seq' )
[ [ [ line#>> ] [ asset>> unparse-short ] bi 2array ] keep ] { } map>assoc [ [ [ line#>> 0 or ] [ asset>> unparse-short ] bi 2array ] keep ] { } map>assoc
sort-keys values ; sort-keys values ;
: file-matches? ( error pathname/f -- ? ) : file-matches? ( error pathname/f -- ? )