steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.tree.propagation.transforms: don't fail to compile if 'at' called on something that's not an assoc

db4
Slava Pestov 2009-08-27 18:57:56 -05:00
parent e40ac73085
commit ba0f3a9911
2 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/tree/propagation/propagation-tests.factor
View File

@ -780,6 +780,10 @@ M: f whatever2 ; inline
[ t ] [ [ 1 whatever2 at ] { at* hashcode* } inlined? ] unit-test [ t ] [ [ 1 whatever2 at ] { at* hashcode* } inlined? ] unit-test
[ f ] [ [ whatever2 at ] { at* hashcode* } inlined? ] unit-test [ f ] [ [ whatever2 at ] { at* hashcode* } inlined? ] unit-test
SYMBOL: not-an-assoc
[ f ] [ [ not-an-assoc at ] { at* } inlined? ] unit-test
[ t ] [ [ { 1 2 3 } member? ] { member? } inlined? ] unit-test [ t ] [ [ { 1 2 3 } member? ] { member? } inlined? ] unit-test
[ f ] [ [ { 1 2 3 } swap member? ] { member? } inlined? ] unit-test [ f ] [ [ { 1 2 3 } swap member? ] { member? } inlined? ] unit-test

2
basis/compiler/tree/propagation/transforms/transforms.factor
View File

@ -207,12 +207,14 @@ CONSTANT: lookup-table-at-max 256
] ; ] ;
: at-quot ( assoc -- quot ) : at-quot ( assoc -- quot )
dup assoc? [
dup lookup-table-at? [ dup lookup-table-at? [
dup fast-lookup-table-at? [ dup fast-lookup-table-at? [
fast-lookup-table-quot fast-lookup-table-quot
] [ ] [
lookup-table-quot lookup-table-quot
] if ] if
] [ drop f ] if
] [ drop f ] if ; ] [ drop f ] if ;
\ at* [ at-quot ] 1 define-partial-eval \ at* [ at-quot ] 1 define-partial-eval