From 5ca847c3263f93d19af912996db7490188862f7f Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Sat, 29 Nov 2008 15:45:00 +0100
Subject: [PATCH 01/14] Emacs factor mode: cycle between source, tests and docs
 factor files.

---
 misc/factor.el | 49 ++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 48 insertions(+), 1 deletion(-)

diff --git a/misc/factor.el b/misc/factor.el
index 2ffabf7de9..f81b1e8f88 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -36,6 +36,7 @@
 (require 'font-lock)
 (require 'comint)
 (require 'view)
+(require 'ring)
 
 ;;; Customization:
 
@@ -166,6 +167,15 @@ buffer."
   "Face for headlines in help buffers."
   :group 'factor-faces)
 
+
+;;; Compatibility
+(when (not (fboundp 'ring-member))
+  (defun ring-member (ring item)
+    (catch 'found
+      (dotimes (ind (ring-length ring) nil)
+        (when (equal item (ring-ref ring ind))
+          (throw 'found ind))))))
+
 
 ;;; Factor mode font lock:
 
@@ -625,7 +635,43 @@ buffer."
   (factor--with-vocab vocab
     (factor--listener-send-cmd cmd)))
 
-;;;;; Interface: see
+
+;;;;; Buffer cycling and docs
+
+
+(defconst factor--cycle-endings
+  '(".factor" "-tests.factor" "-docs.factor"))
+
+(defconst factor--regex-cycle-endings
+  (format "\\(.*?\\)\\(%s\\)$"
+          (regexp-opt factor--cycle-endings)))
+
+(defconst factor--cycle-endings-ring
+  (let ((ring (make-ring (length factor--cycle-endings))))
+    (dolist (e factor--cycle-endings ring)
+      (ring-insert ring e))))
+
+(defun factor--cycle-next (file)
+  (let* ((match (string-match factor--regex-cycle-endings file))
+         (base (and match (match-string-no-properties 1 file)))
+         (ending (and match (match-string-no-properties 2 file)))
+         (idx (and ending (ring-member factor--cycle-endings-ring ending)))
+         (gfl (lambda (i) (concat base (ring-ref factor--cycle-endings-ring i)))))
+    (if (not idx) file
+      (let ((l (length factor--cycle-endings)) (i 1) next)
+        (while (and (not next) (< i l))
+          (when (file-exists-p (funcall gfl (+ idx i)))
+            (setq next (+ idx i)))
+          (setq i (1+ i)))
+        (funcall gfl (or next idx))))))
+
+(defun factor-visit-other-file (&optional file)
+  "Cycle between code, tests and docs factor files."
+  (interactive)
+  (find-file (factor--cycle-next (or file (buffer-file-name)))))
+
+
+;;;;; Interface: See
 
 (defconst factor--regex-error-marker "^Type :help for debugging")
 (defconst factor--regex-data-stack "^--- Data stack:")
@@ -848,6 +894,7 @@ vocabularies which have been modified on disk."
 (factor--define-key ?s 'factor-see t)
 (factor--define-key ?e 'factor-edit)
 (factor--define-key ?z 'switch-to-factor t)
+(factor--define-key ?o 'factor-visit-other-file)
 (factor--define-key ?c 'comment-region)
 
 (factor--define-auto-indent-key ?\])

From f79041545a34e10d94a9cc5ae7dc337d6daddeaf Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 10:19:23 -0600
Subject: [PATCH 02/14] New distance word in math.vectors, replaces distance in
 math.points, more efficient

---
 basis/math/points/points.factor   | 1 -
 basis/math/vectors/vectors.factor | 3 +++
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/basis/math/points/points.factor b/basis/math/points/points.factor
index c8654869e2..107e81d51f 100644
--- a/basis/math/points/points.factor
+++ b/basis/math/points/points.factor
@@ -22,6 +22,5 @@ PRIVATE>
 : rise ( pt2 pt1 -- n ) [ second ] bi@ - ;
 : run ( pt2 pt1 -- n ) [ first ] bi@ - ;
 : slope ( pt pt -- slope ) [ rise ] [ run ] 2bi / ;
-: distance ( point point -- float ) v- norm ;
 : midpoint ( point point -- point ) v+ 2 v/n ;
 : linear-solution ( pt pt -- x ) [ drop first2 ] [ slope ] 2bi / - ;
\ No newline at end of file
diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
index 01a421b4e7..a6967a7218 100644
--- a/basis/math/vectors/vectors.factor
+++ b/basis/math/vectors/vectors.factor
@@ -24,6 +24,8 @@ IN: math.vectors
 : norm ( v -- x ) norm-sq sqrt ;
 : normalize ( u -- v ) dup norm v/n ;
 
+: distance ( u v -- x ) [ - absq ] [ + ] 2map-reduce sqrt ;
+
 : set-axis ( u v axis -- w )
     [ [ zero? 2over ? ] dip swap nth ] map-index 2nip ;
 
@@ -31,6 +33,7 @@ HINTS: vneg { array } ;
 HINTS: norm-sq { array } ;
 HINTS: norm { array } ;
 HINTS: normalize { array } ;
+HINTS: distance { array array } ;
 
 HINTS: n*v { object array } ;
 HINTS: v*n { array object } ;

From 5bc173b9cf294c334bde34ef5d2d055fbd0ad1f0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 10:19:35 -0600
Subject: [PATCH 03/14] Better hints for float array operations

---
 basis/float-arrays/float-arrays.factor | 47 ++++++++++++++------------
 1 file changed, 26 insertions(+), 21 deletions(-)

diff --git a/basis/float-arrays/float-arrays.factor b/basis/float-arrays/float-arrays.factor
index ab3eef62a5..9a71fe27d5 100644
--- a/basis/float-arrays/float-arrays.factor
+++ b/basis/float-arrays/float-arrays.factor
@@ -64,29 +64,29 @@ M: float-array pprint-delims drop \ F{ \ } ;
 M: float-array >pprint-sequence ;
 M: float-array pprint* pprint-object ;
 
-! Rice
+! Specializer hints
 USING: hints math.vectors arrays ;
 
-HINTS: vneg { float-array } { array } ;
-HINTS: v*n { float-array float } { array object } ;
-HINTS: n*v { float float-array } { array object } ;
-HINTS: v/n { float-array float } { array object } ;
-HINTS: n/v { float float-array } { object array } ;
-HINTS: v+ { float-array float-array } { array array } ;
-HINTS: v- { float-array float-array } { array array } ;
-HINTS: v* { float-array float-array } { array array } ;
-HINTS: v/ { float-array float-array } { array array } ;
-HINTS: vmax { float-array float-array } { array array } ;
-HINTS: vmin { float-array float-array } { array array } ;
-HINTS: v. { float-array float-array } { array array } ;
-HINTS: norm-sq { float-array } { array } ;
-HINTS: norm { float-array } { array } ;
-HINTS: normalize { float-array } { array } ;
+HINTS: vneg { array } { float-array } ;
+HINTS: v*n { array object } { float-array float } ;
+HINTS: n*v { array object } { float float-array } ;
+HINTS: v/n { array object } { float-array float } ;
+HINTS: n/v { object array } { float float-array } ;
+HINTS: v+ { array array } { float-array float-array } ;
+HINTS: v- { array array } { float-array float-array } ;
+HINTS: v* { array array } { float-array float-array } ;
+HINTS: v/ { array array } { float-array float-array } ;
+HINTS: vmax { array array } { float-array float-array } ;
+HINTS: vmin { array array } { float-array float-array } ;
+HINTS: v. { array array } { float-array float-array } ;
+HINTS: norm-sq { array } { float-array } ;
+HINTS: norm { array } { float-array } ;
+HINTS: normalize { array } { float-array } ;
+HINTS: distance { array array } { float-array float-array } ;
 
-! More rice. Experimental, currently causes a slowdown in raytracer
-! for some odd reason.
-
-USING: words classes.algebra compiler.tree.propagation.info ;
+! Type functions
+USING: words classes.algebra compiler.tree.propagation.info
+math.intervals ;
 
 { v+ v- v* v/ vmax vmin } [
     [
@@ -114,10 +114,15 @@ USING: words classes.algebra compiler.tree.propagation.info ;
 ] each
 
 \ norm-sq [
-    class>> float-array class<= float object ? <class-info>
+    class>> float-array class<= [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
 ] "outputs" set-word-prop
 
 \ v. [
     [ class>> float-array class<= ] both?
     float object ? <class-info>
 ] "outputs" set-word-prop
+
+\ distance [
+    [ class>> float-array class<= ] both?
+    [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
+] "outputs" set-word-prop

From cbf392c889b054dbbd3cc8303676e0031b4a4242 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 10:38:27 -0600
Subject: [PATCH 04/14] Use new distance word

---
 basis/ui/gestures/gestures.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor
index ffb9795ef8..5faaa93292 100644
--- a/basis/ui/gestures/gestures.factor
+++ b/basis/ui/gestures/gestures.factor
@@ -205,7 +205,7 @@ SYMBOL: drag-timer
     dup hand-last-button get = ;
 
 : multi-click-position? ( -- ? )
-    hand-loc get hand-click-loc get v- norm-sq 100 <= ;
+    hand-loc get hand-click-loc get distance 10 <= ;
 
 : multi-click? ( button -- ? )
     {

From f6752238732c3d01da1ad4619fe626c4c1f42eeb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 10:38:43 -0600
Subject: [PATCH 05/14] Minor optimization in unclip-slice

---
 core/sequences/sequences.factor | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor
index 832de612dd..118969bd3c 100644
--- a/core/sequences/sequences.factor
+++ b/core/sequences/sequences.factor
@@ -101,14 +101,17 @@ M: integer nth-unsafe drop ;
 
 INSTANCE: integer immutable-sequence
 
+: first-unsafe
+    0 swap nth-unsafe ; inline
+
 : first2-unsafe
-    [ 0 swap nth-unsafe 1 ] [ nth-unsafe ] bi ; inline
+    [ first-unsafe ] [ 1 swap nth-unsafe ] bi ; inline
 
 : first3-unsafe
-    [ first2-unsafe 2 ] [ nth-unsafe ] bi ; inline
+    [ first2-unsafe ] [ 2 swap nth-unsafe ] bi ; inline
 
 : first4-unsafe
-    [ first3-unsafe 3 ] [ nth-unsafe ] bi ; inline
+    [ first3-unsafe ] [ 3 swap nth-unsafe ] bi ; inline
 
 : exchange-unsafe ( m n seq -- )
     [ tuck [ nth-unsafe ] 2bi@ ]
@@ -774,13 +777,13 @@ PRIVATE>
     tuck [ tail-slice ] 2bi@ ;
 
 : unclip ( seq -- rest first )
-    [ rest ] [ first ] bi ;
+    [ rest ] [ first-unsafe ] bi ;
 
 : unclip-last ( seq -- butlast last )
     [ but-last ] [ peek ] bi ;
 
 : unclip-slice ( seq -- rest-slice first )
-    [ rest-slice ] [ first ] bi ; inline
+    [ rest-slice ] [ first-unsafe ] bi ; inline
 
 : 2unclip-slice ( seq1 seq2 -- rest-slice1 rest-slice2 first1 first2 )
     [ unclip-slice ] bi@ swapd ; inline

From ef0ea005da32b16bc919a984580aa269cf499eda Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 10:38:55 -0600
Subject: [PATCH 06/14] New benchmark: nbody from shootout

---
 extra/benchmark/nbody/nbody.factor | 106 +++++++++++++++++++++++++++++
 1 file changed, 106 insertions(+)
 create mode 100644 extra/benchmark/nbody/nbody.factor

diff --git a/extra/benchmark/nbody/nbody.factor b/extra/benchmark/nbody/nbody.factor
new file mode 100644
index 0000000000..e99b81e87b
--- /dev/null
+++ b/extra/benchmark/nbody/nbody.factor
@@ -0,0 +1,106 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors float-arrays fry kernel locals make math
+math.constants math.functions math.vectors prettyprint
+sequences hints arrays ;
+IN: benchmark.nbody
+
+: solar-mass 4 pi sq * ; inline
+: days-per-year 365.24 ; inline
+
+TUPLE: body
+{ location float-array }
+{ velocity float-array }
+{ mass float } ;
+
+: <body> ( -- body ) body new ; inline
+
+: <jupiter> ( -- body )
+    <body>
+        F{ 4.84143144246472090e+00 -1.16032004402742839e+00 -1.03622044471123109e-01 } >>location
+        F{ 1.66007664274403694e-03 7.69901118419740425e-03 -6.90460016972063023e-05 } days-per-year v*n >>velocity
+        9.54791938424326609e-04 solar-mass * >>mass ;
+
+: <saturn> ( -- body )
+    <body>
+        F{ 8.34336671824457987e+00 4.12479856412430479e+00 -4.03523417114321381e-01 } >>location
+        F{ -2.76742510726862411e-03 4.99852801234917238e-03 2.30417297573763929e-05 } days-per-year v*n >>velocity
+        2.85885980666130812e-04 solar-mass * >>mass ;
+
+: <uranus> ( -- body )
+    <body>
+        F{ 1.28943695621391310e+01 -1.51111514016986312e+01 -2.23307578892655734e-01 } >>location
+        F{ 2.96460137564761618e-03 2.37847173959480950e-03 -2.96589568540237556e-05 } days-per-year v*n >>velocity
+        4.36624404335156298e-05 solar-mass * >>mass ;
+
+: <neptune> ( -- body )
+    <body>
+        F{ 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 } >>location
+        F{ 2.68067772490389322e-03 1.62824170038242295e-03 -9.51592254519715870e-05 } days-per-year v*n >>velocity
+        5.15138902046611451e-05 solar-mass * >>mass ;
+
+: <sun> ( -- body )
+    <body>
+        solar-mass >>mass
+        F{ 0 0 0 } >>location
+        F{ 0 0 0 } >>velocity ;
+    
+: offset-momentum ( body offset -- body )
+    vneg solar-mass v/n >>velocity ; inline
+
+TUPLE: nbody-system { bodies array read-only } ;
+
+: init-bodies ( bodies -- )
+    [ first ] [ F{ 0 0 0 } [ [ velocity>> ] [ mass>> ] bi v*n v+ ] reduce ] bi
+    offset-momentum drop ; inline
+
+: <nbody-system> ( -- system )
+    [ <sun> , <jupiter> , <saturn> , <uranus> , <neptune> , ] { } make nbody-system boa
+    dup bodies>> init-bodies ; inline
+
+:: each-pair ( bodies pair-quot: ( other-body body -- ) each-quot: ( body -- ) -- )
+    bodies [| body i |
+        body each-quot call
+        bodies i 1+ tail-slice [
+            body pair-quot call
+        ] each
+    ] each-index ; inline
+
+: update-position ( body dt -- )
+    [ dup velocity>> ] dip '[ _ _ v*n v+ ] change-location drop ;
+
+: mag ( dt body other-body -- mag d )
+    [ location>> ] bi@ v- [ norm-sq dup sqrt * / ] keep ; inline
+
+:: update-velocity ( other-body body dt -- )
+    dt body other-body mag
+    [ [ body ] 2dip '[ other-body mass>> _ * _ n*v v- ] change-velocity drop ]
+    [ [ other-body ] 2dip '[ body mass>> _ * _ n*v v+ ] change-velocity drop ] 2bi ;
+
+: advance ( system dt -- )
+    [ bodies>> ] dip
+    [ '[ _ update-velocity ] [ drop ] each-pair ]
+    [ '[ _ update-position ] each ]
+    2bi ; inline
+
+: inertia ( body -- e )
+    [ mass>> ] [ velocity>> norm-sq ] bi * 0.5 * ;
+
+: newton's-law ( other-body body -- e )
+    [ [ mass>> ] bi@ * ] [ [ location>> ] bi@ distance ] 2bi / ;
+
+: energy ( system -- x )
+    [ 0.0 ] dip bodies>> [ newton's-law - ] [ inertia + ] each-pair ; inline
+
+: nbody ( n -- )
+    <nbody-system>
+    [ energy . ] [ '[ _ 0.01 advance ] times ] [ energy . ] tri ;
+
+HINTS: update-position body float ;
+HINTS: update-velocity body body float ;
+HINTS: inertia body ;
+HINTS: newton's-law body body ;
+HINTS: nbody fixnum ;
+
+: nbody-main ( -- )
+    1000000 nbody ;

From 1f6222ef40796121e2c58e1160c54571ac5f88f4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 10:39:28 -0600
Subject: [PATCH 07/14] Add a main word

---
 extra/benchmark/nbody/nbody.factor | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/extra/benchmark/nbody/nbody.factor b/extra/benchmark/nbody/nbody.factor
index e99b81e87b..601096a6f8 100644
--- a/extra/benchmark/nbody/nbody.factor
+++ b/extra/benchmark/nbody/nbody.factor
@@ -102,5 +102,6 @@ HINTS: inertia body ;
 HINTS: newton's-law body body ;
 HINTS: nbody fixnum ;
 
-: nbody-main ( -- )
-    1000000 nbody ;
+: nbody-main ( -- ) 1000000 nbody ;
+
+MAIN: nbody-main

From 62faf57fd98a2ba5cfaa99f08f04f7a51491c95d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 11:39:57 -0600
Subject: [PATCH 08/14] Clarify docs

---
 basis/delegate/delegate-docs.factor | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/basis/delegate/delegate-docs.factor b/basis/delegate/delegate-docs.factor
index 0d2f94c13d..5a2f4802e9 100644
--- a/basis/delegate/delegate-docs.factor
+++ b/basis/delegate/delegate-docs.factor
@@ -28,21 +28,21 @@ HELP: group-words
 { $values { "group" "a group" } { "words" "an array of words" } }
 { $description "Given a protocol or tuple class, this returns the corresponding generic words that this group contains." } ;
 
-ARTICLE: { "delegate" "intro" } "Delegation"
+ARTICLE: "delegate" "Delegation"
 "The " { $vocab-link "delegate" } " vocabulary implements run-time consultation for method dispatch."
 $nl
-"Fundamental to the concept of " { $emphasis "protocols" } ", which are groups of tuple slot accessors, or groups of arbtirary generic words."
+"A " { $emphasis "protocol" } " is a collection of related generic words. An object is said to " { $emphasis "consult" } " another object if it implements a protocol by forwarding all methods onto the other object."
 $nl
-"This allows an object to implement a certain protocol by passing the method calls to another object."
+"Using this vocabulary, protocols can be defined and consulation can be set up without any repetitive boilerplate."
 $nl
 "Unlike " { $link "tuple-subclassing" } ", which expresses " { $emphasis "is-a" } " relationships by statically including the methods and slots of the superclass in all subclasses, consultation forwards generic word calls to another distinct object."
 $nl
-"Fundamentally, a protocol is a word which has a method for " { $link group-words } ". One type of protocol is a tuple, which consists of the slot accessors. To define a protocol as a set of words, use"
+"Defining new protocols:"
 { $subsection POSTPONE: PROTOCOL: }
 { $subsection define-protocol }
-"The literal syntax and defining word are:"
+"Defining consultation:"
 { $subsection POSTPONE: CONSULT: }
 { $subsection define-consult }
-"The " { $vocab-link "delegate.protocols" } " vocabulary defines formal protocols for the various informal protocols used in the Factor core, such as " { $link "sequence-protocol" } ", " { $link "assocs-protocol" } " or " { $link "stream-protocol" } ;
+"Every tuple class has an associated protocol consisting of all of its slot accessor methods. The " { $vocab-link "delegate.protocols" } " vocabulary defines formal protocols for the various informal protocols used in the Factor core, such as " { $link "sequence-protocol" } ", " { $link "assocs-protocol" } " or " { $link "stream-protocol" } ;
 
-ABOUT: { "delegate" "intro" }
+ABOUT: "delegate"

From 09c6d97fea83368a821aaccdbdcc4e73f156aa9c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 12:03:56 -0600
Subject: [PATCH 09/14] HINTS: now supports literals; they're tested with eq?

---
 basis/hints/hints-docs.factor |  8 ++++----
 basis/hints/hints.factor      | 21 +++++++++++++++------
 2 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/basis/hints/hints-docs.factor b/basis/hints/hints-docs.factor
index 347cfd3ef4..b8bda22ddc 100644
--- a/basis/hints/hints-docs.factor
+++ b/basis/hints/hints-docs.factor
@@ -1,10 +1,10 @@
 IN: hints
-USING: help.markup help.syntax words quotations sequences ;
+USING: help.markup help.syntax words quotations sequences kernel ;
 
 ARTICLE: "hints" "Compiler specialization hints"
 "Specialization hints help the compiler generate efficient code."
 $nl
-"Specialization hints can help words which call a lot of generic words on the same object - perhaps in a loop - and in most cases, it is anticipated that this object is of a certain class. Using specialization hints, the compiler can be instructed to compile a branch at the beginning of the word; if the branch is taken, the input object has the assumed class, and inlining of generic methods can take place."
+"Specialization hints can help words which call a lot of generic words on the same object - perhaps in a loop - and in most cases, it is anticipated that this object is of a certain class, or even " { $link eq? } " to some literal. Using specialization hints, the compiler can be instructed to compile a branch at the beginning of the word; if the branch is taken, the input object has the assumed class or value, and inlining of generic methods can take place."
 $nl
 "Specialization hints are not declarations; if the inputs do not match what is specified, the word will still run, possibly slower if the compiled code cannot inline methods because of insufficient static type information."
 $nl
@@ -20,10 +20,10 @@ HELP: specialized-def
 { $description "Outputs the definition of a word after it has been split into specialized branches. This is the definition which will actually be compiled by the compiler." } ;
 
 HELP: HINTS:
-{ $values { "defspec" "a definition specifier" } { "hints..." "a list of sequences of classes" } }
+{ $values { "defspec" "a definition specifier" } { "hints..." "a list of sequences of classes or literals" } }
 { $description "Defines specialization hints for a word or a method."
 $nl
-"Each sequence of classes in the list will cause a specialized version of the word to be compiled." }
+"Each sequence in the list will cause a specialized version of the word to be compiled. Classes are tested for using their predicate, and literals are tested using " { $link eq? } "." }
 { $examples "The " { $link append } " word has a specializer for the very common case where two strings or two arrays are appended:"
 { $code "HINTS: append { string string } { array array } ;" }
 "Specializers can also be defined on methods:"
diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor
index 06ca209cae..240acf74b1 100644
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@@ -3,25 +3,34 @@
 USING: parser words definitions kernel sequences assocs arrays
 kernel.private fry combinators accessors vectors strings sbufs
 byte-arrays byte-vectors io.binary io.streams.string splitting
-math generic generic.standard generic.standard.engines ;
+math generic generic.standard generic.standard.engines classes ;
 IN: hints
 
-: (make-specializer) ( class picker -- quot )
-    swap "predicate" word-prop append ;
+GENERIC: specializer-predicate ( spec -- quot )
 
-: make-specializer ( classes -- quot )
+M: class specializer-predicate "predicate" word-prop ;
+
+M: object specializer-predicate '[ _ eq? ] ;
+
+GENERIC: specializer-declaration ( spec -- class )
+
+M: class specializer-declaration ;
+
+M: object specializer-declaration class ;
+
+: make-specializer ( specs -- quot )
     dup length <reversed>
     [ (picker) 2array ] 2map
     [ drop object eq? not ] assoc-filter
     [ [ t ] ] [
-        [ (make-specializer) ] { } assoc>map
+        [ swap specializer-predicate append ] { } assoc>map
         unclip [ swap [ f ] \ if 3array append [ ] like ] reduce
     ] if-empty ;
 
 : specializer-cases ( quot word -- default alist )
     dup [ array? ] all? [ 1array ] unless [
         [ make-specializer ] keep
-        '[ _ declare ] pick append
+        [ specializer-declaration ] map '[ _ declare ] pick append
     ] { } map>assoc ;
 
 : method-declaration ( method -- quot )

From b80e82b17054fbb74b3a64f832794e5e83e36b08 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 12:05:27 -0600
Subject: [PATCH 10/14] Use specializer hints when inlining words

---
 basis/stack-checker/backend/backend.factor   | 4 ++--
 basis/stack-checker/inlining/inlining.factor | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor
index 94e59950f7..8bb19b82f7 100644
--- a/basis/stack-checker/backend/backend.factor
+++ b/basis/stack-checker/backend/backend.factor
@@ -4,7 +4,7 @@ USING: fry arrays generic io io.streams.string kernel math
 namespaces parser prettyprint sequences strings vectors words
 quotations effects classes continuations debugger assocs
 combinators compiler.errors accessors math.order definitions
-sets generic.standard.engines.tuple stack-checker.state
+sets generic.standard.engines.tuple hints stack-checker.state
 stack-checker.visitor stack-checker.errors
 stack-checker.values stack-checker.recursive-state ;
 IN: stack-checker.backend
@@ -125,7 +125,7 @@ M: object apply-object push-literal ;
     ] 2bi ; inline
 
 : infer-word-def ( word -- )
-    [ def>> ] [ add-recursive-state ] bi infer-quot ;
+    [ specialized-def ] [ add-recursive-state ] bi infer-quot ;
 
 : check->r ( -- )
     meta-r get empty? terminated? get or
diff --git a/basis/stack-checker/inlining/inlining.factor b/basis/stack-checker/inlining/inlining.factor
index b6a988652b..df0145b73e 100644
--- a/basis/stack-checker/inlining/inlining.factor
+++ b/basis/stack-checker/inlining/inlining.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry namespaces assocs kernel sequences words accessors
 definitions math math.order effects classes arrays combinators
-vectors arrays
+vectors arrays hints
 stack-checker.state
 stack-checker.errors
 stack-checker.values
@@ -17,7 +17,7 @@ IN: stack-checker.inlining
 ! having to handle recursive inline words.
 
 : infer-inline-word-def ( word label -- )
-    [ drop def>> ] [ add-inline-word ] 2bi infer-quot ;
+    [ drop specialized-def ] [ add-inline-word ] 2bi infer-quot ;
 
 TUPLE: inline-recursive < identity-tuple
 id

From 8672f0d637587d863efb7fa614a0ce67f2d64f2f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 12:05:42 -0600
Subject: [PATCH 11/14] Add fast-path for <float-array> on 2 and 3 arguments

---
 basis/float-arrays/float-arrays.factor | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/basis/float-arrays/float-arrays.factor b/basis/float-arrays/float-arrays.factor
index 9a71fe27d5..4aa9f79414 100644
--- a/basis/float-arrays/float-arrays.factor
+++ b/basis/float-arrays/float-arrays.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private alien.accessors sequences
 sequences.private math math.private byte-arrays accessors
-alien.c-types parser prettyprint.backend ;
+alien.c-types parser prettyprint.backend combinators ;
 IN: float-arrays
 
 TUPLE: float-array
@@ -67,6 +67,8 @@ M: float-array pprint* pprint-object ;
 ! Specializer hints
 USING: hints math.vectors arrays ;
 
+HINTS: <float-array> { 2 } { 3 } ;
+
 HINTS: vneg { array } { float-array } ;
 HINTS: v*n { array object } { float-array float } ;
 HINTS: n*v { array object } { float float-array } ;

From 267ab0aa4d1e1e9561ac42fa3b8684207a204f7b Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 12:21:26 -0600
Subject: [PATCH 12/14] Implement /i on floats

---
 core/math/floats/floats-tests.factor | 2 ++
 core/math/floats/floats.factor       | 1 +
 2 files changed, 3 insertions(+)

diff --git a/core/math/floats/floats-tests.factor b/core/math/floats/floats-tests.factor
index bd3f951b02..dbdd5b27fe 100644
--- a/core/math/floats/floats-tests.factor
+++ b/core/math/floats/floats-tests.factor
@@ -60,3 +60,5 @@ unit-test
 [ 0 ] [ 1/0. >bignum ] unit-test
 
 [ t ] [ 64 [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
+
+[ 5 ] [ 10.5 1.9 /i ] unit-test
diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor
index 9dcff9eb90..2a22dc4330 100644
--- a/core/math/floats/floats.factor
+++ b/core/math/floats/floats.factor
@@ -24,6 +24,7 @@ M: float - float- ;
 M: float * float* ;
 M: float / float/f ;
 M: float /f float/f ;
+M: float /i float/f >integer ;
 M: float mod float-mod ;
 
 M: real abs dup 0 < [ neg ] when ;

From 1ae43cc5e7fe69b115aa3f18bfaa0ebb75e4a633 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 12:42:53 -0600
Subject: [PATCH 13/14] Cleanup

---
 extra/benchmark/nbody/nbody.factor | 42 ++++++++++++++----------------
 1 file changed, 20 insertions(+), 22 deletions(-)

diff --git a/extra/benchmark/nbody/nbody.factor b/extra/benchmark/nbody/nbody.factor
index 601096a6f8..7b20edaadb 100644
--- a/extra/benchmark/nbody/nbody.factor
+++ b/extra/benchmark/nbody/nbody.factor
@@ -11,39 +11,37 @@ IN: benchmark.nbody
 TUPLE: body
 { location float-array }
 { velocity float-array }
-{ mass float } ;
+{ mass float read-only } ;
 
-: <body> ( -- body ) body new ; inline
+: <body> ( location velocity mass -- body )
+    [ days-per-year v*n ] [ solar-mass * ] bi* body boa ; inline
 
 : <jupiter> ( -- body )
-    <body>
-        F{ 4.84143144246472090e+00 -1.16032004402742839e+00 -1.03622044471123109e-01 } >>location
-        F{ 1.66007664274403694e-03 7.69901118419740425e-03 -6.90460016972063023e-05 } days-per-year v*n >>velocity
-        9.54791938424326609e-04 solar-mass * >>mass ;
+    F{ 4.84143144246472090e+00 -1.16032004402742839e+00 -1.03622044471123109e-01 }
+    F{ 1.66007664274403694e-03 7.69901118419740425e-03 -6.90460016972063023e-05 }
+    9.54791938424326609e-04
+    <body> ;
 
 : <saturn> ( -- body )
-    <body>
-        F{ 8.34336671824457987e+00 4.12479856412430479e+00 -4.03523417114321381e-01 } >>location
-        F{ -2.76742510726862411e-03 4.99852801234917238e-03 2.30417297573763929e-05 } days-per-year v*n >>velocity
-        2.85885980666130812e-04 solar-mass * >>mass ;
+    F{ 8.34336671824457987e+00 4.12479856412430479e+00 -4.03523417114321381e-01 }
+    F{ -2.76742510726862411e-03 4.99852801234917238e-03 2.30417297573763929e-05 }
+    2.85885980666130812e-04
+    <body> ;
 
 : <uranus> ( -- body )
-    <body>
-        F{ 1.28943695621391310e+01 -1.51111514016986312e+01 -2.23307578892655734e-01 } >>location
-        F{ 2.96460137564761618e-03 2.37847173959480950e-03 -2.96589568540237556e-05 } days-per-year v*n >>velocity
-        4.36624404335156298e-05 solar-mass * >>mass ;
+    F{ 1.28943695621391310e+01 -1.51111514016986312e+01 -2.23307578892655734e-01 }
+    F{ 2.96460137564761618e-03 2.37847173959480950e-03 -2.96589568540237556e-05 }
+    4.36624404335156298e-05
+    <body> ;
 
 : <neptune> ( -- body )
-    <body>
-        F{ 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 } >>location
-        F{ 2.68067772490389322e-03 1.62824170038242295e-03 -9.51592254519715870e-05 } days-per-year v*n >>velocity
-        5.15138902046611451e-05 solar-mass * >>mass ;
+    F{ 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 }
+    F{ 2.68067772490389322e-03 1.62824170038242295e-03 -9.51592254519715870e-05 }
+    5.15138902046611451e-05
+    <body> ;
 
 : <sun> ( -- body )
-    <body>
-        solar-mass >>mass
-        F{ 0 0 0 } >>location
-        F{ 0 0 0 } >>velocity ;
+    F{ 0 0 0 } F{ 0 0 0 } 1 <body> ;
     
 : offset-momentum ( body offset -- body )
     vneg solar-mass v/n >>velocity ; inline

From 280087f3bad5e8fbc6c21f0e6002aa6cda97f358 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 29 Nov 2008 12:45:25 -0600
Subject: [PATCH 14/14] Fix USING: clash

---
 extra/jamshred/tunnel/tunnel.factor | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor
index 7082acec47..52f2d38dd1 100755
--- a/extra/jamshred/tunnel/tunnel.factor
+++ b/extra/jamshred/tunnel/tunnel.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2007, 2008 Alex Chapman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays colors combinators float-arrays kernel jamshred.oint locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences vectors ;
-USE: tools.walker
+USING: accessors arrays colors combinators float-arrays kernel
+locals math math.constants math.matrices math.order math.ranges
+math.vectors math.quadratic random sequences vectors jamshred.oint ;
 IN: jamshred.tunnel
 
 : n-segments ( -- n ) 5000 ; inline