From ba0f3a9911b597ff0ab5cf028683be7bfd81fe27 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 27 Aug 2009 18:57:56 -0500 Subject: [PATCH] compiler.tree.propagation.transforms: don't fail to compile if 'at' called on something that's not an assoc --- .../tree/propagation/propagation-tests.factor | 4 ++++ .../tree/propagation/transforms/transforms.factor | 14 ++++++++------ 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 511f87dd09..879ab82c4b 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -780,6 +780,10 @@ M: f whatever2 ; inline [ t ] [ [ 1 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 [ f ] [ [ { 1 2 3 } swap member? ] { member? } inlined? ] unit-test diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 683c182903..f3247b55fc 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -207,12 +207,14 @@ CONSTANT: lookup-table-at-max 256 ] ; : at-quot ( assoc -- quot ) - dup lookup-table-at? [ - dup fast-lookup-table-at? [ - fast-lookup-table-quot - ] [ - lookup-table-quot - ] if + dup assoc? [ + dup lookup-table-at? [ + dup fast-lookup-table-at? [ + fast-lookup-table-quot + ] [ + lookup-table-quot + ] if + ] [ drop f ] if ] [ drop f ] if ; \ at* [ at-quot ] 1 define-partial-eval