diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index bf9b049127..70a0676863 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -3,18 +3,16 @@ USING: accessors kernel namespaces arrays sequences io words fry continuations vocabs assocs dlists definitions math graphs generic generic.single combinators deques search-deques macros -source-files.errors combinators.short-circuit +source-files.errors combinators.short-circuit classes.algebra stack-checker stack-checker.dependencies stack-checker.inlining stack-checker.errors -compiler.errors compiler.units compiler.utilities +compiler.errors compiler.units compiler.utilities compiler.crossref compiler.tree.builder compiler.tree.optimizer -compiler.crossref - compiler.cfg compiler.cfg.builder compiler.cfg.optimizer @@ -183,6 +181,12 @@ t compile-dependencies? set-global SINGLETON: optimizing-compiler +M: optimizing-compiler update-call-sites ( class generic -- words ) + #! Words containing call sites with inferred type 'class' + #! which inlined a method on 'generic' + compiled-generic-usage swap + '[ nip _ classes-intersect? ] assoc-filter keys ; + M: optimizing-compiler recompile ( words -- alist ) [ compile-queue set @@ -197,9 +201,7 @@ M: optimizing-compiler recompile ( words -- alist ) "--- compile done" compiler-message ; M: optimizing-compiler to-recompile ( -- words ) - changed-definitions get compiled-usages - changed-generics get compiled-generic-usages - append assoc-combine keys ; + changed-definitions get compiled-usages assoc-combine keys ; M: optimizing-compiler process-forgotten-words [ delete-compiled-xref ] each ; diff --git a/basis/compiler/crossref/crossref.factor b/basis/compiler/crossref/crossref.factor index e6ef5cf17c..e216a1f147 100644 --- a/basis/compiler/crossref/crossref.factor +++ b/basis/compiler/crossref/crossref.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs classes.algebra compiler.units definitions graphs grouping kernel namespaces sequences words @@ -32,16 +32,6 @@ compiled-generic-crossref [ H{ } clone ] initialize : compiled-generic-usage ( word -- assoc ) compiled-generic-crossref get at ; -: (compiled-generic-usages) ( generic class -- assoc ) - [ compiled-generic-usage ] dip - [ - 2dup [ valid-class? ] both? - [ classes-intersect? ] [ 2drop f ] if nip - ] curry assoc-filter ; - -: compiled-generic-usages ( assoc -- assocs ) - [ (compiled-generic-usages) ] { } assoc>map ; - : (compiled-xref) ( word dependencies word-prop variable -- ) [ [ concat ] dip set-word-prop ] [ get add-vertex* ] bi-curry* 2bi ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index f009368420..656037c739 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2009 Slava Pestov. +! Copyright (C) 2004, 2010 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 @@ -133,19 +133,24 @@ M: sequence implementors [ implementors ] gather ; dup deferred? [ define-symbol ] [ drop ] if ; : (define-class) ( word props -- ) + reset-caches + [ drop update-map- ] [ - { - [ dup class? [ drop ] [ [ implementors-map+ ] [ new-class ] bi ] if ] - [ reset-class ] - [ ?define-symbol ] - [ changed-definition ] - [ ] - } cleave - ] dip [ assoc-union ] curry change-props - dup predicate-word - [ 1quotation "predicate" set-word-prop ] - [ swap "predicating" set-word-prop ] - [ drop t "class" set-word-prop ] + [ + { + [ dup class? [ drop ] [ implementors-map+ ] if ] + [ reset-class ] + [ ?define-symbol ] + [ ] + } cleave + ] dip [ assoc-union ] curry change-props + dup predicate-word + [ 1quotation "predicate" set-word-prop ] + [ swap "predicating" set-word-prop ] + [ drop t "class" set-word-prop ] + 2tri + ] + [ drop update-map+ ] 2tri ; PRIVATE> @@ -161,13 +166,7 @@ GENERIC: update-methods ( class seq -- ) [ nip [ update-class ] each ] [ update-methods ] 2bi ; : define-class ( word superclass members participants metaclass -- ) - #! If it was already a class, update methods after. - reset-caches - make-class-props - [ drop update-map- ] - [ (define-class) ] - [ drop update-map+ ] - 2tri ; + make-class-props [ (define-class) ] [ drop changed-definition ] 2bi ; : forget-predicate ( class -- ) dup "predicate" word-prop diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 3a6670a4f7..cc67a75407 100644 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -26,10 +26,12 @@ M: mixin-class rank-class drop 3 ; dup mixin-class? [ drop ] [ - [ { } redefine-mixin-class ] - [ H{ } clone "instances" set-word-prop ] - [ update-classes ] - tri + { + [ { } redefine-mixin-class ] + [ H{ } clone "instances" set-word-prop ] + [ changed-definition ] + [ update-classes ] + } cleave ] if ; TUPLE: check-mixin-class class ; @@ -46,18 +48,18 @@ TUPLE: check-mixin-class class ; [ [ members swap bootstrap-word ] dip call ] [ drop ] 2bi swap redefine-mixin-class ; inline -: update-mixin-class ( member mixin -- ) - class-usages - [ update-methods ] - [ [ update-class ] each ] - [ implementors [ remake-generic ] each ] - tri ; - : (add-mixin-instance) ( class mixin -- ) - [ [ suffix ] change-mixin-class ] - [ [ f ] 2dip "instances" word-prop set-at ] - [ update-mixin-class ] - 2tri ; + #! Call update-methods before adding the member: + #! - Call sites of generics specializing on 'mixin' + #! where the inferred type is 'class' are updated, + #! - Call sites where the inferred type is a subtype + #! of 'mixin' disjoint from 'class' are not updated + dup class-usages { + [ nip update-methods ] + [ drop [ suffix ] change-mixin-class ] + [ drop [ f ] 2dip "instances" word-prop set-at ] + [ 2nip [ update-class ] each ] + } 3cleave ; GENERIC# add-mixin-instance 1 ( class mixin -- ) @@ -65,15 +67,19 @@ M: class add-mixin-instance [ 2drop ] [ (add-mixin-instance) ] if-mixin-member? ; : (remove-mixin-instance) ( class mixin -- ) - [ [ swap remove ] change-mixin-class ] - [ "instances" word-prop delete-at ] - [ update-mixin-class ] - 2tri ; + #! Call update-methods after removing the member: + #! - Call sites of generics specializing on 'mixin' + #! where the inferred type is 'class' are updated, + #! - Call sites where the inferred type is a subtype + #! of 'mixin' disjoint from 'class' are not updated + dup class-usages { + [ drop [ swap remove ] change-mixin-class ] + [ drop "instances" word-prop delete-at ] + [ 2nip [ update-class ] each ] + [ nip update-methods ] + } 3cleave ; : remove-mixin-instance ( class mixin -- ) - #! The order of the three clauses is important here. The last - #! one must come after the other two so that the entries it - #! adds to changed-generics are not overwritten. [ (remove-mixin-instance) ] [ 2drop ] if-mixin-member? ; M: mixin-class class-forgotten remove-mixin-instance ; diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index 9540b0be86..94013c32d9 100644 --- a/core/classes/union/union.factor +++ b/core/classes/union/union.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: words sequences kernel assocs combinators classes -classes.algebra classes.algebra.private namespaces arrays math -quotations ; +classes.private classes.algebra classes.algebra.private +namespaces arrays math quotations definitions ; IN: classes.union PREDICATE: union-class < class @@ -26,12 +26,15 @@ PREDICATE: union-class < class M: union-class update-class define-union-predicate ; : (define-union-class) ( class members -- ) - f swap f union-class define-class ; + f swap f union-class make-class-props (define-class) ; PRIVATE> : define-union-class ( class members -- ) - [ (define-union-class) ] [ drop update-classes ] 2bi ; + [ (define-union-class) ] + [ drop changed-definition ] + [ drop update-classes ] + 2tri ; M: union-class rank-class drop 2 ; diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 87a25f2af7..3d0cd7bb97 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel continuations assocs namespaces sequences words vocabs definitions hashtables init sets @@ -43,6 +43,16 @@ PRIVATE> SYMBOL: compiler-impl +HOOK: update-call-sites compiler-impl ( class generic -- words ) + +M: generic update-generic ( class generic -- ) + [ update-call-sites [ changed-definition ] each ] + [ remake-generic drop ] + 2bi ; + +M: sequence update-methods ( class seq -- ) + implementors [ update-generic ] with each ; + HOOK: recompile compiler-impl ( words -- alist ) HOOK: to-recompile compiler-impl ( -- words ) @@ -52,12 +62,14 @@ HOOK: process-forgotten-words compiler-impl ( words -- ) : compile ( words -- ) recompile modify-code-heap ; ! Non-optimizing compiler -M: f recompile - [ dup def>> ] { } map>assoc ; +M: f update-call-sites + 2drop { } ; M: f to-recompile - changed-definitions get [ drop word? ] assoc-filter - changed-generics get assoc-union keys ; + changed-definitions get [ drop word? ] assoc-filter keys ; + +M: f recompile + [ dup def>> ] { } map>assoc ; M: f process-forgotten-words drop ; @@ -148,25 +160,21 @@ PRIVATE> : with-nested-compilation-unit ( quot -- ) [ 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-words set - H{ } clone new-classes set [ finish-compilation-unit ] [ ] cleanup ] with-scope ; inline : with-compilation-unit ( quot -- ) [ 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 H{ } clone new-words set - H{ } clone new-classes set new-definitions set old-definitions set [ finish-compilation-unit ] [ ] cleanup diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index 597b195c36..71d6797abd 100644 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006, 2009 Slava Pestov. +! Copyright (C) 2006, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences namespaces assocs math accessors ; IN: definitions @@ -17,26 +17,16 @@ SYMBOL: changed-definitions SYMBOL: changed-effects -SYMBOL: changed-generics - SYMBOL: outdated-generics SYMBOL: new-words -SYMBOL: new-classes - : new-word ( word -- ) dup new-words get set-in-unit ; : new-word? ( word -- ? ) new-words get key? ; -: new-class ( word -- ) - dup new-classes get set-in-unit ; - -: new-class? ( word -- ? ) - new-classes get key? ; - GENERIC: where ( defspec -- loc ) M: object where drop f ; diff --git a/core/generic/generic.factor b/core/generic/generic.factor index cea3643473..517ccd4775 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -87,21 +87,16 @@ TUPLE: check-method class generic ; \ check-method boa throw ] unless ; inline -: changed-generic ( class generic -- ) - changed-generics get - [ [ [ class-or ] when* ] change-at ] [ no-compilation-unit ] if* ; - : remake-generic ( generic -- ) dup outdated-generics get set-in-unit ; : remake-generics ( -- ) outdated-generics get keys [ generic? ] filter [ make-generic ] each ; +GENERIC: update-generic ( class generic -- ) + : with-methods ( class generic quot -- ) - [ drop changed-generic ] - [ [ "methods" word-prop ] dip call ] - [ drop remake-generic drop ] - 3tri ; inline + [ "methods" word-prop ] prepose [ update-generic ] 2bi ; inline : method-word-name ( class generic -- string ) [ name>> ] bi@ "=>" glue ; @@ -174,11 +169,6 @@ M: method-body forget* [ call-next-method ] bi ] if ; -M: sequence update-methods ( class seq -- ) - implementors [ - [ changed-generic ] [ remake-generic drop ] 2bi - ] with each ; - : define-generic ( word combination effect -- ) [ nip swap set-stack-effect ] [