From aa1651032d0545f86889ed523d40a745da6911ed Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 20 Jan 2010 00:10:49 -0600 Subject: [PATCH 01/12] Adding compiler transforms in propagation --- .../tree/propagation/transforms/transforms.factor | 9 +++++++++ core/math/integers/integers.factor | 5 ++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index ff68fb2400..b0605bfb35 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -300,3 +300,12 @@ CONSTANT: lookup-table-at-max 256 tester '[ _ filter ] ; \ intersect [ intersect-quot ] 1 define-partial-eval + +: fixnum-bits ( -- n ) + cell-bits tag-bits get - ; + +: bit-quot ( #call -- quot/f ) + in-d>> second value-info interval>> 0 fixnum-bits [a,b] interval-subset? + [ [ >fixnum ] dip fixnum-bit? ] f ? ; + +\ bit? [ bit-quot ] "custom-inlining" set-word-prop diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index eb94597160..e87d3a6a0d 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -55,7 +55,10 @@ M: fixnum shift >fixnum fixnum-shift ; inline M: fixnum bitnot fixnum-bitnot ; inline -M: fixnum bit? neg shift 1 bitand 0 > ; inline +: fixnum-bit? ( n m -- b ) + neg shift 1 bitand 0 > ; + +M: fixnum bit? fixnum-bit? ; inline : fixnum-log2 ( x -- n ) 0 swap [ dup 1 eq? ] [ [ 1 + ] [ 2/ ] bi* ] until drop ; From 52f2ac2bb9459162ed76281259b4e5db09903353 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Mon, 25 Jan 2010 20:15:17 -0600 Subject: [PATCH 02/12] Tests for propagation additions; making fixnum-bit? inline --- .../tree/propagation/propagation-tests.factor | 12 +++++++++++- core/math/integers/integers.factor | 2 +- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index ad17ccc1c9..e2bfe58788 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -8,7 +8,7 @@ layouts compiler.tree.propagation.info compiler.tree.def-use compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals specialized-arrays system sorting math.libm math.floats.private math.integers.private -math.intervals quotations effects alien alien.data ; +math.intervals quotations effects alien alien.data sets ; FROM: math => float ; SPECIALIZED-ARRAY: double SPECIALIZED-ARRAY: void* @@ -952,3 +952,13 @@ M: tuple-with-read-only-slot clone ! Reduction [ 1 ] [ [ 4 [ nth-unsafe ] [ ] unless ] final-info length ] unit-test + +! Optimization on bit? +[ t ] [ [ 3 bit? ] { bit? fixnum-bit? } inlined? ] unit-test +[ f ] [ [ 500 bit? ] { bit? fixnum-bit? } inlined? ] unit-test + +[ t ] [ [ { 1 } intersect ] { intersect } inlined? ] unit-test +[ f ] [ [ { 1 } swap intersect ] { intersect } inlined? ] unit-test ! We could do this + +[ t ] [ [ { 1 } diff ] { diff } inlined? ] unit-test +[ f ] [ [ { 1 } swap diff ] { diff } inlined? ] unit-test ! We could do this diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index 9f7543ca13..5f461e22a3 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -59,7 +59,7 @@ M: fixnum shift >fixnum fixnum-shift ; inline M: fixnum bitnot fixnum-bitnot ; inline : fixnum-bit? ( n m -- b ) - neg shift 1 bitand 0 > ; + neg shift 1 bitand 0 > ; inline M: fixnum bit? fixnum-bit? ; inline From 93282bcc94e7916ca5d70276681bd06f2c5a3e23 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 26 Jan 2010 15:11:12 -0600 Subject: [PATCH 03/12] Removing rot/-rot in nsieve and nsieve-bits --- extra/benchmark/nsieve-bits/nsieve-bits.factor | 15 ++++++++------- extra/benchmark/nsieve/nsieve.factor | 11 ++++++----- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/extra/benchmark/nsieve-bits/nsieve-bits.factor b/extra/benchmark/nsieve-bits/nsieve-bits.factor index 9ccc2d8616..8d56bd935b 100644 --- a/extra/benchmark/nsieve-bits/nsieve-bits.factor +++ b/extra/benchmark/nsieve-bits/nsieve-bits.factor @@ -1,5 +1,5 @@ USING: math math.parser sequences sequences.private kernel -bit-arrays make io ; +bit-arrays make io math.ranges multiline fry locals ; IN: benchmark.nsieve-bits : clear-flags ( step i seq -- ) @@ -13,23 +13,24 @@ IN: benchmark.nsieve-bits 2dup length < [ 2dup nth-unsafe [ over dup 2 * pick clear-flags - rot 1 + -rot ! increment count + [ 1 + ] 2dip ! increment count ] when [ 1 + ] dip (nsieve-bits) ] [ 2drop ] if ; inline recursive : nsieve-bits ( m -- count ) - 0 2 rot 1 + dup set-bits (nsieve-bits) ; + [ 0 2 ] dip 1 + dup set-bits (nsieve-bits) ; : nsieve-bits. ( m -- ) [ "Primes up to " % dup # " " % nsieve-bits # ] "" make - print ; + print ; inline : nsieve-bits-main ( n -- ) - dup 2^ 10000 * nsieve-bits. - dup 1 - 2^ 10000 * nsieve-bits. - 2 - 2^ 10000 * nsieve-bits. ; + [ 2^ 10000 * nsieve-bits. ] + [ 1 - 2^ 10000 * nsieve-bits. ] + [ 2 - 2^ 10000 * nsieve-bits. ] + tri ; : nsieve-bits-main* ( -- ) 11 nsieve-bits-main ; diff --git a/extra/benchmark/nsieve/nsieve.factor b/extra/benchmark/nsieve/nsieve.factor index 646c98f3a4..7c4a655e59 100644 --- a/extra/benchmark/nsieve/nsieve.factor +++ b/extra/benchmark/nsieve/nsieve.factor @@ -13,22 +13,23 @@ IN: benchmark.nsieve 2dup length < [ 2dup nth-unsafe [ over dup 2 * pick clear-flags - rot 1 + -rot ! increment count + [ 1 + ] 2dip ! increment count ] when [ 1 + ] dip (nsieve) ] [ 2drop ] if ; inline recursive : nsieve ( m -- count ) - 0 2 rot 1 + t (nsieve) ; + [ 0 2 ] dip 1 + t (nsieve) ; : nsieve. ( m -- ) [ "Primes up to " % dup # " " % nsieve # ] "" make print ; : nsieve-main ( n -- ) - dup 2^ 10000 * nsieve. - dup 1 - 2^ 10000 * nsieve. - 2 - 2^ 10000 * nsieve. ; + [ 2^ 10000 * nsieve. ] + [ 1 - 2^ 10000 * nsieve. ] + [ 2 - 2^ 10000 * nsieve. ] + tri ; : nsieve-main* ( -- ) 9 nsieve-main ; From 54e0221de5fddabf996b4c7fc28c37b15813f551 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 29 Jan 2010 16:30:34 -0800 Subject: [PATCH 04/12] images: extend pixel-at/set-pixel-at with versions that select/replace rows of pixels --- basis/images/images.factor | 27 ++++++++++++++++++++------- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/basis/images/images.factor b/basis/images/images.factor index 625627f337..6cbcdb9508 100644 --- a/basis/images/images.factor +++ b/basis/images/images.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators kernel accessors sequences math arrays ; +USING: combinators kernel locals accessors sequences math arrays ; IN: images SINGLETONS: @@ -128,18 +128,31 @@ TUPLE: image dim component-order component-type upside-down? bitmap ; > first * + ] - [ bytes-per-pixel [ * dup ] keep + ] - [ bitmap>> ] tri ; +:: pixel@ ( x y w image -- start end bitmap ) + image dim>> first y * x + :> start + start w [ image bytes-per-pixel * ] bi@ :> ( start' w' ) + start' start' w' + image bitmap>> ; inline : set-subseq ( new-value from to victim -- ) 0 swap copy ; inline PRIVATE> +: pixel-row-at ( x y w image -- pixels ) + pixel@ subseq ; inline + +: pixel-row-slice-at ( x y w image -- pixels ) + pixel@ ; inline + +: set-pixel-row-at ( pixel x y w image -- ) + pixel@ set-subseq ; inline + : pixel-at ( x y image -- pixel ) - pixel@ subseq ; + [ 1 ] dip pixel-row-at ; inline + +: pixel-slice-at ( x y image -- pixels ) + [ 1 ] dip pixel-row-slice-at ; inline : set-pixel-at ( pixel x y image -- ) - pixel@ set-subseq ; + [ 1 ] dip set-pixel-row-at ; inline + From 52e25f190c9206b1131b3e3dcd52051f5e9f7c8c Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Fri, 29 Jan 2010 16:33:19 -0800 Subject: [PATCH 05/12] images.atlas tool for creating an atlas image from an array of image objects --- extra/images/atlas/atlas.factor | 107 ++++++++++++++++++++++++++++++++ extra/images/atlas/authors.txt | 1 + extra/images/atlas/summary.txt | 1 + 3 files changed, 109 insertions(+) create mode 100644 extra/images/atlas/atlas.factor create mode 100644 extra/images/atlas/authors.txt create mode 100644 extra/images/atlas/summary.txt diff --git a/extra/images/atlas/atlas.factor b/extra/images/atlas/atlas.factor new file mode 100644 index 0000000000..aa0a69c1c2 --- /dev/null +++ b/extra/images/atlas/atlas.factor @@ -0,0 +1,107 @@ +! (c)2010 Joe Groff bsd license +USING: accessors byte-arrays fry images kernel locals math +math.functions math.order math.vectors namespaces sequences +sorting ; +IN: images.atlas + +! sort rects by height/width/whatever +! use least power of two greater than k * greatest width for atlas width +! pack stripes(y 0): +! place first rect at x 0 +! place rects that fit in remaining stripe +! pack stripes(y + height) +! if height > max height + +TUPLE: image-placement + { image read-only } + loc ; + +CONSTANT: atlas-waste-factor 1.25 +CONSTANT: atlas-padding 1 + +ERROR: atlas-image-formats-dont-match images ; + + @x! + f :> stripe-height! + image-placements [| ip | + ip loc>> [ + ip image>> dim>> :> dim + stripe-height [ dim height stripe-height 0 or max stripe-height! ] unless + dim width :> w + atlas-width w @x + >= [ + ip { @x @y } >>loc drop + @x w + @x! + ] when + ] unless + ] each + stripe-height ; + +:: (pack-images) ( images atlas-width sort-quot -- placements ) + images sort-quot inv-sort-with [ f image-placement boa ] map :> image-placements + 0 :> @y! + [ image-placements atlas-width @y (pack-stripe) dup ] [ @y + @y! ] while drop + image-placements ; inline + +: atlas-image-format ( image-placements -- component-order component-type upside-down? ) + [ image>> ] map dup unclip '[ _ + [ [ component-order>> ] bi@ = ] + [ [ component-type>> ] bi@ = ] + [ [ upside-down?>> ] bi@ = ] 2tri and and + ] all? + [ first [ component-order>> ] [ component-type>> ] [ upside-down?>> ] tri ] + [ atlas-image-formats-dont-match ] if ; inline + +: atlas-dim ( image-placements -- dim ) + [ [ loc>> ] [ image>> dim>> ] bi v+ atlas-padding v+n ] [ vmax ] map-reduce + [ next-power-of-2 ] map ; inline + +:: ( image-placements component-order component-type upside-down? -- atlas ) + image-placements atlas-dim :> dim + + dim >>dim + component-order >>component-order + component-type >>component-type + upside-down? >>upside-down? + dim product component-order component-type (bytes-per-pixel) * >>bitmap ; inline + +:: copy-image-into-atlas ( image-placement atlas -- ) + image-placement image>> :> image + image dim>> first2 :> ( w h ) + image-placement loc>> first2 :> ( x y ) + + h iota [| row | + 0 row w image pixel-row-slice-at + x y row + w atlas set-pixel-row-at + ] each ; inline + +: copy-images-into-atlas ( image-placements atlas -- ) + '[ _ copy-image-into-atlas ] each ; inline + +PRIVATE> + +: (guess-atlas-dim) ( images -- width ) + [ dim>> area ] [ + ] map-reduce sqrt + atlas-waste-factor * + .5 + >integer ; + +: guess-atlas-dim ( images -- width ) + [ (guess-atlas-dim) ] [ [ dim>> width ] [ max ] map-reduce ] bi max next-power-of-2 ; + +: pack-images ( images atlas-width -- placements ) + [ dim>> second ] (pack-images) ; + +: pack-atlas ( images -- image-placements ) + dup guess-atlas-dim pack-images ; + +: (make-atlas) ( image-placements -- image ) + dup dup atlas-image-format [ copy-images-into-atlas ] keep ; + +: make-atlas ( images -- image-placements atlas-image ) + pack-atlas dup (make-atlas) ; diff --git a/extra/images/atlas/authors.txt b/extra/images/atlas/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/images/atlas/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/images/atlas/summary.txt b/extra/images/atlas/summary.txt new file mode 100644 index 0000000000..eb1adcd602 --- /dev/null +++ b/extra/images/atlas/summary.txt @@ -0,0 +1 @@ +Tool for generating an atlas image from an array of images From 6eceff6acbce0b35a250514b5178a1583f1d8e90 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 30 Jan 2010 10:58:00 +1300 Subject: [PATCH 06/12] compiler.crossref: cleanup --- basis/compiler/compiler.factor | 2 +- basis/compiler/crossref/crossref.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 0fb9231666..a78c6f729a 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -86,7 +86,7 @@ M: word combinator? inline? ; [ dup crossref? [ [ dependencies get generic-dependencies get compiled-xref ] - [ conditional-dependencies get save-conditional-dependencies ] + [ conditional-dependencies get set-dependency-checks ] bi ] [ drop ] if ] tri ; diff --git a/basis/compiler/crossref/crossref.factor b/basis/compiler/crossref/crossref.factor index 2e30e942d9..99b34d02c5 100644 --- a/basis/compiler/crossref/crossref.factor +++ b/basis/compiler/crossref/crossref.factor @@ -107,5 +107,5 @@ compiled-generic-crossref [ H{ } clone ] initialize [ compiled-generic-crossref get delete-at ] tri ; -: save-conditional-dependencies ( word deps -- ) +: set-dependency-checks ( word deps -- ) keys f like "dependency-checks" set-word-prop ; From e45816cf9b9903501aff12c194c62d5773f8a68c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 30 Jan 2010 21:12:25 +1300 Subject: [PATCH 07/12] math: docs fix --- core/math/math-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 6af48d00de..1e107124a2 100644 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -403,7 +403,7 @@ HELP: number HELP: next-power-of-2 { $values { "m" "a non-negative integer" } { "n" "an integer" } } -{ $description "Outputs the smallest power of 2 greater than " { $snippet "m" } ". The output value is always at least 1." } ; +{ $description "Outputs the smallest power of 2 greater than " { $snippet "m" } ". The output value is always at least 2." } ; HELP: power-of-2? { $values { "n" integer } { "?" "a boolean" } } From 22e3b71ae2564728c62437bff6074a68d2c7f7af Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 30 Jan 2010 21:12:49 +1300 Subject: [PATCH 08/12] grouping: tweak inheritance to make method precedence explicit --- basis/grouping/grouping.factor | 57 ++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 27 deletions(-) diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor index 8364144694..4ee0d0c385 100644 --- a/basis/grouping/grouping.factor +++ b/basis/grouping/grouping.factor @@ -6,35 +6,29 @@ IN: grouping 0 swap copy ; - -M: chunking-seq like drop { } like ; inline +M: chunking set-nth group@ 0 swap copy ; +M: chunking like drop { } like ; inline MIXIN: subseq-chunking - +INSTANCE: subseq-chunking chunking INSTANCE: subseq-chunking sequence M: subseq-chunking nth group@ subseq ; inline MIXIN: slice-chunking - +INSTANCE: slice-chunking chunking INSTANCE: slice-chunking sequence M: slice-chunking nth group@ ; inline - M: slice-chunking nth-unsafe group@ slice boa ; inline -TUPLE: abstract-groups < chunking-seq ; +MIXIN: abstract-groups +INSTANCE: abstract-groups sequence M: abstract-groups length [ seq>> length ] [ n>> ] bi [ + 1 - ] keep /i ; inline @@ -45,7 +39,8 @@ M: abstract-groups set-length M: abstract-groups group@ [ n>> [ * dup ] keep + ] [ seq>> ] bi [ length min ] keep ; inline -TUPLE: abstract-clumps < chunking-seq ; +MIXIN: abstract-clumps +INSTANCE: abstract-clumps sequence M: abstract-clumps length [ seq>> length 1 + ] [ n>> ] bi [-] ; inline @@ -56,36 +51,44 @@ M: abstract-clumps set-length M: abstract-clumps group@ [ n>> over + ] [ seq>> ] bi ; inline +TUPLE: chunking-seq { seq read-only } { n read-only } ; + +: check-groups ( n -- n ) + dup 0 <= [ "Invalid group count" throw ] when ; inline + +: new-groups ( seq n class -- groups ) + [ check-groups ] dip boa ; inline + PRIVATE> -TUPLE: groups < abstract-groups ; +TUPLE: groups < chunking-seq ; +INSTANCE: groups subseq-chunking +INSTANCE: groups abstract-groups : ( seq n -- groups ) groups new-groups ; inline -INSTANCE: groups subseq-chunking - -TUPLE: sliced-groups < abstract-groups ; +TUPLE: sliced-groups < chunking-seq ; +INSTANCE: sliced-groups slice-chunking +INSTANCE: sliced-groups abstract-groups : ( seq n -- groups ) sliced-groups new-groups ; inline -INSTANCE: sliced-groups slice-chunking - -TUPLE: clumps < abstract-clumps ; +TUPLE: clumps < chunking-seq ; +INSTANCE: clumps subseq-chunking +INSTANCE: clumps abstract-clumps : ( seq n -- clumps ) clumps new-groups ; inline -INSTANCE: clumps subseq-chunking - -TUPLE: sliced-clumps < abstract-clumps ; +TUPLE: sliced-clumps < chunking-seq ; +INSTANCE: sliced-clumps slice-chunking +INSTANCE: sliced-clumps abstract-clumps : ( seq n -- clumps ) sliced-clumps new-groups ; inline -INSTANCE: sliced-clumps slice-chunking - : group ( seq n -- array ) { } like ; : clump ( seq n -- array ) { } like ; From 9bc4e662c68baa8059030bcdfd2bcb07b87f9ad3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 30 Jan 2010 22:33:27 +1300 Subject: [PATCH 09/12] compiler.crossref: word props were stored the wrong way round --- basis/compiler/crossref/crossref.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/compiler/crossref/crossref.factor b/basis/compiler/crossref/crossref.factor index 99b34d02c5..d6c000b286 100644 --- a/basis/compiler/crossref/crossref.factor +++ b/basis/compiler/crossref/crossref.factor @@ -55,7 +55,7 @@ compiled-generic-crossref [ H{ } clone ] initialize : store-dependencies ( word assoc -- ) split-dependencies - "effect-dependencies" "definition-dependencies" "conditional-dependencies" + "effect-dependencies" "conditional-dependencies" "definition-dependencies" [ (store-dependencies) ] tri-curry@ tri-curry* tri ; : (compiled-xref) ( word dependencies generic-dependencies -- ) @@ -81,8 +81,8 @@ compiled-generic-crossref [ H{ } clone ] initialize : load-dependencies ( word -- assoc ) [ "effect-dependencies" word-prop ] - [ "definition-dependencies" word-prop ] - [ "conditional-dependencies" word-prop ] tri + [ "conditional-dependencies" word-prop ] + [ "definition-dependencies" word-prop ] tri join-dependencies ; : (compiled-unxref) ( word dependencies variable -- ) @@ -96,8 +96,8 @@ compiled-generic-crossref [ H{ } clone ] initialize [ dup load-dependencies compiled-crossref (compiled-unxref) ] [ dup compiled-generic-uses compiled-generic-crossref (compiled-unxref) ] [ "effect-dependencies" remove-word-prop ] - [ "definition-dependencies" remove-word-prop ] [ "conditional-dependencies" remove-word-prop ] + [ "definition-dependencies" remove-word-prop ] [ "compiled-generic-uses" remove-word-prop ] } cleave ; From 2c63161c842e1a6c842052d3332a1b77a6468410 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 31 Jan 2010 01:55:35 +1300 Subject: [PATCH 10/12] stack-checker.dependencies: make conditional dependencies more robust --- basis/compiler/compiler.factor | 4 ++-- .../dependencies/dependencies.factor | 24 +++++++++++++++---- core/classes/algebra/algebra.factor | 10 ++++---- 3 files changed, 26 insertions(+), 12 deletions(-) diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index a78c6f729a..94b927ca82 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -184,8 +184,8 @@ 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 dup forgotten-class? - [ drop f ] [ _ classes-intersect? ] if + nip dup classoid? + [ _ classes-intersect? ] [ drop f ] if ] assoc-filter keys ; M: optimizing-compiler recompile ( words -- alist ) diff --git a/basis/stack-checker/dependencies/dependencies.factor b/basis/stack-checker/dependencies/dependencies.factor index 6fa2ae4eab..d995354a52 100644 --- a/basis/stack-checker/dependencies/dependencies.factor +++ b/basis/stack-checker/dependencies/dependencies.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs accessors classes.algebra fry generic kernel math -namespaces sequences words sets ; +namespaces sequences words sets combinators.short-circuit ; FROM: classes.tuple.private => tuple-layout ; IN: stack-checker.dependencies @@ -62,7 +62,11 @@ TUPLE: depends-on-class<= class1 class2 ; \ depends-on-class<= add-conditional-dependency ; M: depends-on-class<= satisfied? - [ class1>> ] [ class2>> ] bi class<= ; + { + [ class1>> classoid? ] + [ class2>> classoid? ] + [ [ class1>> ] [ class2>> ] bi class<= ] + } 1&& ; TUPLE: depends-on-classes-disjoint class1 class2 ; @@ -70,7 +74,11 @@ TUPLE: depends-on-classes-disjoint class1 class2 ; \ depends-on-classes-disjoint add-conditional-dependency ; M: depends-on-classes-disjoint satisfied? - [ class1>> ] [ class2>> ] bi classes-intersect? not ; + { + [ class1>> classoid? ] + [ class2>> classoid? ] + [ [ class1>> ] [ class2>> ] bi classes-intersect? not ] + } 1&& ; TUPLE: depends-on-next-method class generic next-method ; @@ -79,7 +87,10 @@ TUPLE: depends-on-next-method class generic next-method ; \ depends-on-next-method add-conditional-dependency ; M: depends-on-next-method satisfied? - [ [ class>> ] [ generic>> ] bi next-method ] [ next-method>> ] bi eq? ; + { + [ class>> classoid? ] + [ [ [ class>> ] [ generic>> ] bi next-method ] [ next-method>> ] bi eq? ] + } 1&& ; TUPLE: depends-on-method class generic method ; @@ -88,7 +99,10 @@ TUPLE: depends-on-method class generic method ; \ depends-on-method add-conditional-dependency ; M: depends-on-method satisfied? - [ [ class>> ] [ generic>> ] bi method-for-class ] [ method>> ] bi eq? ; + { + [ class>> classoid? ] + [ [ [ class>> ] [ generic>> ] bi method-for-class ] [ method>> ] bi eq? ] + } 1&& ; TUPLE: depends-on-tuple-layout class layout ; diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index fe02e6b583..dc9226d20d 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -40,12 +40,12 @@ M: object normalize-class ; PRIVATE> -GENERIC: forgotten-class? ( obj -- ? ) +GENERIC: classoid? ( obj -- ? ) -M: word forgotten-class? "forgotten" word-prop ; -M: anonymous-union forgotten-class? members>> [ forgotten-class? ] any? ; -M: anonymous-intersection forgotten-class? participants>> [ forgotten-class? ] any? ; -M: anonymous-complement forgotten-class? class>> forgotten-class? ; +M: word classoid? class? ; +M: anonymous-union classoid? members>> [ classoid? ] all? ; +M: anonymous-intersection classoid? participants>> [ classoid? ] all? ; +M: anonymous-complement classoid? class>> classoid? ; : class<= ( first second -- ? ) class<=-cache get [ (class<=) ] 2cache ; From a22fadaee44ba2fc34f7cffe4e718cb37c9c3236 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 31 Jan 2010 02:50:47 +1300 Subject: [PATCH 11/12] words: fix unit test --- core/words/words-tests.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 4f30e9a899..46b20bf2e6 100644 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -122,8 +122,10 @@ DEFER: x [ { } ] [ all-words [ - "compiled-uses" word-prop 2 - keys [ "forgotten" word-prop ] filter + [ "effect-dependencies" word-prop ] + [ "definition-dependencies" word-prop ] + [ "conditional-dependencies" word-prop ] tri + 3append [ "forgotten" word-prop ] filter ] map harvest ] unit-test From 03d2b77faad93af84e925300b7a3707c958dc013 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 31 Jan 2010 02:50:55 +1300 Subject: [PATCH 12/12] tools.deploy.shaker: update for new crossref word props --- basis/tools/deploy/shaker/shaker.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index c2db471a23..dfb5b7fa30 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -127,8 +127,10 @@ IN: tools.deploy.shaker "coercer" "combination" "compiled-generic-uses" - "compiled-uses" + "effect-dependencies" + "definition-dependencies" "conditional-dependencies" + "dependency-checks" "constant" "constraints" "custom-inlining"