From bea4d80a33fb213692fbfe61add0046d862891d7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 3 Dec 2008 10:11:02 -0600
Subject: [PATCH] Add specialization hints from old float-arrays. These will be
 replaced with a better facility soon

---
 basis/specialized-arrays/double/double.factor | 68 ++++++++++++++++++-
 1 file changed, 67 insertions(+), 1 deletion(-)

diff --git a/basis/specialized-arrays/double/double.factor b/basis/specialized-arrays/double/double.factor
index b7fc3a8143..0501458532 100644
--- a/basis/specialized-arrays/double/double.factor
+++ b/basis/specialized-arrays/double/double.factor
@@ -1,4 +1,70 @@
 USE: specialized-arrays.functor
 IN: specialized-arrays.double
 
-<< "double" define-array >>
\ No newline at end of file
+<< "double" define-array >>
+
+! Specializer hints. These should really be generalized, and placed
+! somewhere else
+USING: hints math.vectors arrays kernel math accessors sequences ;
+
+HINTS: <double-array> { 2 } { 3 } ;
+
+HINTS: vneg { array } { double-array } ;
+HINTS: v*n { array object } { double-array float } ;
+HINTS: n*v { array object } { float double-array } ;
+HINTS: v/n { array object } { double-array float } ;
+HINTS: n/v { object array } { float double-array } ;
+HINTS: v+ { array array } { double-array double-array } ;
+HINTS: v- { array array } { double-array double-array } ;
+HINTS: v* { array array } { double-array double-array } ;
+HINTS: v/ { array array } { double-array double-array } ;
+HINTS: vmax { array array } { double-array double-array } ;
+HINTS: vmin { array array } { double-array double-array } ;
+HINTS: v. { array array } { double-array double-array } ;
+HINTS: norm-sq { array } { double-array } ;
+HINTS: norm { array } { double-array } ;
+HINTS: normalize { array } { double-array } ;
+HINTS: distance { array array } { double-array double-array } ;
+
+! Type functions
+USING: words classes.algebra compiler.tree.propagation.info
+math.intervals ;
+
+{ v+ v- v* v/ vmax vmin } [
+    [
+        [ class>> double-array class<= ] both?
+        double-array object ? <class-info>
+    ] "outputs" set-word-prop
+] each
+
+{ n*v n/v } [
+    [
+        nip class>> double-array class<= double-array object ? <class-info>
+    ] "outputs" set-word-prop
+] each
+
+{ v*n v/n } [
+    [
+        drop class>> double-array class<= double-array object ? <class-info>
+    ] "outputs" set-word-prop
+] each
+
+{ vneg normalize } [
+    [
+        class>> double-array class<= double-array object ? <class-info>
+    ] "outputs" set-word-prop
+] each
+
+\ norm-sq [
+    class>> double-array class<= [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
+] "outputs" set-word-prop
+
+\ v. [
+    [ class>> double-array class<= ] both?
+    float object ? <class-info>
+] "outputs" set-word-prop
+
+\ distance [
+    [ class>> double-array class<= ] both?
+    [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
+] "outputs" set-word-prop