diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor index ba58e60a4a..6d0a8f8c8e 100644 --- a/basis/compiler/cfg/debugger/debugger.factor +++ b/basis/compiler/cfg/debugger/debugger.factor @@ -16,7 +16,7 @@ M: callable test-cfg build-tree optimize-tree gensym build-cfg ; M: word test-cfg - [ build-tree-from-word nip optimize-tree ] keep build-cfg ; + [ build-tree-from-word optimize-tree ] keep build-cfg ; SYMBOL: allocate-registers? diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index f2f4e7aa9e..d6da95408d 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -1,46 +1,47 @@ ! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel namespaces arrays sequences io -words fry continuations vocabs assocs dlists definitions math -graphs generic combinators deques search-deques io -stack-checker stack-checker.state stack-checker.inlining -compiler.errors compiler.units compiler.tree.builder -compiler.tree.optimizer compiler.cfg.builder -compiler.cfg.optimizer compiler.cfg.linearization -compiler.cfg.two-operand compiler.cfg.linear-scan -compiler.cfg.stack-frame compiler.codegen compiler.utilities ; +USING: accessors kernel namespaces arrays sequences io words fry +continuations vocabs assocs dlists definitions math graphs +generic combinators deques search-deques io stack-checker +stack-checker.state stack-checker.inlining +combinators.short-circuit compiler.errors compiler.units +compiler.tree.builder compiler.tree.optimizer +compiler.cfg.builder compiler.cfg.optimizer +compiler.cfg.linearization compiler.cfg.two-operand +compiler.cfg.linear-scan compiler.cfg.stack-frame +compiler.codegen compiler.utilities ; IN: compiler SYMBOL: compile-queue SYMBOL: compiled -: queue-compile ( word -- ) +: queue-compile? ( word -- ? ) { - { [ dup "forgotten" word-prop ] [ ] } - { [ dup compiled get key? ] [ ] } - { [ dup inlined-block? ] [ ] } - { [ dup primitive? ] [ ] } - [ dup compile-queue get push-front ] - } cond drop ; + [ "forgotten" word-prop ] + [ compiled get key? ] + [ inlined-block? ] + [ primitive? ] + } 1|| not ; + +: queue-compile ( word -- ) + dup queue-compile? [ compile-queue get push-front ] [ drop ] if ; : maybe-compile ( word -- ) dup optimized>> [ drop ] [ queue-compile ] if ; -SYMBOL: +failed+ +SYMBOLS: +optimized+ +unoptimized+ ; : ripple-up ( words -- ) - dup "compiled-effect" word-prop +failed+ eq? + dup "compiled-status" word-prop +unoptimized+ eq? [ usage [ word? ] filter ] [ compiled-usage keys ] if [ queue-compile ] each ; -: ripple-up? ( word effect -- ? ) - #! If the word has previously been compiled and had a - #! different stack effect, we have to recompile any callers. - swap "compiled-effect" word-prop [ = not ] keep and ; +: ripple-up? ( word status -- ? ) + swap "compiled-status" word-prop [ = not ] keep and ; -: save-effect ( word effect -- ) +: save-compiled-status ( word status -- ) [ dupd ripple-up? [ ripple-up ] [ drop ] if ] - [ "compiled-effect" set-word-prop ] + [ "compiled-status" set-word-prop ] 2bi ; : start ( word -- ) @@ -49,18 +50,18 @@ SYMBOL: +failed+ H{ } clone generic-dependencies set f swap compiler-error ; -: fail ( word error -- ) +: fail ( word error -- * ) [ swap compiler-error ] [ drop [ compiled-unxref ] [ f swap compiled get set-at ] - [ +failed+ save-effect ] + [ +unoptimized+ save-compiled-status ] tri ] 2bi return ; -: frontend ( word -- effect nodes ) +: frontend ( word -- nodes ) [ build-tree-from-word ] [ fail ] recover optimize-tree ; ! Only switch this off for debugging. @@ -84,8 +85,8 @@ t compile-dependencies? set-global save-asm ] each ; -: finish ( effect word -- ) - [ swap save-effect ] +: finish ( word -- ) + [ +optimized+ save-compiled-status ] [ compiled-unxref ] [ dup crossref? @@ -112,6 +113,9 @@ t compile-dependencies? set-global : decompile ( word -- ) f 2array 1array modify-code-heap ; +: compile-call ( quot -- ) + [ dup infer define-temp ] with-compilation-unit execute ; + : optimized-recompile-hook ( words -- alist ) [ compile-queue set diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index cfeb5d01ac..b5cb0ddbdb 100644 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -303,7 +303,7 @@ HINTS: recursive-inline-hang-3 array ; : member-test ( obj -- ? ) { + - * / /i } member? ; \ member-test must-infer -[ ] [ \ member-test build-tree-from-word optimize-tree 2drop ] unit-test +[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test [ t ] [ \ + member-test ] unit-test [ f ] [ \ append member-test ] unit-test diff --git a/basis/compiler/tree/builder/builder-tests.factor b/basis/compiler/tree/builder/builder-tests.factor index d758e2a34d..4982a3986c 100755 --- a/basis/compiler/tree/builder/builder-tests.factor +++ b/basis/compiler/tree/builder/builder-tests.factor @@ -8,4 +8,4 @@ compiler.tree ; : inline-recursive ( -- ) inline-recursive ; inline recursive -[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test +[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index b715223445..4cb7650b1d 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/basis/compiler/tree/builder/builder.factor @@ -12,18 +12,18 @@ IN: compiler.tree.builder : with-tree-builder ( quot -- nodes ) '[ V{ } clone stack-visitor set @ ] - with-infer ; inline + with-infer nip ; inline : build-tree ( quot -- nodes ) #! Not safe to call from inference transforms. - [ f initial-recursive-state infer-quot ] with-tree-builder nip ; + [ f initial-recursive-state infer-quot ] with-tree-builder ; : build-tree-with ( in-stack quot -- nodes out-stack ) #! Not safe to call from inference transforms. [ [ >vector \ meta-d set ] [ f initial-recursive-state infer-quot ] bi* - ] with-tree-builder nip + ] with-tree-builder unclip-last in-d>> ; : build-sub-tree ( #call quot -- nodes ) @@ -45,7 +45,7 @@ IN: compiler.tree.builder : check-no-compile ( word -- ) dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ; -: build-tree-from-word ( word -- effect nodes ) +: build-tree-from-word ( word -- nodes ) [ [ { diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index 9f2cc0536e..188dcdb935 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -144,7 +144,7 @@ SYMBOL: node-count : make-report ( word/quot -- assoc ) [ - dup word? [ build-tree-from-word nip ] [ build-tree ] if + dup word? [ build-tree-from-word ] [ build-tree ] if optimize-tree H{ } clone words-called set