From 6080c6e734161a1ba81495d3e929de82f756ad97 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 22 Mar 2009 20:16:31 -0500 Subject: [PATCH] Fix stack effect redefinition --- basis/alien/c-types/c-types-tests.factor | 2 +- basis/compiler/compiler.factor | 9 +++-- basis/compiler/tests/redefine2.factor | 4 ++- .../tree/cleanup/cleanup-tests.factor | 2 +- core/classes/classes.factor | 19 +++++++---- core/classes/tuple/tuple-tests.factor | 33 ++++++++++++++----- core/classes/tuple/tuple.factor | 5 ++- core/compiler/units/units.factor | 2 ++ core/definitions/definitions.factor | 13 +++++--- core/generic/generic.factor | 3 +- core/words/words.factor | 6 ++-- 11 files changed, 64 insertions(+), 34 deletions(-) diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 40171f56e7..988dc180e0 100644 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -4,7 +4,7 @@ sequences system libc alien.strings io.encodings.utf8 ; \ expand-constants must-infer -: xyz 123 ; +CONSTANT: xyz 123 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index c8e1e5fd0f..04c1a9c55f 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -35,11 +35,14 @@ SYMBOLS: +optimized+ +unoptimized+ ; [ usage [ word? ] filter ] [ compiled-usage keys ] if [ queue-compile ] each ; -: ripple-up? ( word status -- ? ) - swap "compiled-status" word-prop [ = not ] keep and ; +: ripple-up? ( status word -- ? ) + [ + [ nip changed-effects get key? ] + [ "compiled-status" word-prop eq? not ] 2bi or + ] keep "compiled-status" word-prop and ; : save-compiled-status ( word status -- ) - [ dupd ripple-up? [ ripple-up ] [ drop ] if ] + [ over ripple-up? [ ripple-up ] [ drop ] if ] [ "compiled-status" set-word-prop ] 2bi ; diff --git a/basis/compiler/tests/redefine2.factor b/basis/compiler/tests/redefine2.factor index d6e90187fe..5a28b28261 100644 --- a/basis/compiler/tests/redefine2.factor +++ b/basis/compiler/tests/redefine2.factor @@ -1,12 +1,14 @@ IN: compiler.tests USING: compiler compiler.units tools.test math parser kernel sequences sequences.private classes.mixin generic definitions -arrays words assocs eval ; +arrays words assocs eval words.symbol ; DEFER: redefine2-test [ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval ] unit-test +[ t ] [ \ redefine2-test symbol? ] unit-test + [ t ] [ redefine2-test new sequence? ] unit-test [ 3 ] [ 0 redefine2-test new nth-unsafe ] unit-test diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 2ed68934a7..7de092d84a 100755 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -197,7 +197,7 @@ M: fixnum annotate-entry-test-1 drop ; [ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2) ] if ; inline recursive -: annotate-entry-test-2 0 -rot (annotate-entry-test-2) ; inline +: annotate-entry-test-2 ( from to -- ) 0 -rot (annotate-entry-test-2) ; inline [ f ] [ [ { bignum } declare annotate-entry-test-2 ] diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 888eac7645..eded33beed 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays definitions assocs kernel kernel.private slots.private namespaces make sequences strings words words.symbol @@ -126,14 +126,19 @@ M: sequence implementors [ implementors ] gather ; } spread ] H{ } make-assoc ; +: ?define-symbol ( word -- ) + dup deferred? [ define-symbol ] [ drop ] if ; + : (define-class) ( word props -- ) [ - dup class? [ dup [ implementors-map+ ] [ new-class ] bi ] unless - dup reset-class - dup deferred? [ dup define-symbol ] when - dup redefined - dup props>> - ] dip assoc-union >>props + { + [ dup class? [ drop ] [ [ implementors-map+ ] [ new-class ] bi ] if ] + [ reset-class ] + [ ?define-symbol ] + [ redefined ] + [ ] + } cleave + ] dip [ assoc-union ] curry change-props dup predicate-word [ 1quotation "predicate" set-word-prop ] [ swap "predicating" set-word-prop ] diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index f27d24e39d..fa2df4e312 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -4,7 +4,8 @@ namespaces quotations sequences.private classes continuations generic.standard effects classes.tuple classes.tuple.private arrays vectors strings compiler.units accessors classes.algebra calendar prettyprint io.streams.string splitting summary -columns math.order classes.private slots slots.private eval see ; +columns math.order classes.private slots slots.private eval see +words.symbol ; IN: classes.tuple.tests TUPLE: rect x y w h ; @@ -62,7 +63,7 @@ TUPLE: predicate-test ; C: predicate-test -: predicate-test drop f ; +: predicate-test ( a -- ? ) drop f ; [ t ] [ predicate-test? ] unit-test @@ -97,7 +98,7 @@ TUPLE: size-test a b c d ; size-test tuple-layout second = ] unit-test -GENERIC: +GENERIC: ( a -- b ) TUPLE: yo-momma ; @@ -123,7 +124,7 @@ TUPLE: loc-recording ; TUPLE: forget-robustness ; -GENERIC: forget-robustness-generic +GENERIC: forget-robustness-generic ( a -- b ) M: forget-robustness forget-robustness-generic ; @@ -493,7 +494,7 @@ must-fail-with [ t ] [ "z" accessor-exists? ] unit-test [ [ ] ] [ - "IN: classes.tuple.tests GENERIC: forget-accessors-test" + "IN: classes.tuple.tests GENERIC: forget-accessors-test ( a -- b )" "forget-accessors-test" parse-stream ] unit-test @@ -508,7 +509,7 @@ TUPLE: another-forget-accessors-test ; [ [ ] ] [ - "IN: classes.tuple.tests GENERIC: another-forget-accessors-test" + "IN: classes.tuple.tests GENERIC: another-forget-accessors-test ( a -- b )" "another-forget-accessors-test" parse-stream ] unit-test @@ -567,7 +568,7 @@ GENERIC: break-me ( obj -- ) [ ] [ "IN: classes.tuple.tests USE: kernel M: subclass-reset-test-1 break-me drop ;" eval ] unit-test -[ ] [ "IN: classes.tuple.tests : subclass-reset-test ;" "subclass-reset-test" parse-stream drop ] unit-test +[ ] [ "IN: classes.tuple.tests : subclass-reset-test ( -- ) ;" "subclass-reset-test" parse-stream drop ] unit-test [ f ] [ subclass-reset-test-1 tuple-class? ] unit-test [ f ] [ subclass-reset-test-2 tuple-class? ] unit-test @@ -666,7 +667,7 @@ DEFER: error-y [ ] [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test -[ ] [ "IN: classes.tuple.tests GENERIC: error-y" eval ] unit-test +[ ] [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" eval ] unit-test [ f ] [ \ error-y tuple-class? ] unit-test @@ -730,4 +731,18 @@ SLOT: kex ] unit-test [ t ] [ \ change-slot-test \ kex>> method >boolean ] unit-test -[ f ] [ \ change-slot-test \ kex>> method "reading" word-prop ] unit-test \ No newline at end of file +[ f ] [ \ change-slot-test \ kex>> method "reading" word-prop ] unit-test + +DEFER: redefine-tuple-twice + +[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval ] unit-test + +[ t ] [ \ redefine-tuple-twice symbol? ] unit-test + +[ ] [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" eval ] unit-test + +[ t ] [ \ redefine-tuple-twice deferred? ] unit-test + +[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval ] unit-test + +[ t ] [ \ redefine-tuple-twice symbol? ] unit-test \ No newline at end of file diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index a01c9db53e..fb7a073205 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -247,8 +247,7 @@ M: tuple-class update-class bi ] each-subclass ] - [ define-new-tuple-class ] - 3bi ; + [ define-new-tuple-class ] 3bi ; : tuple-class-unchanged? ( class superclass slots -- ? ) [ [ superclass ] [ bootstrap-word ] bi* = ] @@ -275,7 +274,7 @@ M: word (define-tuple-class) M: tuple-class (define-tuple-class) 3dup tuple-class-unchanged? - [ 3drop ] [ redefine-tuple-class ] if ; + [ 2drop ?define-symbol ] [ redefine-tuple-class ] if ; : thrower-effect ( slots -- effect ) [ dup array? [ first ] when ] map { "*" } ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index eac288a079..afa05f9442 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -148,6 +148,7 @@ GENERIC: definitions-changed ( assoc obj -- ) [ H{ } clone changed-definitions set H{ } clone changed-generics set + H{ } clone changed-effects set H{ } clone outdated-generics set H{ } clone outdated-tuples set H{ } clone new-classes set @@ -158,6 +159,7 @@ GENERIC: definitions-changed ( assoc obj -- ) [ H{ } clone changed-definitions set H{ } clone changed-generics set + H{ } clone changed-effects set H{ } clone outdated-generics set H{ } clone forgotten-definitions set H{ } clone outdated-tuples set diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index 3fa30b63ee..434b133b3f 100644 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -1,13 +1,11 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: definitions USING: kernel sequences namespaces assocs graphs math math.order ; +IN: definitions ERROR: no-compilation-unit definition ; -SYMBOL: inlined-dependency -SYMBOL: flushed-dependency -SYMBOL: called-dependency +SYMBOLS: inlined-dependency flushed-dependency called-dependency ; : set-in-unit ( value key assoc -- ) [ set-at ] [ no-compilation-unit ] if* ; @@ -17,6 +15,11 @@ SYMBOL: changed-definitions : changed-definition ( defspec -- ) inlined-dependency swap changed-definitions get set-in-unit ; +SYMBOL: changed-effects + +: changed-effect ( word -- ) + dup changed-effects get set-in-unit ; + SYMBOL: changed-generics SYMBOL: outdated-generics diff --git a/core/generic/generic.factor b/core/generic/generic.factor index c78c88eef0..8380a41207 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -199,8 +199,7 @@ M: sequence update-methods ( class seq -- ) 2cleave ] if ] - [ 2drop remake-generic ] - 3tri ; + [ 2drop remake-generic ] 3tri ; M: generic subwords [ diff --git a/core/words/words.factor b/core/words/words.factor index b101350db0..cfdcd4517f 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -164,8 +164,10 @@ CONSTANT: reset-on-redefine { "inferred-effect" "cannot-infer" } : set-stack-effect ( effect word -- ) 2dup "declared-effect" word-prop = [ 2drop ] [ swap + [ drop changed-effect ] [ "declared-effect" set-word-prop ] - [ drop dup primitive? [ dup redefined ] unless drop ] 2bi + [ drop dup primitive? [ drop ] [ redefined ] if ] + 2tri ] if ; : define-declared ( word def effect -- ) @@ -192,7 +194,7 @@ M: word reset-word { "unannotated-def" "parsing" "inline" "recursive" "foldable" "flushable" "reading" "writing" "reader" - "writer" "declared-effect" "delimiter" + "writer" "delimiter" } reset-props ; GENERIC: subwords ( word -- seq )