diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 61d3de983f..2fb590a5a0 100644 --- a/TODO.FACTOR.txt +++ b/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: diff --git a/library/bootstrap/image.factor b/library/bootstrap/image.factor index 15cbd7d5d8..444a713627 100644 --- a/library/bootstrap/image.factor +++ b/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 ; diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index f6f3f248d5..f90a7c37df 100644 --- a/library/bootstrap/primitives.factor +++ b/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 -- " } diff --git a/library/collections/sequence-sort.factor b/library/collections/sequence-sort.factor index 349cdd386e..ad8dd71cac 100644 --- a/library/collections/sequence-sort.factor +++ b/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 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 ; -: start> dup sorter-start 1 + swap set-sorter-start ; inline +: 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 diff --git a/library/generic/generic.factor b/library/generic/generic.factor index 2a30de9ba1..eb028bf5a7 100644 --- a/library/generic/generic.factor +++ b/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 ; diff --git a/library/httpd/browser-responder.factor b/library/httpd/browser-responder.factor index bc3ab751ff..7ed69bd555 100644 --- a/library/httpd/browser-responder.factor +++ b/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 ; -: 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* ; diff --git a/library/syntax/prettyprint.factor b/library/syntax/prettyprint.factor index fd899d4d4d..878c9c3ce7 100644 --- a/library/syntax/prettyprint.factor +++ b/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 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 [.] ; diff --git a/library/test/redefine.factor b/library/test/redefine.factor index 322ad1b0d1..eb08293aeb 100644 --- a/library/test/redefine.factor +++ b/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 diff --git a/library/test/sequences.factor b/library/test/sequences.factor index 49c08c5c73..93c0a9f21f 100644 --- a/library/test/sequences.factor +++ b/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 - ; [ { 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 diff --git a/library/tools/walker.factor b/library/tools/walker.factor index 8fb83c2828..74eede4c45 100644 --- a/library/tools/walker.factor +++ b/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. diff --git a/library/vocabularies.factor b/library/vocabularies.factor index 302ad0ab62..8c1e71d579 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -41,8 +41,10 @@ SYMBOL: vocabularies global [ 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 ; : ( 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 ) diff --git a/library/words.factor b/library/words.factor index a540516e35..dcbb95c06d 100644 --- a/library/words.factor +++ b/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.