diff --git a/CHANGES.html b/CHANGES.html index 46567205c2..23b73760e5 100644 --- a/CHANGES.html +++ b/CHANGES.html @@ -12,6 +12,9 @@
  • Optimizing out conditionals where the test value is a constant.
  • Optimizing out type checks that are always/never satisfied.
  • Inlining method bodies when generic words are called on values with known compile-time types.
  • +
  • Side-effect-free words that output immutable values are evaluated at compile time if all their inputs are literal. You can declare a word as having this condition by suffixing the definition with foldable, eg: +
    : cube dup dup * * ; foldable
  • +
  • Various arithmetic identities such as 1 * are optimized out.
  • diff --git a/library/collections/virtual-sequences.factor b/library/collections/virtual-sequences.factor index 6f7ce9bd0c..76aab05cc9 100644 --- a/library/collections/virtual-sequences.factor +++ b/library/collections/virtual-sequences.factor @@ -26,7 +26,12 @@ M: reversed thaw ( seq -- seq ) delegate reverse ; ! A slice of another sequence. TUPLE: slice seq from to step ; +: collapse-slice ( from to slice -- from to seq ) + dup slice-from swap slice-seq >r tuck + >r + r> r> ; + C: slice ( from to seq -- seq ) + #! A slice of a slice collapses. + >r dup slice? [ collapse-slice ] when r> [ set-slice-seq ] keep >r 2dup > -1 1 ? r> [ set-slice-step ] keep diff --git a/library/compiler/intrinsics.factor b/library/compiler/intrinsics.factor index 658bb83e29..b73149e6fb 100644 --- a/library/compiler/intrinsics.factor +++ b/library/compiler/intrinsics.factor @@ -54,28 +54,28 @@ sequences vectors words ; out-1 ] "intrinsic" set-word-prop -: value-types drop f ; +: node-peek ( node -- value ) node-in-d peek ; -: node-peek ( node -- obj ) node-in-d peek ; +: value-tag ( value node -- n/f ) + #! If the tag is known, output it, otherwise f. + node-classes hash dup [ + types [ type-tag ] map dup [ = ] every? + [ first ] [ drop f ] ifte + ] [ + drop f + ] ifte ; -: peek-2 dup length 2 - swap nth ; -: node-peek-2 ( node -- obj ) node-in-d peek-2 ; - -: typed? ( value -- ? ) value-types length 1 = ; - -: slot@ ( node -- n ) +: slot@ ( node -- n/f ) #! Compute slot offset. - node-in-d - dup peek literal-value cell * - swap peek-2 value-types car type-tag - ; - -: typed-literal? ( node -- ? ) - #! Output if the node's first input is well-typed, and the - #! second is a literal. - dup node-peek literal? swap node-peek-2 typed? and ; + dup node-in-d reverse dup first dup literal? [ + literal-value cell * swap second + rot value-tag dup [ - ] [ 2drop f ] ifte + ] [ + 3drop f + ] ifte ; \ slot [ - dup typed-literal? [ + dup slot@ [ 1 %dec-d , in-1 0 swap slot@ %fast-slot , @@ -89,20 +89,19 @@ sequences vectors words ; ] "intrinsic" set-word-prop \ set-slot [ - dup typed-literal? [ + dup slot@ [ 1 %dec-d , in-2 2 %dec-d , slot@ >r 0 1 r> %fast-set-slot , - 0 %write-barrier , ] [ drop in-3 3 %dec-d , 1 %untag , 0 1 2 %set-slot , - 1 %write-barrier , ] ifte + 1 %write-barrier , ] "intrinsic" set-word-prop \ type [ diff --git a/library/generic/generic.factor b/library/generic/generic.factor index 17d94d46d8..ce2e0256ac 100644 --- a/library/generic/generic.factor +++ b/library/generic/generic.factor @@ -36,6 +36,8 @@ SYMBOL: null #! Test if class1 is a subclass of class2. { { [ 2dup eq? ] [ 2drop t ] } + { [ over types empty? ] [ 2drop t ] } + { [ dup types empty? ] [ 2drop f ] } { [ dup custom-class< ] [ dup custom-class< call ] } { [ t ] [ 2types contained? ] } } cond ; diff --git a/library/generic/predicate.factor b/library/generic/predicate.factor index bc242b65d3..4acf916c17 100644 --- a/library/generic/predicate.factor +++ b/library/generic/predicate.factor @@ -31,7 +31,7 @@ predicate [ over metaclass over metaclass eq? [ >r "superclass" word-prop r> class< ] [ - drop types empty? + 2drop f ] ifte ] "class<" set-word-prop diff --git a/library/test/compiler/intrinsics.factor b/library/test/compiler/intrinsics.factor index 07e708dc63..6896328cd6 100644 --- a/library/test/compiler/intrinsics.factor +++ b/library/test/compiler/intrinsics.factor @@ -12,6 +12,9 @@ math-internals test words ; [ 3 ] [ 3 1 2 [ cons [ 1 set-slot ] keep ] compile-1 cdr ] unit-test [ 3 ] [ [ 3 1 2 cons [ 1 set-slot ] keep ] compile-1 cdr ] unit-test +! Write barrier hits on the wrong value were causing segfaults +[ -3 ] [ -3 1 2 [ cons [ 1 set-slot ] keep ] compile-1 cdr ] unit-test + [ ] [ 1 [ drop ] compile-1 ] unit-test [ ] [ [ 1 drop ] compile-1 ] unit-test [ ] [ [ 1 2 2drop ] compile-1 ] unit-test diff --git a/library/test/sequences.factor b/library/test/sequences.factor index a28fd0657c..70f7b361c5 100644 --- a/library/test/sequences.factor +++ b/library/test/sequences.factor @@ -8,8 +8,8 @@ USING: kernel lists math sequences strings test vectors ; [ { 2 3 } ] [ 1 3 { 1 2 3 4 } >vector ] unit-test [ { 4 5 } ] [ 2 { 1 2 3 4 5 } tail-slice* >vector ] unit-test [ { 1 2 } { 3 4 } ] [ 2 { 1 2 3 4 } cut ] unit-test -[ { 3 4 } ] [ 2 4 1 10 subseq ] unit-test -[ { 3 4 } ] [ 0 2 2 4 1 10 subseq ] unit-test +[ { 3 4 } ] [ 2 4 1 10 subseq >vector ] unit-test +[ { 3 4 } ] [ 0 2 2 4 1 10 subseq >vector ] unit-test [ "cba" ] [ 3 "abcdef" head-slice reverse ] unit-test [ 1 2 3 ] [ 1 2 3 3vector 3unseq ] unit-test diff --git a/library/test/test.factor b/library/test/test.factor index e54e71b3c2..e3e095006d 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -72,7 +72,7 @@ SYMBOL: failures prepare-tests [ test ] subset terpri passed. failed. ; : tests - [ + { "lists/cons" "lists/lists" "lists/assoc" "lists/namespaces" "lists/queues" "combinators" @@ -91,26 +91,26 @@ SYMBOL: failures "gadgets/gradients" "memory" "redefine" "annotate" "sequences" "binary" "inspector" "kernel" - ] run-tests ; + } run-tests ; : benchmarks - [ + { "benchmark/empty-loop" "benchmark/fac" "benchmark/fib" "benchmark/sort" "benchmark/continuations" "benchmark/ack" "benchmark/hashtables" "benchmark/strings" "benchmark/vectors" "benchmark/prettyprint" "benchmark/image" - ] run-tests ; + } run-tests ; : compiler-tests - [ + { "io/buffer" "compiler/optimizer" "compiler/simple" "compiler/stack" "compiler/ifte" "compiler/generic" "compiler/bail-out" "compiler/linearizer" "compiler/intrinsics" "compiler/identities" - ] run-tests ; + } run-tests ; : all-tests tests compiler-tests benchmarks ;