From 2c73e72e5ea46fa688cafda74358c7fe45d58b10 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 14 Feb 2008 01:03:57 -0600 Subject: [PATCH] case now optimizes contiguous integer ranges --- core/combinators/combinators-docs.factor | 22 +++------ core/combinators/combinators-tests.factor | 7 +++ core/combinators/combinators.factor | 55 ++++++++++++++++++--- core/hashtables/hashtables.factor | 18 ++----- core/inference/transforms/transforms.factor | 2 +- 5 files changed, 68 insertions(+), 36 deletions(-) mode change 100644 => 100755 core/combinators/combinators-tests.factor diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor index d91c920def..5b87297b0c 100755 --- a/core/combinators/combinators-docs.factor +++ b/core/combinators/combinators-docs.factor @@ -7,11 +7,7 @@ ARTICLE: "combinators-quot" "Quotation construction utilities" "Some words for creating quotations which can be useful for implementing method combinations and compiler transforms:" { $subsection cond>quot } { $subsection case>quot } -{ $subsection alist>quot } -"A powerful tool used to optimize code in several places is open-coded hashtable dispatch:" -{ $subsection hash-case>quot } -{ $subsection distribute-buckets } -{ $subsection hash-dispatch-quot } ; +{ $subsection alist>quot } ; ARTICLE: "combinators" "Additional combinators" "The " { $vocab-link "combinators" } " vocabulary is usually used because it provides two combinators which abstract out nested chains of " { $link if } ":" @@ -104,19 +100,17 @@ HELP: case>quot { $values { "assoc" "a sequence of pairs of quotations" } { "default" quotation } { "quot" quotation } } { $description "Creates a quotation that when called, has the same effect as applying " { $link case } " to " { $snippet "assoc" } "." $nl -"The quotation actually tests each possible case in order;" { $link hash-case>quot } " produces more efficient code." } ; +"This word uses three strategies:" +{ $list + "If the assoc only has a few keys, a linear search is generated." + { "If the assoc has a large number of keys which form a contiguous range of integers, a direct dispatch is generated using the " { $link dispatch } " word together with a bounds check." } + "Otherwise, an open-coded hashtable dispatch is generated." +} } ; HELP: distribute-buckets { $values { "assoc" "an alist" } { "initial" object } { "quot" "a quotation with stack effect " { $snippet "( obj -- assoc )" } } { "buckets" "a new array" } } { $description "Sorts the entries of " { $snippet "assoc" } " into buckets, using the quotation to yield a set of keys for each entry. The hashcode of each key is computed, and the entry is placed in all corresponding buckets. Each bucket is initially cloned from " { $snippet "initial" } "; this should either be an empty vector or a one-element vector containing a pair." } -{ $notes "This word is used in the implemention of " { $link hash-case>quot } " and " { $link standard-combination } "." } ; - -HELP: hash-case>quot -{ $values { "default" quotation } { "assoc" "an association list mapping quotations to quotations" } { "quot" quotation } } -{ $description "Creates a quotation that when called, has the same effect as applying " { $link case } " to " { $snippet "assoc" } "." -$nl -"The quotation uses an efficient hash-based search to avoid testing the object against all possible keys." } -{ $notes "This word is used behind the scenes to compile " { $link case } " forms efficiently; it can also be called directly, which is useful for meta-programming." } ; +{ $notes "This word is used in the implemention of " { $link hash-case-quot } " and " { $link standard-combination } "." } ; HELP: dispatch ( n array -- ) { $values { "n" "a fixnum" } { "array" "an array of quotations" } } diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor old mode 100644 new mode 100755 index 3cefda7f71..ce8e180867 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -69,3 +69,10 @@ namespaces combinators words ; ! Interpreted [ "a hashtable" ] [ H{ } \ case-test-3 word-def call ] unit-test + +[ 1 3 t ] [ { 1 3 2 } contiguous-range? ] unit-test +[ f ] [ { 1 2 2 4 } contiguous-range? 2nip ] unit-test +[ f ] [ { + 3 2 } contiguous-range? 2nip ] unit-test +[ f ] [ { 1 0 7 } contiguous-range? 2nip ] unit-test +[ f ] [ { 1 1 3 7 } contiguous-range? 2nip ] unit-test +[ 4 8 t ] [ { 7 6 4 8 5 } contiguous-range? ] unit-test diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 0ba8b583be..ffd1576e6e 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2006, 2007 Slava Pestov. +! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: combinators USING: arrays sequences sequences.private math.private -kernel kernel.private math assocs quotations vectors ; +kernel kernel.private math assocs quotations vectors +hashtables sorting ; TUPLE: no-cond ; @@ -31,16 +32,24 @@ TUPLE: no-case ; : recursive-hashcode ( n obj quot -- code ) pick 0 <= [ 3drop 0 ] [ rot 1- -rot call ] if ; inline +! These go here, not in sequences and hashtables, since those +! two depend on combinators M: sequence hashcode* [ sequence-hashcode ] recursive-hashcode ; +M: hashtable hashcode* + [ + dup assoc-size 1 number= + [ assoc-hashcode ] [ nip assoc-size ] if + ] recursive-hashcode ; + : alist>quot ( default assoc -- quot ) [ rot \ if 3array append [ ] like ] assoc-each ; : cond>quot ( assoc -- quot ) reverse [ no-cond ] swap alist>quot ; -: case>quot ( default assoc -- quot ) +: linear-case-quot ( default assoc -- quot ) [ >r [ dupd = ] curry r> \ drop add* ] assoc-map alist>quot ; @@ -63,20 +72,50 @@ M: sequence hashcode* : hash-case-table ( default assoc -- array ) V{ } [ 1array ] distribute-buckets - [ case>quot ] with map ; + [ linear-case-quot ] with map ; : hash-dispatch-quot ( table -- quot ) [ length 1- [ fixnum-bitand ] curry ] keep [ dispatch ] curry append ; -: hash-case>quot ( default assoc -- quot ) +: hash-case-quot ( default assoc -- quot ) + hash-case-table hash-dispatch-quot + [ dup hashcode >fixnum ] swap append ; + +: contiguous-range? ( keys -- from to ? ) + dup [ fixnum? ] all? [ + dup all-unique? [ + dup infimum over supremum + [ - swap prune length + 1 = ] 2keep rot + ] [ + drop f f f + ] if + ] [ + drop f f f + ] if ; + +: dispatch-case ( value from to default array -- ) + >r >r 3dup between? [ + drop - >fixnum r> drop r> dispatch + ] [ + 2drop r> call r> drop + ] if ; inline + +: dispatch-case-quot ( default assoc from to -- quot ) + -roll -roll sort-keys values [ >quotation ] map + [ dispatch-case ] 2curry 2curry ; + +: case>quot ( default assoc -- quot ) dup empty? [ drop ] [ dup length 4 <= [ - case>quot + linear-case-quot ] [ - hash-case-table hash-dispatch-quot - [ dup hashcode >fixnum ] swap append + dup keys contiguous-range? [ + dispatch-case-quot + ] [ + 2drop hash-case-quot + ] if ] if ] if ; diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor index b24928a71e..8c935db859 100755 --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel kernel.private slots.private math assocs -math.private sequences sequences.private vectors -combinators ; +math.private sequences sequences.private vectors ; IN: hashtables ; diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index 7faeefc3d6..240f39218b 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -35,7 +35,7 @@ IN: inference.transforms dup peek swap 1 head* ] [ [ no-case ] swap - ] if hash-case>quot + ] if case>quot ] if ] 1 define-transform