diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 5c76a0fcf8..aeedef39bd 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -515,7 +515,7 @@ M: quotation ' 20000 objects set emit-header t, 0, 1, -1, "Building generic words..." print flush - call-remake-generics-hook + remake-generics "Serializing words..." print flush emit-words "Serializing JIT data..." print flush diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index 9169e9e0fa..f19225a45c 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -12,8 +12,6 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler" "Normally, new word definitions are recompiled automatically. This can be changed:" { $subsection disable-compiler } { $subsection enable-compiler } -"The optimizing compiler can be called directly, although this should not be necessary under normal circumstances:" -{ $subsection optimized-recompile-hook } "Removing a word's optimized definition:" { $subsection decompile } "Compiling a single quotation:" @@ -46,9 +44,8 @@ HELP: (compile) { $description "Compile a single word." } { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ; -HELP: optimized-recompile-hook -{ $values { "words" "a sequence of words" } { "alist" "an association list" } } -{ $description "Compile a set of words." } +HELP: optimizing-compiler +{ $description "Singleton class implementing " { $link recompile } " to call the optimizing compiler." } { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ; HELP: compile-call diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 24ce3debeb..349d50fe35 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -111,7 +111,7 @@ t compile-dependencies? set-global ] with-return ; : compile-loop ( deque -- ) - [ (compile) yield-hook get call ] slurp-deque ; + [ (compile) yield-hook get assert-depth ] slurp-deque ; : decompile ( word -- ) f 2array 1array modify-code-heap ; @@ -119,7 +119,9 @@ t compile-dependencies? set-global : compile-call ( quot -- ) [ dup infer define-temp ] with-compilation-unit execute ; -: optimized-recompile-hook ( words -- alist ) +SINGLETON: optimizing-compiler + +M: optimizing-compiler recompile ( words -- alist ) [ compile-queue set H{ } clone compiled set @@ -129,10 +131,10 @@ t compile-dependencies? set-global ] with-scope ; : enable-compiler ( -- ) - [ optimized-recompile-hook ] recompile-hook set-global ; + optimizing-compiler compiler-impl set-global ; : disable-compiler ( -- ) - [ default-recompile-hook ] recompile-hook set-global ; + f compiler-impl set-global ; : recompile-all ( -- ) forget-errors all-words compile ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index f881792ac6..b280afc01e 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -309,8 +309,7 @@ FUNCTION: bool check_sse2 ( ) ; check_sse2 ; "-no-sse2" (command-line) member? [ - [ optimized-recompile-hook ] recompile-hook - [ { check_sse2 } compile ] with-variable + optimizing-compiler compiler-impl [ { check_sse2 } compile ] with-variable "Checking if your CPU supports SSE2..." print flush sse2? [ diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 961d0ff26d..98fc06a989 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -53,6 +53,13 @@ IN: tools.deploy.shaker run-file ] when ; +: strip-call ( -- ) + "call" vocab [ + "Stripping stack effect checking from call( and execute(" show + "vocab:tools/deploy/shaker/strip-call.factor" + run-file + ] when ; + : strip-cocoa ( -- ) "cocoa" vocab [ "Stripping unused Cocoa methods" show @@ -256,9 +263,7 @@ IN: tools.deploy.shaker command-line:main-vocab-hook compiled-crossref compiled-generic-crossref - recompile-hook - update-tuples-hook - remake-generics-hook + compiler-impl definition-observers definitions:crossref interactive-vocabs @@ -399,6 +404,7 @@ SYMBOL: deploy-vocab init-stripper strip-default-methods strip-libc + strip-call strip-cocoa strip-debugger compute-next-methods diff --git a/basis/tools/deploy/shaker/strip-call.factor b/basis/tools/deploy/shaker/strip-call.factor new file mode 100644 index 0000000000..4259895936 --- /dev/null +++ b/basis/tools/deploy/shaker/strip-call.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2009 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +IN: tools.deploy.shaker.call + +IN: call +USE: call.private + +: execute-effect ( word effect -- ) execute-effect-unsafe ; inline \ No newline at end of file diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 9e064cf99c..0b8583bb81 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -36,7 +36,7 @@ H{ } clone sub-primitives set dictionary new-classes changed-definitions changed-generics - remake-generics forgotten-definitions + outdated-generics forgotten-definitions root-cache source-files update-map implementors-map } [ H{ } clone swap set ] each @@ -47,8 +47,10 @@ init-caches ! Trivial recompile hook. We don't want to touch the code heap ! during stage1 bootstrap, it would just waste time. +! SINGLETON: dummy-compiler +! M: dummy-compiler recompile drop { } ; +! dummy-compiler compiler-impl set [ drop { } ] recompile-hook set - call call call diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index b13bc1bfa2..a01c9db53e 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -4,7 +4,7 @@ USING: arrays definitions hashtables kernel kernel.private math namespaces make sequences sequences.private strings vectors words quotations memory combinators generic classes classes.algebra classes.builtin classes.private slots.private -slots compiler.units math.private accessors assocs effects ; +slots math.private accessors assocs effects ; IN: classes.tuple PREDICATE: tuple-class < class @@ -188,6 +188,8 @@ ERROR: bad-superclass class ; : apply-slot-permutation ( old-values triples -- new-values ) [ first3 update-slot ] with map ; +SYMBOL: outdated-tuples + : permute-slots ( old-values layout -- new-values ) [ first all-slots ] [ outdated-tuples get at ] bi compute-slot-permutation @@ -212,8 +214,6 @@ ERROR: bad-superclass class ; dup [ update-tuple ] map become ] if ; -[ update-tuples ] update-tuples-hook set-global - : update-tuples-after ( class -- ) [ all-slots ] [ tuple-layout ] bi outdated-tuples get set-at ; diff --git a/core/compiler/units/units-docs.factor b/core/compiler/units/units-docs.factor index 46d3dbc33f..bf3b4a7171 100644 --- a/core/compiler/units/units-docs.factor +++ b/core/compiler/units/units-docs.factor @@ -17,7 +17,7 @@ $nl "Forward reference checking (see " { $link "definition-checking" } "):" { $subsection forward-reference? } "A hook to be called at the end of the compilation unit. If the optimizing compiler is loaded, this compiles new words with the " { $link "compiler" } ":" -{ $subsection recompile-hook } +{ $subsection recompile } "Low-level compiler interface exported by the Factor VM:" { $subsection modify-code-heap } ; @@ -47,8 +47,9 @@ $nl $nl "Since compilation is relatively expensive, you should try to batch up as many definitions into one compilation unit as possible." } ; -HELP: recompile-hook -{ $var-description "Quotation with stack effect " { $snippet "( words -- )" } ", called at the end of " { $link with-compilation-unit } "." } ; +HELP: recompile +{ $values { "words" "a sequence of words" } { "alist" "an association list mapping words to compiled definitions" } } +{ $contract "Internal word which compiles words. Called at the end of " { $link with-compilation-unit } "." } ; HELP: no-compilation-unit { $values { "word" word } } diff --git a/core/compiler/units/units-tests.factor b/core/compiler/units/units-tests.factor index 5eafcef94e..d84b377f36 100644 --- a/core/compiler/units/units-tests.factor +++ b/core/compiler/units/units-tests.factor @@ -2,6 +2,9 @@ IN: compiler.units.tests USING: definitions compiler.units tools.test arrays sequences words kernel accessors namespaces fry ; +[ [ [ ] define-temp ] with-compilation-unit ] must-infer +[ [ [ ] define-temp ] with-nested-compilation-unit ] must-infer + [ flushed-dependency ] [ f flushed-dependency strongest-dependency ] unit-test [ flushed-dependency ] [ flushed-dependency f strongest-dependency ] unit-test [ inlined-dependency ] [ flushed-dependency inlined-dependency strongest-dependency ] unit-test diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 178e29fd93..eaa9c8d537 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 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 -math math.order classes classes.algebra ; +math math.order classes classes.algebra classes.tuple +classes.tuple.private generic ; IN: compiler.units SYMBOL: old-definitions @@ -35,7 +36,11 @@ TUPLE: redefine-error def ; [ new-definitions get assoc-stack not ] [ drop f ] if ; -SYMBOL: recompile-hook +SYMBOL: compiler-impl + +HOOK: recompile compiler-impl ( words -- alist ) + +M: f recompile [ f ] { } map>assoc ; : ( -- pair ) { H{ } H{ } } [ clone ] map ; @@ -68,12 +73,7 @@ GENERIC: definitions-changed ( assoc obj -- ) dup changed-definitions get update dup dup changed-vocabs update ; -: compile ( words -- ) - recompile-hook get call modify-code-heap ; - -SYMBOL: outdated-tuples -SYMBOL: update-tuples-hook -SYMBOL: remake-generics-hook +: compile ( words -- ) recompile modify-code-heap ; : index>= ( obj1 obj2 seq -- ? ) [ index ] curry bi@ >= ; @@ -125,24 +125,15 @@ SYMBOL: remake-generics-hook changed-generics get compiled-generic-usages append assoc-combine keys ; -: call-recompile-hook ( -- ) - to-recompile recompile-hook get call ; - -: call-remake-generics-hook ( -- ) - remake-generics-hook get call ; - -: call-update-tuples-hook ( -- ) - update-tuples-hook get call ; - : unxref-forgotten-definitions ( -- ) forgotten-definitions get keys [ word? ] filter [ delete-compiled-xref ] each ; : finish-compilation-unit ( -- ) - call-remake-generics-hook - call-recompile-hook - call-update-tuples-hook + remake-generics + to-recompile recompile + update-tuples unxref-forgotten-definitions modify-code-heap ; @@ -150,7 +141,7 @@ SYMBOL: remake-generics-hook [ H{ } clone changed-definitions set H{ } clone changed-generics set - H{ } clone remake-generics set + H{ } clone outdated-generics set H{ } clone outdated-tuples set H{ } clone new-classes set [ finish-compilation-unit ] [ ] cleanup @@ -160,7 +151,7 @@ SYMBOL: remake-generics-hook [ H{ } clone changed-definitions set H{ } clone changed-generics set - H{ } clone remake-generics set + H{ } clone outdated-generics set H{ } clone forgotten-definitions set H{ } clone outdated-tuples set H{ } clone new-classes set @@ -172,8 +163,3 @@ SYMBOL: remake-generics-hook notify-definition-observers ] [ ] cleanup ] with-scope ; inline - -: default-recompile-hook ( words -- alist ) - [ f ] { } map>assoc ; - -recompile-hook [ [ default-recompile-hook ] ] initialize diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index db99d7e3a3..3fa30b63ee 100644 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -19,7 +19,7 @@ SYMBOL: changed-definitions SYMBOL: changed-generics -SYMBOL: remake-generics +SYMBOL: outdated-generics SYMBOL: new-classes diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 351a8f98fd..ef1ca6f1ab 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -3,7 +3,7 @@ USING: accessors words kernel sequences namespaces make assocs hashtables definitions kernel.private classes classes.private classes.algebra quotations arrays vocabs effects combinators -sets compiler.units ; +sets ; IN: generic ! Method combination protocol @@ -21,11 +21,6 @@ M: generic definition drop f ; [ dup "combination" word-prop perform-combination ] bi ; -[ - remake-generics get keys - [ generic? ] filter [ make-generic ] each -] remake-generics-hook set-global - : method ( class generic -- method/f ) "methods" word-prop at ; @@ -76,7 +71,10 @@ TUPLE: check-method class generic ; [ [ [ class-or ] when* ] change-at ] [ no-compilation-unit ] if* ; : remake-generic ( generic -- ) - dup remake-generics get set-in-unit ; + dup outdated-generics get set-in-unit ; + +: remake-generics ( -- ) + outdated-generics get keys [ generic? ] filter [ make-generic ] each ; : with-methods ( class generic quot -- ) [ drop changed-generic ]