diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index efa6294c98..d86c9234d1 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -15,18 +15,17 @@ IN: compiler SYMBOL: compile-queue SYMBOL: compiled -: queue-compile? ( word -- ? ) +: compile? ( word -- ? ) #! Don't attempt to compile certain words. { [ "forgotten" word-prop ] [ compiled get key? ] - [ single-generic? ] [ inlined-block? ] [ primitive? ] } 1|| not ; : queue-compile ( word -- ) - dup queue-compile? [ compile-queue get push-front ] [ drop ] if ; + dup compile? [ compile-queue get push-front ] [ drop ] if ; : recompile-callers? ( word -- ? ) changed-effects get key? ; @@ -43,6 +42,14 @@ SYMBOL: compiled H{ } clone generic-dependencies set clear-compiler-error ; +GENERIC: no-compile? ( word -- ? ) + +M: word no-compile? "no-compile" word-prop ; + +M: method-body no-compile? "method-generic" word-prop no-compile? ; + +M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ; + : ignore-error? ( word error -- ? ) #! Ignore some errors on inline combinators, macros, and special #! words such as 'call'. @@ -50,8 +57,8 @@ SYMBOL: compiled { [ macro? ] [ inline? ] + [ no-compile? ] [ "special" word-prop ] - [ "no-compile" word-prop ] } 1|| ] [ { @@ -98,12 +105,16 @@ SYMBOL: compiled 2bi ] if ; +: optimize? ( word -- ? ) + { [ contains-breakpoints? ] [ single-generic? ] } 1|| not ; + : frontend ( word -- nodes ) #! If the word contains breakpoints, don't optimize it, since #! the walker does not support this. - dup contains-breakpoints? [ dup def>> deoptimize-with ] [ - [ build-tree ] [ deoptimize ] recover optimize-tree - ] if ; + dup optimize? + [ [ build-tree ] [ deoptimize ] recover optimize-tree ] + [ dup def>> deoptimize-with ] + if ; : compile-dependency ( word -- ) #! If a word calls an unoptimized word, try to compile the callee. diff --git a/basis/debugger/debugger-docs.factor b/basis/debugger/debugger-docs.factor index ff5869efab..ff9986432c 100644 --- a/basis/debugger/debugger-docs.factor +++ b/basis/debugger/debugger-docs.factor @@ -1,6 +1,6 @@ USING: alien arrays generic generic.math help.markup help.syntax kernel math memory strings sbufs vectors io io.files classes -help generic.standard continuations io.files.private listener +help generic.single continuations io.files.private listener alien.libraries ; IN: debugger diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor index d96e0df6c1..68777f2f73 100644 --- a/basis/listener/listener.factor +++ b/basis/listener/listener.factor @@ -62,6 +62,8 @@ SYMBOL: max-stack-items SYMBOL: error-summary? +t error-summary? set-global + > (step-into-quot) ] diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index aa23a8ebe1..704ae112e5 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -10,7 +10,7 @@ ui.gadgets.tables ui.gadgets.labeled ui.gadgets.tracks ui.gestures ui.operations ui.tools.browser ui.tools.common ui.gadgets.scrollers ui.tools.inspector ui.gadgets.status-bar ui.operations ui.gadgets.buttons ui.gadgets.borders ui.gadgets.packs -ui.gadgets.labels ui.baseline-alignment ui.images ui.tools.listener +ui.gadgets.labels ui.baseline-alignment ui.images compiler.errors tools.errors tools.errors.model ; IN: ui.tools.error-list diff --git a/basis/ui/tools/listener/completion/completion.factor b/basis/ui/tools/listener/completion/completion.factor index 70131f3212..17216bd656 100644 --- a/basis/ui/tools/listener/completion/completion.factor +++ b/basis/ui/tools/listener/completion/completion.factor @@ -8,8 +8,7 @@ definitions.icons ui.images ui.commands ui.operations ui.gadgets ui.gadgets.editors ui.gadgets.glass ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.tracks ui.gadgets.labeled ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.pens.solid -ui.tools.listener.history combinators vocabs ui.tools.listener.popups - ; +ui.tools.listener.history combinators vocabs ui.tools.listener.popups ; IN: ui.tools.listener.completion ! We don't directly depend on the listener tool but we use a few slots @@ -120,8 +119,6 @@ M: object completion-string present ; M: method-body completion-string method-completion-string ; -M: engine-word completion-string method-completion-string ; - GENERIC# accept-completion-hook 1 ( item popup -- ) : insert-completion ( item popup -- ) diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index c180807b0c..466b221877 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -1,11 +1,11 @@ -USING: definitions generic kernel kernel.private math -math.constants parser sequences tools.test words assocs -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 -words.symbol compiler.errors ; +USING: definitions generic kernel kernel.private math math.constants +parser sequences tools.test words assocs namespaces quotations +sequences.private classes continuations generic.single +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 words.symbol +compiler.errors ; IN: classes.tuple.tests TUPLE: rect x y w h ; diff --git a/core/generic/generic-docs.factor b/core/generic/generic-docs.factor index e8b5e6d69c..73002a5d89 100644 --- a/core/generic/generic-docs.factor +++ b/core/generic/generic-docs.factor @@ -1,6 +1,7 @@ USING: help.markup help.syntax words classes classes.algebra definitions kernel alien sequences math quotations -generic.standard generic.math combinators prettyprint effects ; +generic.single generic.standard generic.hook generic.math +combinators prettyprint effects ; IN: generic ARTICLE: "method-order" "Method precedence" diff --git a/core/generic/hook/hook.factor b/core/generic/hook/hook.factor index 0574833fab..a44d071e4d 100644 --- a/core/generic/hook/hook.factor +++ b/core/generic/hook/hook.factor @@ -17,3 +17,6 @@ M: hook-combination picker M: hook-combination dispatch# drop 0 ; M: hook-generic definer drop \ HOOK: f ; + +M: hook-generic effective-method + [ "combination" word-prop var>> get ] keep (effective-method) ; \ No newline at end of file diff --git a/core/generic/standard/standard-tests.factor b/core/generic/single/single-tests.factor similarity index 88% rename from core/generic/standard/standard-tests.factor rename to core/generic/single/single-tests.factor index 58007f795f..8245cbe22f 100644 --- a/core/generic/standard/standard-tests.factor +++ b/core/generic/single/single-tests.factor @@ -1,11 +1,10 @@ -IN: generic.standard.tests -USING: tools.test math math.functions math.constants -generic.standard strings sequences arrays kernel accessors words -specialized-arrays.double byte-arrays bit-arrays parser -namespaces make quotations stack-checker vectors growable -hashtables sbufs prettyprint byte-vectors bit-vectors -specialized-vectors.double definitions generic sets graphs assocs -grouping see ; +IN: generic.single.tests +USING: tools.test math math.functions math.constants generic.standard +generic.single strings sequences arrays kernel accessors words +specialized-arrays.double byte-arrays bit-arrays parser namespaces +make quotations stack-checker vectors growable hashtables sbufs +prettyprint byte-vectors bit-vectors specialized-vectors.double +definitions generic sets graphs assocs grouping see ; GENERIC: lo-tag-test ( obj -- obj' ) @@ -249,23 +248,6 @@ M: string my-hook "a string" ; [ "a string" ] [ my-hook my-var set my-hook ] unit-test [ 1.0 my-var set my-hook ] [ T{ no-method f 1.0 my-hook } = ] must-fail-with -HOOK: my-tuple-hook my-var ( -- x ) - -M: sequence my-tuple-hook my-hook ; - -TUPLE: m-t-h-a ; - -M: m-t-h-a my-tuple-hook "foo" ; - -TUPLE: m-t-h-b < m-t-h-a ; - -M: m-t-h-b my-tuple-hook "bar" ; - -[ f ] [ - \ my-tuple-hook [ "engines" word-prop ] keep prefix - [ 1quotation infer ] map all-equal? -] unit-test - HOOK: call-next-hooker my-var ( -- x ) M: sequence call-next-hooker "sequence" ; @@ -281,7 +263,7 @@ M: growable call-next-hooker call-next-method "growable " prepend ; ] unit-test [ t ] [ - { } \ nth effective-method nip \ sequence \ nth method eq? + { } \ nth effective-method nip M\ sequence nth eq? ] unit-test [ t ] [ diff --git a/core/generic/single/single.factor b/core/generic/single/single.factor index d70a378c67..7624fbfb7d 100644 --- a/core/generic/single/single.factor +++ b/core/generic/single/single.factor @@ -42,16 +42,13 @@ M: single-combination next-method-quot* ] [ 3drop f ] if ] with-combination ; -: single-effective-method ( obj word -- method ) +: (effective-method) ( obj word -- method ) [ [ order [ instance? ] with find-last nip ] keep method ] [ "default-method" word-prop ] bi or ; -M: single-generic effective-method - [ [ picker ] with-combination call ] keep single-effective-method ; - M: single-combination make-default-method - combination [ [ picker ] dip [ no-method ] curry append ] with-variable ; + [ [ picker ] dip [ no-method ] curry append ] with-combination ; ! ! ! Build an engine ! ! ! @@ -101,7 +98,10 @@ TUPLE: tuple-dispatch-engine echelons ; [ ?set-at ] change-at ; : echelon-sort ( assoc -- assoc' ) - H{ } clone [ [ push-echelon ] curry assoc-each ] keep ; + #! Convert an assoc mapping classes to methods into an + #! assoc mapping echelons to assocs. The first echelon + #! is always there + H{ { 0 f } } clone [ [ push-echelon ] curry assoc-each ] keep ; : ( methods -- engine ) echelon-sort @@ -127,9 +127,13 @@ TUPLE: tag-dispatch-engine methods ; C: tag-dispatch-engine : ( assoc -- engine ) + dup keys [ not ] filter [ "FOO" throw ] unless-empty flatten-methods + dup keys [ not ] filter [ "FOO1" throw ] unless-empty convert-tuple-methods + dup keys [ not ] filter [ "FOO2" throw ] unless-empty convert-hi-tag-methods + dup keys [ not ] filter [ "FOO3" throw ] unless-empty ; ! ! ! Compile engine ! ! ! @@ -146,7 +150,7 @@ GENERIC: compile-engine ( engine -- obj ) M: tag-dispatch-engine compile-engine methods>> compile-engines* - [ [ tag-number ] dip ] assoc-map + [ [ global [ target-word ] bind tag-number ] dip ] assoc-map num-tags get direct-dispatch-table ; : hi-tag-number ( class -- n ) "type" word-prop ; @@ -159,16 +163,23 @@ M: hi-tag-dispatch-engine compile-engine num-hi-tags direct-dispatch-table ; : build-fast-hash ( methods -- buckets ) - >alist V{ } clone [ hashcode 1array ] distribute-buckets + V{ } clone [ hashcode 1array ] distribute-buckets [ compile-engines* >alist >array ] map ; M: echelon-dispatch-engine compile-engine - methods>> compile-engines* build-fast-hash ; + dup n>> 0 = [ + methods>> dup assoc-size { + { 0 [ drop default get ] } + { 1 [ >alist first second compile-engine ] } + } case + ] [ + methods>> compile-engines* build-fast-hash + ] if ; M: tuple-dispatch-engine compile-engine tuple assumed [ echelons>> compile-engines - dup keys supremum f default get prefix + dup keys supremum 1+ f [ swap update ] keep ] with-variable ; diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index bbf458ef1d..bf8ea8da08 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors definitions generic generic.single kernel -namespaces words math combinators ; +namespaces words math combinators sequences ; IN: generic.standard TUPLE: standard-combination < single-combination # ; @@ -32,6 +32,10 @@ M: standard-combination picker M: standard-combination dispatch# #>> ; -M: simple-generic definer drop \ GENERIC: f ; +M: standard-generic effective-method + [ datastack ] dip [ "combination" word-prop #>> swap nth ] keep + (effective-method) ; -M: standard-generic definer drop \ GENERIC# f ; \ No newline at end of file +M: standard-generic definer drop \ GENERIC# f ; + +M: simple-generic definer drop \ GENERIC: f ; diff --git a/core/layouts/layouts.factor b/core/layouts/layouts.factor index 5a32ca2dce..e30245abd1 100644 --- a/core/layouts/layouts.factor +++ b/core/layouts/layouts.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces math words kernel assocs classes math.order kernel.private ; @@ -16,12 +16,12 @@ SYMBOL: tag-numbers SYMBOL: type-numbers -: tag-number ( class -- n ) - tag-numbers get at [ object tag-number ] unless* ; - : type-number ( class -- n ) type-numbers get at ; +: tag-number ( class -- n ) + type-number dup num-tags get >= [ drop object tag-number ] when ; + : tag-fixnum ( n -- tagged ) tag-bits get shift ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index 556e41249e..cfd96789b4 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -1,6 +1,6 @@ USING: arrays help.markup help.syntax math sequences.private vectors strings kernel math.order layouts -quotations generic.standard ; +quotations generic.single ; IN: sequences HELP: sequence @@ -1466,8 +1466,8 @@ ARTICLE: "sequences-combinators" "Sequence combinators" { $subsection produce } { $subsection produce-as } "Filtering:" -{ $subsection push-if } { $subsection filter } +{ $subsection partition } "Testing if a sequence contains elements satisfying a predicate:" { $subsection any? } { $subsection all? }