diff --git a/Makefile b/Makefile index 7e0fab93f1..284abddbeb 100644 --- a/Makefile +++ b/Makefile @@ -3,8 +3,8 @@ CC = gcc BINARY = f IMAGE = factor.image BUNDLE = Factor.app -DISK_IMAGE_DIR = Factor-0.83 -DISK_IMAGE = Factor-0.83.dmg +DISK_IMAGE_DIR = Factor-0.84 +DISK_IMAGE = Factor-0.84.dmg ifdef DEBUG CFLAGS = -g diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 670151e50d..f8e5b733d1 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -9,6 +9,7 @@ + ui: +- gadgets/fields unit test fails if UI not running - "benchmark/help" runs out of memory - shortcuts: - find a listener @@ -113,7 +114,7 @@ + misc: -- consider: swap tail --> tail, swap head --> head +- consider: swap tail --> tail, swap head --> head, swap group --> group - mach_signal: fault address reporting is not reliable - slice: if sequence or seq start is changed, abstraction violation - hashed generic method dispatch diff --git a/doc/handbook/tools.facts b/doc/handbook/tools.facts index ae64d3670e..98d72f9f8e 100644 --- a/doc/handbook/tools.facts +++ b/doc/handbook/tools.facts @@ -85,8 +85,6 @@ ARTICLE: "debugger" "The debugger" { $subsection :r } { $subsection :c } { $subsection :get } -{ $subsection :error } -{ $subsection :cc } "If the error is recoverable, a list of restarts is also printed, and a numbered restart can be invoked:" { $subsection :res } "You can read more about error handling in " { $link "errors" } "." ; diff --git a/library/collections/sequence-combinators.factor b/library/collections/sequence-combinators.factor index 413531c802..d18dbc57df 100644 --- a/library/collections/sequence-combinators.factor +++ b/library/collections/sequence-combinators.factor @@ -9,8 +9,8 @@ vectors ; [ rot >r [ swap call ] keep r> set-array-nth ] 3keep ] repeat drop ; inline -: (map) ( quot seq i -- quot seq value ) - pick pick >r >r swap nth-unsafe swap call r> r> rot ; inline +: (map) ( seq quot i -- quot seq value ) + -rot [ >r nth-unsafe r> call ] 2keep rot ; inline : (2each) ( quot seq seq i -- quot seq seq i ) [ 2nth-unsafe rot dup slip ] 3keep ; inline @@ -30,13 +30,6 @@ vectors ; t f 0 pick set-nth-unsafe ] if ; -: select ( seq quot quot -- seq ) - pick >r >r V{ } clone rot [ - -rot [ - >r over >r call [ r> r> push ] [ r> r> 2drop ] if - ] 2keep - ] r> call r> like nip ; inline - IN: sequences : each ( seq quot -- | quot: elt -- ) @@ -51,22 +44,21 @@ IN: sequences swapd each ; inline : map ( seq quot -- seq | quot: elt -- elt ) - swap [ dup length [ (map) ] collect ] keep like 2nip ; + over >r over length [ (map) ] collect r> like 2nip ; inline : map-with ( obj list quot -- list | quot: obj elt -- elt ) swap [ with rot ] map 2nip ; inline -: accumulate ( list identity quot -- values | quot: x y -- z ) +: accumulate ( seq identity quot -- values | quot: x y -- z ) rot [ pick >r swap call r> ] map-with nip ; inline -: change-nth ( seq i quot -- ) - pick pick >r >r >r swap nth - r> call r> r> swap set-nth ; inline +: change-nth ( i seq quot -- ) + -rot [ nth swap call ] 2keep set-nth ; inline : inject ( seq quot -- | quot: elt -- elt ) over length - [ [ swap change-nth ] 3keep ] repeat 2drop ; + [ [ -rot change-nth ] 3keep ] repeat 2drop ; inline : inject-with ( obj seq quot -- | quot: obj elt -- elt ) @@ -141,7 +133,11 @@ IN: sequences swap [ with rot ] all? 2nip ; inline : subset ( seq quot -- seq | quot: elt -- ? ) - [ each ] select ; inline + over >r over length rot [ + -rot [ + >r over >r call [ r> r> push ] [ r> r> 2drop ] if + ] 2keep + ] each r> like nip ; inline : subset-with ( obj seq quot -- seq | quot: obj elt -- ? ) swap [ with rot ] subset 2nip ; inline @@ -178,5 +174,5 @@ IN: sequences pick rot call [ drop clone ] [ - over >r >r length r> call dup 0 swap r> copy-into + over >r >r length r> call 0 over r> copy-into ] if ; inline diff --git a/library/collections/sequence-combinators.facts b/library/collections/sequence-combinators.facts index 8eb6fb69d1..3812b1e41b 100644 --- a/library/collections/sequence-combinators.facts +++ b/library/collections/sequence-combinators.facts @@ -35,8 +35,8 @@ HELP: map-with "( obj seq quot -- newseq )" { $values { "obj" "an object" } { "seq" "a sequence" } { "quot" "a quotation with stack effect " { $snippet "( obj elt -- new )" } } } { $description "Variant of " { $link map } " which pushes a retained object on each invocation of the quotation." } ; -HELP: change-nth "( seq i quot -- )" -{ $values { "seq" "a mutable sequence" } { "i" "a non-negative integer" } { "quot" "a quotation with stack effect " { $snippet "( elt -- newelt )" } } } +HELP: change-nth "( i seq quot -- )" +{ $values { "i" "a non-negative integer" } { "seq" "a mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- newelt )" } } } { $description "Applies the quotation to the " { $snippet "i" } "th element of the sequence, storing the result back into the sequence." } { $errors "Throws an error if the sequence is immutable, if the index is out of bounds, or the sequence cannot hold elements of the type output by " { $snippet "quot" } "." } { $side-effects "seq" } ; diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor index ee765bcae5..816fdc82be 100644 --- a/library/collections/sequences-epilogue.factor +++ b/library/collections/sequences-epilogue.factor @@ -50,7 +50,7 @@ M: object like drop ; : (delete) ( elt store scan seq -- ) 2dup length < [ 3dup move - >r pick over r> dup >r nth = r> swap + [ nth pick = ] 2keep rot [ >r >r 1+ r> r> ] unless >r 1+ r> (delete) ] when ; @@ -100,10 +100,11 @@ M: object like drop ; : all-eq? ( seq -- ? ) [ eq? ] monotonic? ; +: (mismatch) ( seq1 seq2 n -- i ) + [ >r 2dup r> 2nth-unsafe = not ] find drop 2nip ; inline + : mismatch ( seq1 seq2 -- i ) - 2dup min-length - [ >r 2dup r> 2nth-unsafe = not ] find - swap >r 3drop r> ; + 2dup min-length (mismatch) ; : flip ( seq -- seq ) dup empty? [ @@ -127,11 +128,8 @@ M: object like drop ; : last/first ( seq -- pair ) dup peek swap first 2array ; : sequence= ( seq seq -- ? ) - 2dup [ length ] 2apply number= [ - dup length [ >r 2dup r> 2nth-unsafe = ] all? 2nip - ] [ - 2drop f - ] if ; + 2dup [ length ] 2apply tuck number= + [ (mismatch) -1 number= ] [ 3drop f ] if ; UNION: sequence array string sbuf vector quotation ; diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor index b2192109dd..8db1556584 100644 --- a/library/collections/sequences.factor +++ b/library/collections/sequences.factor @@ -26,9 +26,6 @@ GENERIC: like ( seq seq -- seq ) : bounds-check? ( n seq -- ? ) over 0 >= [ length < ] [ 2drop f ] if ; inline -: ?nth ( n seq/f -- elt/f ) - 2dup bounds-check? [ nth ] [ 2drop f ] if ; - IN: sequences-internals GENERIC: resize ( n seq -- seq ) @@ -61,3 +58,8 @@ M: integer nth-unsafe drop ; : exchange-unsafe ( n n seq -- ) [ tuck nth-unsafe >r nth-unsafe r> ] 3keep tuck >r >r set-nth-unsafe r> r> set-nth-unsafe ; inline + +IN: sequences + +: ?nth ( n seq/f -- elt/f ) + 2dup bounds-check? [ nth-unsafe ] [ 2drop f ] if ; diff --git a/library/collections/slicing.factor b/library/collections/slicing.factor index cf20e40150..d6e30d0036 100644 --- a/library/collections/slicing.factor +++ b/library/collections/slicing.factor @@ -48,7 +48,7 @@ strings vectors ; tuck >r >r head-slice r> r> tail-slice swapd append3 ; : remove-nth ( n seq -- seq ) - [ head-slice ] 2keep >r 1+ r> tail-slice append ; + f -rot dupd replace-slice ; : (cut) ( n seq -- before after ) [ head ] 2keep tail-slice ; diff --git a/library/collections/strings.factor b/library/collections/strings.factor index 9b74d0a541..87fc54a4b3 100644 --- a/library/collections/strings.factor +++ b/library/collections/strings.factor @@ -17,7 +17,7 @@ M: string hashcode dup rehash-string string-hashcode ] ?if ; -M: string nth bounds-check char-slot ; +M: string nth bounds-check nth-unsafe ; M: string nth-unsafe >r >fixnum r> char-slot ; @@ -45,8 +45,6 @@ PREDICATE: integer control "\0\e\r\n\t\u0008\u007f" member? ; : >upper ( str -- str ) [ ch>upper ] map ; : quotable? ( ch -- ? ) - #! In a string literal, can this character be used without - #! escaping? dup printable? swap "\"\\" member? not and ; foldable : padding ( string count char -- string ) diff --git a/library/test/collections/strings.factor b/library/test/collections/strings.factor index 1301540b55..4333ed25c5 100644 --- a/library/test/collections/strings.factor +++ b/library/test/collections/strings.factor @@ -8,6 +8,8 @@ USE: test USE: sequences USE: vectors +[ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test + [ ] [ 10 [ [ -1000000 ] catch drop ] times ] unit-test [ "abc" ] [ [ "a" "b" "c" ] [ [ % ] each ] "" make ] unit-test diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index 0f05513880..b49599b9aa 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -148,9 +148,6 @@ M: object error. ( error -- ) . ; dup length [ restart. ] 2each ] if ; -DEFER: :error -DEFER: :cc - : debug-help ( -- ) terpri "Debugger commands:" print @@ -158,8 +155,6 @@ DEFER: :cc ":s data stack at exception time" [ :s ] (debug-help) ":r retain stack at exception time" [ :r ] (debug-help) ":c call stack at exception time" [ :c ] (debug-help) - ":error starts the inspector with the error" [ :error ] (debug-help) - ":cc starts the inspector with the error continuation" [ :cc ] (debug-help) ":get ( var -- value ) accesses variables at time of error" print flush ; diff --git a/library/tools/describe.factor b/library/tools/describe.factor index 4b9a5a587a..f452d0d185 100644 --- a/library/tools/describe.factor +++ b/library/tools/describe.factor @@ -78,7 +78,7 @@ DEFER: describe : sheet. ( sheet -- ) flip - H{ { table-gap { 10 0 0 } } } + H{ { table-gap { 10 0 } } } [ dup unparse-short swap write-object ] tabular-output ; diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor index bd7d292bf7..bd2bdc6213 100644 --- a/library/tools/inspector.factor +++ b/library/tools/inspector.factor @@ -47,9 +47,3 @@ SYMBOL: inspector-stack : go ( n -- ) inspector-slots get nth (inspect) ; : up ( -- ) inspector-stack get dup pop* pop (inspect) ; - -! Another feature. -IN: errors - -: :error ( -- ) error get inspect ; -: :cc ( -- ) error-continuation get inspect ; diff --git a/library/tools/inspector.facts b/library/tools/inspector.facts index 3c4fbd1502..e5061ba9c4 100644 --- a/library/tools/inspector.facts +++ b/library/tools/inspector.facts @@ -28,9 +28,3 @@ HELP: go "( n -- )" HELP: up "( -- )" { $description "Returns to the previously-inspected object." } ; - -HELP: :error "( -- )" -{ $description "Opens an inspector with the most recently thrown error." } ; - -HELP: :cc "( -- )" -{ $description "Opens an inspector with the continuation reified at the time of the most recently thrown error." } ; diff --git a/library/tools/jedit.factor b/library/tools/jedit.factor index a8d8027597..150202c4bf 100644 --- a/library/tools/jedit.factor +++ b/library/tools/jedit.factor @@ -8,7 +8,7 @@ parser prettyprint sequences strings words ; ! edit files and position the cursor on a specific line number. : jedit-server-info ( -- port auth ) - "~" get "/.jedit/server" append [ + "~" get "/.jedit/server" path+ [ readln drop readln string>number readln string>number @@ -90,4 +90,4 @@ IN: shells "telnetd-port" get string>number telnetd ; ! This is a string since we string>number it above. -global [ "9999" "telnetd-port" set ] bind +"9999" "telnetd-port" set-global diff --git a/library/tools/memory.factor b/library/tools/memory.factor index 25e592b563..bb6de3e6df 100644 --- a/library/tools/memory.factor +++ b/library/tools/memory.factor @@ -20,7 +20,12 @@ strings styles vectors words ; : total, ( n str -- ) [ , number>string , "" , "" , ] { } make , ; -: room-table ( -- table ) +: simple-table ( table -- ) + H{ { table-gap { 10 0 } } } + [ dup string? [ write ] [ pprint ] if ] + tabular-output ; + +: room. ( -- ) room [ { "" "Total" "Used" "Free" } , 0 [ @@ -30,11 +35,7 @@ strings styles vectors words ; "Semi-space" total, "Cards" total, "Code space" total/used/free, - ] [ ] make ; - -: room. ( -- ) - room-table H{ { table-gap { 10 0 0 } } } - [ write ] tabular-output ; + ] { } make simple-table ; ! Some words for iterating through the heap. @@ -70,7 +71,4 @@ strings styles vectors words ; ( hash hash key -- ) [ dup , dup pick hash , pick hash , ] { } make , ] each 2drop - ] { } make - H{ { table-gap { 10 0 0 } } } - [ dup string? [ write ] [ pprint ] if ] - tabular-output ; + ] { } make simple-table ; diff --git a/library/ui/gadgets/tracks.factor b/library/ui/gadgets/tracks.factor index dbd3352a29..0de4a7be48 100644 --- a/library/ui/gadgets/tracks.factor +++ b/library/ui/gadgets/tracks.factor @@ -59,7 +59,7 @@ M: track pref-dim* ( track -- dim ) : set-nth-0 ( n seq -- old ) 2dup nth >r 0 -rot set-nth r> ; -: +nth ( delta n seq -- ) swap [ + ] change-nth ; +: +nth ( delta n seq -- ) [ + ] change-nth ; : clamp-nth ( i j sizes -- ) [ set-nth-0 swap ] keep +nth ; diff --git a/library/ui/text/document.factor b/library/ui/text/document.factor index 98a0bfb6d6..86d9bea2f9 100644 --- a/library/ui/text/document.factor +++ b/library/ui/text/document.factor @@ -71,10 +71,10 @@ C: document ( -- document ) ] if r> peek length + 2array ; : prepend-first ( str seq -- seq ) - 0 [ append ] change-nth ; + 0 swap [ append ] change-nth ; : append-last ( str seq -- seq ) - dup length 1- [ swap append ] change-nth ; + [ length 1- ] keep [ swap append ] change-nth ; : loc-col/str ( loc document -- col str ) >r first2 swap r> nth ; diff --git a/version.factor b/version.factor index 4d45846e74..ca1646ceb3 100644 --- a/version.factor +++ b/version.factor @@ -1,2 +1,2 @@ IN: kernel -: version "0.83" ; +: version "0.84" ;