]> gitweb.factorcode.org Git - factor.git/commitdiff
remove call to sort from cross-referencer
authorSlava Pestov <slava@factorcode.org>
Tue, 23 Aug 2005 00:54:01 +0000 (00:54 +0000)
committerSlava Pestov <slava@factorcode.org>
Tue, 23 Aug 2005 00:54:01 +0000 (00:54 +0000)
12 files changed:
TODO.FACTOR.txt
library/bootstrap/image.factor
library/bootstrap/primitives.factor
library/collections/sequence-sort.factor
library/generic/generic.factor
library/httpd/browser-responder.factor
library/syntax/prettyprint.factor
library/test/redefine.factor
library/test/sequences.factor
library/tools/walker.factor
library/vocabularies.factor
library/words.factor

index 61d3de983f68c1e760512af7caa95342e04f7d2a..2fb590a5a0dd6797946442c02d6a0fd1a97f7a4e 100644 (file)
@@ -1,6 +1,8 @@
 - reader syntax for arrays, byte arrays, displaced aliens\r
 - sleep word\r
 - docstrings appear twice\r
+- fix infer hang\r
+- fix sort out of bounds\r
 \r
 + ui:\r
 \r
index 15cbd7d5d8c6841f73126e35fe2ba45df6c54249..444a7136274bb78bda7c30fcca4c4a24bcbf33ed 100644 (file)
@@ -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 ;
index f6f3f248d518962ad0dbbea6ad9f999164e8dc93..f90a7c37df40a3d4f39ceaf8632709d85905eaf3 100644 (file)
@@ -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 -- " }
index 349cdd386e0534f84f678bcf237d5c5e8099658c..ad8dd71cac754a78ff4c347013cc2bf2ddc9adef 100644 (file)
@@ -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-seq length 1 - ;
-: s/e* 0 swap sorter-end ;
-: sorter-exchange dup s*/e* rot sorter-seq exchange ;
+: s*/e* dup sorter-start swap sorter-end ; inline
+: s*/e dup sorter-start swap sorter-seq length 1 - ; inline
+: s/e* 0 swap sorter-end ; inline
+: 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 ;
-: <end< dup sorter-end 1 - swap set-sorter-end ;
+: >start> dup sorter-start 1 + swap set-sorter-start ; inline
+: <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 )
-    >r dup midpoint@ swap r> 1 <
+: partition ( -1/1 seq -- seq )
+    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 = [
-            drop 2nip dup slice-from swap slice-to + 2 /i
+        3dup >r >r >r midpoint swap call dup 0 = [
+            r> r> 3drop r> dup slice-from swap slice-to + 2 /i
         ] [
-            partition (binsearch)
+            r> swap r> swap r> partition (binsearch)
         ] ifte
     ] ifte ; inline
 
index 2a30de9ba1cff82c04455041de751b18859e4219..eb028bf5a7142292a358ce12f9f91bfdcf26243d 100644 (file)
@@ -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 ;
index bc3ab751fff5bb64df8c8b2fbc55cc82c4905243..7ed69bd555e439eafaf79fff940a6f4a4be92386 100644 (file)
@@ -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* ;
 
index fd899d4d4df15efff5cfe0f3c17599a538e3b9a7..878c9c3ce72a3f1e98e69d0a654c2e8bb27f1131 100644 (file)
@@ -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 each element on its own line.
-    [ dup unparse-short swap write-object terpri ] each ;
+: unparse-short ( object -- )
+    dup unparse-short swap write-object terpri ;
+
+: [.] ( sequence -- ) [ unparse-short. ] each ;
 
 : stack. reverse-slice [.] ;
 
index 322ad1b0d14803c52e1f049a7c6a24d5de4f54c6..eb08293aebb8415e3e55f0d47be4022dee5354a9 100644 (file)
@@ -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
index 49c08c5c7318e25e4c5e8499f7d03794d8c70c4b..93c0a9f21ffe219ea9b12d25341a8d905daeadd3 100644 (file)
@@ -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
index 8fb83c2828ae6c1ff370924632f73aba19afdb70..74eede4c45c38667e9e2d89432382509b136f5e4 100644 (file)
@@ -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.
index 302ad0ab62f118ec242a041b65cb021f479f8d06..8c1e71d579e1e715188351cd05935efcf00689f6 100644 (file)
@@ -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 )
index a540516e35be0497f4dc3d5e50d54296dd1eab19..dcbb95c06de277acb78872a602e870becefc4d8f 100644 (file)
@@ -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.