Support declaring intervals as well as classes for the optimizing compiler

A `{ class } declare` call will now also refine the value info if the `class`
word has a valid interval in the "declared-interval" property.

This allows certain optimizations during value propagation passes in the
frontend compiler.

For easier usage, a new vocabulary `math.intervals.predicates` is supplied.

Union and intersection classes are also considered when determining the interval.

The compiler makes use of this in `compile.tree.propagation.info` in
`class-interval`.

This also ensures that whenever the frontend determines that a value has a class
with interval declaration, the interval slot of the value-info is initialized
correctly.

diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor
index 3f9e35ed63f7c55d0b87cb1ac9466778eae7c65d..e0b1ed67750b546891ed9685c505024409007ff4 100644 (file)
--- a/basis/compiler/tree/propagation/info/info.factor
+++ b/basis/compiler/tree/propagation/info/info.factor
@@ -2,6 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs byte-arrays classes
 classes.algebra classes.singleton classes.tuple
+classes.intersection classes.union
 classes.tuple.private combinators combinators.short-circuit
 compiler.tree.propagation.copy compiler.utilities kernel layouts math
 math.intervals namespaces sequences sequences.private strings
@@ -103,12 +104,31 @@ UNION: fixed-length array byte-array string ;
         [ drop 1/0. ]
     } case ;
 
-: class-interval ( class -- i )
+! : maybe-declared-interval ( classoid -- int )
+!     dup word?
+!     [ "declared-interval" word-prop full-interval or ]
+!     [ drop full-interval ] if ;
+
+GENERIC: declared-class-interval ( classoid -- int/f )
+M: object declared-class-interval drop full-interval ;
+M: class declared-class-interval "declared-interval" word-prop full-interval or ;
+M: union-class declared-class-interval
+    class-members [ empty-interval ]
+    [
+        [ declared-class-interval ] [ interval-union ] map-reduce
+    ] if-empty ;
+M: intersection-class declared-class-interval
+    class-participants [ full-interval ]
+    [
+        [ declared-class-interval ] [ interval-intersect ] map-reduce
+    ] if-empty ;
+
+: class-interval ( classoid -- i )
     {
         { fixnum [ fixnum-interval ] }
         { array-capacity [ array-capacity-interval ] }
         { integer-array-capacity [ array-capacity-interval ] }
-        [ drop full-interval ]
+        [ declared-class-interval ]
     } case ;
 
 : fix-capacity-class ( class -- class' )

diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor
index 6a082ca31a09610ea0b7f4c49d57aa7444d5cb3d..60979d5d8de9a4165fdde7e70fd463822c6515ac 100644 (file)
--- a/basis/compiler/tree/propagation/simple/simple.factor
+++ b/basis/compiler/tree/propagation/simple/simple.factor
@@ -22,6 +22,7 @@ M: #push propagate-before
 : set-value-infos ( infos values -- )
     [ set-value-info ] 2each ;
 
+
 M: #declare propagate-before
     ! We need to force the caller word to recompile when the
     ! classes mentioned in the declaration are redefined, since

diff --git a/basis/math/intervals/predicates/predicates-docs.factor b/basis/math/intervals/predicates/predicates-docs.factor
new file mode 100644 (file)
index 0000000..2fc4506
--- /dev/null
+++ b/basis/math/intervals/predicates/predicates-docs.factor
@@ -0,0 +1,32 @@
+USING: classes compiler.units help.markup help.syntax math math.intervals ;
+IN: math.intervals.predicates
+
+HELP: INTERVAL-PREDICATE:
+{ $syntax "INTERVAL-PREDICATE: class < superclass interval... ;" }
+{ $values
+  { "class" "a new class word to define" }
+  { "superclass" "an existing superclass, which should be derived from " { $link real } "." }
+  { "interval" "code that must result in a valid " { $link interval }
+    ", i.e. have the stack effect " { $snippet "( -- int )" } }
+}
+{ $description
+  "Defines a predicate class deriving from " { $snippet "superclass" } ", with the predicate being a test if an object is an instance of the predicate's superclass as well as if is contained in the specified interval."
+}
+
+{ $examples
+  { $code "USING: math.intervals math.interval-predicates ;" "INTERVAL-PREDICATE: positive < integer 0 (a,inf] ;" }
+}
+{ $notes
+    "In addition to defining a predicate for the class, this also sets the word property " { $snippet "\"declared-interval\"" }
+    ", which allows the optimizing compiler to make additional assumptions about the numerical range of a number which has been declared a type of the defined class."
+}
+{ $see-also "predicates" "math-intervals" "word-props" }
+;
+
+HELP: define-interval-predicate-class
+{ $values { "class" class } { "superclass" class } { "interval" interval } }
+{ $description "Defines an interval predicate class.  This is the run time equivalent of " { $link POSTPONE: INTERVAL-PREDICATE: } }
+{ $notes "This word must be called from inside " { $link with-compilation-unit } "." }
+{ $side-effects "class" } ;
+
+{ define-interval-predicate-class POSTPONE: INTERVAL-PREDICATE: } related-words

diff --git a/basis/math/intervals/predicates/predicates-tests.factor b/basis/math/intervals/predicates/predicates-tests.factor
new file mode 100644 (file)
index 0000000..229324a
--- /dev/null
+++ b/basis/math/intervals/predicates/predicates-tests.factor
@@ -0,0 +1,37 @@
+USING: arrays compiler.units math math.intervals.predicates
+math.intervals.predicates.private math.intervals sequences tools.test words ;
+
+IN: math.intervals.predicates.tests
+
+{ t } [
+    -42 666 [a,b]
+    empty-interval
+    full-interval
+    [-inf,inf] 4array
+    [ valid-interval? ] all?
+] unit-test
+
+{ f } [ "foo" valid-interval? ] unit-test
+
+{ T{ interval { from { 0 t } } { to { 5 t } } } } [
+    [ 0 5 [a,b] ] evaluate-interval
+] unit-test
+
+[ [ 1 2 3 ] evaluate-interval ] [ invalid-interval-definition? ] must-fail-with
+[ [ 0 [-inf,inf] ] evaluate-interval ] [ invalid-interval-definition? ] must-fail-with
+
+
+SYMBOL: test-class
+
+{ T{ interval { from { 0 f } } { to { 5 f } } } } [ [
+        test-class fixnum 0 5 (a,b) define-interval-predicate-class
+    ] with-compilation-unit
+        test-class "declared-interval" word-prop
+] unit-test
+
+INTERVAL-PREDICATE: test-natural < fixnum 0 [a,inf] ;
+
+{ t } [ 0 test-natural? ] unit-test
+{ f } [ -1 test-natural? ] unit-test
+{ t } [ 5 test-natural? ] unit-test
+{ f } [ 5.1 test-natural? ] unit-test

diff --git a/basis/math/intervals/predicates/predicates.factor b/basis/math/intervals/predicates/predicates.factor
new file mode 100644 (file)
index 0000000..37bb92e
--- /dev/null
+++ b/basis/math/intervals/predicates/predicates.factor
@@ -0,0 +1,27 @@
+USING: classes.parser classes.predicate combinators.short-circuit continuations
+kernel lexer math.intervals parser sequences words ;
+IN: math.intervals.predicates
+
+ERROR: invalid-interval-definition stack ;
+
+<PRIVATE
+PREDICATE: empty-interval-class < word empty-interval eq? ;
+UNION: valid-interval interval full-interval empty-interval-class ;
+
+: evaluate-interval ( quot -- interval )
+    { } swap with-datastack
+    dup { [ length 1 = ] [ first valid-interval? ] } 1&&
+    [ first ]
+    [ invalid-interval-definition ] if ;
+
+: interval>predicate ( interval -- quot )
+    [ interval-contains? ] curry ;
+PRIVATE>
+
+: define-interval-predicate-class ( class superclass interval -- )
+    [ interval>predicate define-predicate-class ]
+    [ nip "declared-interval" set-word-prop ] 3bi ;
+
+SYNTAX: INTERVAL-PREDICATE:
+    scan-new-class "<" expect scan-class parse-definition
+    evaluate-interval define-interval-predicate-class ;

diff --git a/basis/math/intervals/predicates/summary.txt b/basis/math/intervals/predicates/summary.txt
new file mode 100644 (file)
index 0000000..44ec0e6
--- /dev/null
+++ b/basis/math/intervals/predicates/summary.txt
@@ -0,0 +1 @@
+Predicate classes with numeric interval checking

diff --git a/core/classes/classes.factor b/core/classes/classes.factor
index 8401a654a190f4aae601ac3b58dc18412db18de2..87cedb17c3e9123510b9f4d3c7f185ae5c174032 100644 (file)
--- a/core/classes/classes.factor
+++ b/core/classes/classes.factor
@@ -60,6 +60,7 @@ M: class reset-class
         "members"
         "participants"
         "predicate"
+        "declared-interval"
     } remove-word-props ;
 
 M: word reset-class drop ;