remove call to sort from cross-referencer

TODO.FACTOR.txt

@@ -1,6 +1,8 @@
 - reader syntax for arrays, byte arrays, displaced aliens
 - sleep word
 - docstrings appear twice
+- fix infer hang
+- fix sort out of bounds
 
 + ui:
 

library/bootstrap/image.factor

@@ -156,7 +156,7 @@ M: f ' ( obj -- ptr )
 
 : transfer-word ( word -- word )
     #! This is a hack. See doc/bootstrap.txt.
-    dup dup word-name swap word-vocabulary unit search
+    dup dup word-name swap word-vocabulary lookup
     [ ] [ dup "Missing DEFER: " word-error ] ?ifte ;
 
 : pooled-object ( object -- ptr ) objects get hash ;

library/bootstrap/primitives.factor

@@ -198,7 +198,7 @@ vocabularies get [ "syntax" set [ reveal ] each ] bind
 } dup length 3 swap [ + ] map-with [ make-primitive ] 2each
 
 : set-stack-effect ( { vocab word effect } -- )
-    3unseq >r unit search r> "stack-effect" set-word-prop ;
+    3unseq >r lookup r> "stack-effect" set-word-prop ;
 
 {
     { "drop" "kernel" " x -- " }

library/collections/sequence-sort.factor

@@ -1,5 +1,5 @@
 IN: sorting-internals
-USING: kernel math sequences ;
+USING: kernel math sequences vectors ;
 
 TUPLE: sorter seq start end mid ;
 
@@ -7,15 +7,15 @@ C: sorter ( seq start end -- sorter )
     [ >r 1 + rot <slice> r> set-sorter-seq ] keep
     dup sorter-seq midpoint over set-sorter-mid
     dup sorter-seq length 1 - over set-sorter-end
-    0 over set-sorter-start ;
+    0 over set-sorter-start ; inline
 
-: s*/e* dup sorter-start swap sorter-end ;
+: s*/e* dup sorter-start swap sorter-end ; inline
-: s*/e dup sorter-start swap sorter-seq length 1 - ;
+: s*/e dup sorter-start swap sorter-seq length 1 - ; inline
-: s/e* 0 swap sorter-end ;
+: s/e* 0 swap sorter-end ; inline
-: sorter-exchange dup s*/e* rot sorter-seq exchange ;
+: sorter-exchange dup s*/e* rot sorter-seq exchange ; inline
 : compare over sorter-seq nth swap sorter-mid rot call ; inline
-: >start> dup sorter-start 1 + swap set-sorter-start ;
+: >start> dup sorter-start 1 + swap set-sorter-start ; inline
-: <end< dup sorter-end 1 - swap set-sorter-end ;
+: <end< dup sorter-end 1 - swap set-sorter-end ; inline
 
 : sort-up ( quot sorter -- quot sorter )
     dup s*/e < [
@@ -47,18 +47,18 @@ DEFER: (nsort)
         2drop
     ] ifte 2drop ; inline
 
-: partition ( seq -1/1 -- seq )
+: partition ( -1/1 seq -- seq )
-    >r dup midpoint@ swap r> 1 <
+    dup midpoint@ swap rot 1 <
     [ head-slice ] [ tail-slice ] ifte ; inline
 
 : (binsearch) ( elt quot seq -- i )
     dup length 1 <= [
         2nip slice-from
     ] [
-        3dup midpoint swap call dup 0 = [
+        3dup >r >r >r midpoint swap call dup 0 = [
-            drop 2nip dup slice-from swap slice-to + 2 /i
+            r> r> 3drop r> dup slice-from swap slice-to + 2 /i
         ] [
-            partition (binsearch)
+            r> swap r> swap r> partition (binsearch)
         ] ifte
     ] ifte ; inline
 

library/generic/generic.factor

@@ -85,7 +85,7 @@ SYMBOL: builtin
     global [
         [
             dup word? [
-                dup word-name swap word-vocabulary vocab hash
+                dup word-name swap word-vocabulary lookup
             ] when
         ] map
     ] bind ;

library/httpd/browser-responder.factor

@@ -53,14 +53,9 @@ USING: html cont-responder kernel io namespaces words lists prettyprint
     swap words [ word-name over swap option ] each drop
   </select> ;
 
-: find-word ( vocab string -- word )
-  #! Given the name of a word, find it in the given vocab. Return the
-  #! word object itself if successfull, otherwise return false.
-  swap unit search ;
-
 : word-source ( vocab word -- )
   #! Write the source for the given word from the vocab as HTML.
-  find-word [
+  swap lookup [
     [ see ] with-simple-html-output
   ] when* ;
 

library/syntax/prettyprint.factor

@@ -61,7 +61,7 @@ C: section ( length -- section )
     last-newline set
     line-count inc
     line-limit? [ " ..." write end-printing get call ] when
-    terpri do-indent ;
+    "\n" write do-indent ;
 
 TUPLE: text string style ;
 
@@ -321,9 +321,10 @@ M: wrapper pprint* ( wrapper -- )
 
 : unparse-short ( object -- str ) [ pprint-short ] string-out ;
 
-: [.] ( sequence -- )
+: unparse-short ( object -- )
-    #! Unparse each element on its own line.
+    dup unparse-short swap write-object terpri ;
-    [ dup unparse-short swap write-object terpri ] each ;
+
+: [.] ( sequence -- ) [ unparse-short. ] each ;
 
 : stack. reverse-slice [.] ;
 

library/test/redefine.factor

@@ -1,5 +1,5 @@
 IN: temporary
-USING: compiler inference math generic ;
+USING: compiler inference math generic parser ;
 
 USE: test
 
@@ -9,3 +9,7 @@ USE: test
 
 [ 1 2 3 1 2 3 ] [ bar ] unit-test
 [ [ [ ] [ object object object ] ] ] [ [ foo ] infer ] unit-test
+
+[ ] [
+    "IN: temporary : foo ; : bar foo ; : baz foo ; : foo ;" eval
+] unit-test

library/test/sequences.factor

@@ -118,6 +118,14 @@ unit-test
 
 [ 3 ] [ { 1 2 3 4 } midpoint ] unit-test
 
+[ -1 ] [ 3 { } [ - ] binsearch ] unit-test
+[ 0 ] [ 3 { 3 } [ - ] binsearch ] unit-test
+[ 1 ] [ 2 { 1 2 3 } [ - ] binsearch ] unit-test
+[ 3 ] [ 4 { 1 2 3 4 5 6 } [ - ] binsearch ] unit-test
+[ 1 ] [ 3.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
+[ 3 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
+[ 10 ] [ 10 20 >vector [ - ] binsearch ] unit-test
+
 : seq-sorter 0 over length 1 - <sorter> ;
 
 [ { 4 2 3 1 } ]
@@ -156,16 +164,8 @@ unit-test
     map-pairs [ 0 <= ] all? ;
 
 [ t ] [
-    10 [
+    100 [
         drop
         1000 [ drop 0 1000 random-int ] map [ - ] sort [ - ] sorted?
     ] all?
 ] unit-test
-
-[ -1 ] [ 3 { } [ - ] binsearch ] unit-test
-[ 0 ] [ 3 { 3 } [ - ] binsearch ] unit-test
-[ 1 ] [ 2 { 1 2 3 } [ - ] binsearch ] unit-test
-[ 3 ] [ 4 { 1 2 3 4 5 6 } [ - ] binsearch ] unit-test
-[ 1 ] [ 3.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
-[ 3 ] [ 5.5 { 1 2 3 4 5 6 7 8 } [ - ] binsearch ] unit-test
-[ 10 ] [ 10 20 >vector [ - ] binsearch ] unit-test

library/tools/walker.factor

@@ -10,12 +10,13 @@ sequences io strings vectors words ;
 
 : &s
     #! Print stepper data stack.
-    meta-d get reverse [.] ;
+    meta-d get stack. ;
 
 : &r
     #! Print stepper call stack, as well as the currently
     #! executing quotation.
-    meta-cf get . meta-executing get . meta-r get reverse [.] ;
+    meta-cf get unparse-short.
+    meta-executing get . meta-r get stack. ;
 
 : &get ( var -- value )
     #! Get stepper variable value.

library/vocabularies.factor

@@ -41,8 +41,10 @@ SYMBOL: vocabularies
     global [ <namespace> crossref set ] bind
     [ add-crossref ] each-word ;
 
+: lookup ( name vocab -- word ) vocab ?hash ;
+
 : search ( name vocabs -- word )
-    [ vocab ?hash ] map-with [ ] find nip ;
+    [ lookup ] map-with [ ] find nip ;
 
 : <props> ( name vocab -- plist )
     [ "vocabulary" set "name" set ] make-hash ;
@@ -65,7 +67,7 @@ SYMBOL: vocabularies
     #! Create a new word in a vocabulary. If the vocabulary
     #! already contains the word, the existing instance is
     #! returned.
-    2dup check-create 2dup vocab ?hash
+    2dup check-create 2dup lookup
     [ nip ] [ (create) dup reveal ] ?ifte ;
 
 : constructor-word ( string vocab -- word )

library/words.factor

@@ -69,17 +69,17 @@ SYMBOL: crossref
 : usages ( word -- deps )
     #! List all usages of a word. This is a transitive closure,
     #! so indirect usages are reported.
-    crossref get dup [ closure word-sort ] [ 2drop { } ] ifte ;
+    crossref get dup [ closure ] [ 2drop { } ] ifte ;
 
 : usage ( word -- list )
     #! List all direct usages of a word.
-    crossref get ?hash dup [ hash-keys ] when word-sort ;
+    crossref get ?hash dup [ hash-keys ] when ;
 
 GENERIC: (uncrossref) ( word -- )
 M: word (uncrossref) drop ;
 
 : uncrossref ( word -- )
-    dup (uncrossref) usages  [ (uncrossref) ] each ;
+    dup (uncrossref) usages [ (uncrossref) ] each ;
 
 ! The word primitive combined with the word def specify what the
 ! word does when invoked.