Some cleanups to start 0.84

Makefile

@@ -3,8 +3,8 @@ CC = gcc
 BINARY = f
 IMAGE = factor.image
 BUNDLE = Factor.app
-DISK_IMAGE_DIR = Factor-0.83
+DISK_IMAGE_DIR = Factor-0.84
-DISK_IMAGE = Factor-0.83.dmg
+DISK_IMAGE = Factor-0.84.dmg
 
 ifdef DEBUG
 	CFLAGS = -g

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

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" } "." ;

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 )
+: (map) ( seq quot i -- quot seq value )
-    pick pick >r >r swap nth-unsafe swap call r> r> rot ; inline
+    -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 <array> 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 -- )
+: change-nth ( i seq quot -- )
-    pick pick >r >r >r swap nth
+    -rot [ nth swap call ] 2keep set-nth ; inline
-    r> call r> r> swap 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 <vector> 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

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 -- )"
+HELP: change-nth "( i seq quot -- )"
-{ $values { "seq" "a mutable sequence" } { "i" "a non-negative integer" } { "quot" "a quotation with stack effect " { $snippet "( elt -- newelt )" } } }
+{ $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" } ;

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
+    2dup min-length (mismatch) ;
-    [ >r 2dup r> 2nth-unsafe = not ] find
-    swap >r 3drop r> ;
 
 : 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= [
+    2dup [ length ] 2apply tuck number=
-        dup length [ >r 2dup r> 2nth-unsafe = ] all? 2nip
+    [ (mismatch) -1 number= ] [ 3drop f ] if ;
-    ] [
-        2drop f
-    ] if ;
 
 UNION: sequence array string sbuf vector quotation ;
 

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 ;

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 ;

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 )

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 <sbuf> ] catch drop ] times ] unit-test
 
 [ "abc" ] [ [ "a" "b" "c" ] [ [ % ] each ] "" make ] unit-test

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 ;
 

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 ;
 

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 ;

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." } ;

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 <file-reader> [
+    "~" get "/.jedit/server" path+ <file-reader> [
         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

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 ;
+    ] { } make simple-table ;
-
-: room. ( -- )
-    room-table H{ { table-gap { 10 0 0 } } }
-    [ write ] tabular-output ;
 
 ! 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
+    ] { } make simple-table ;
-    H{ { table-gap { 10 0 0 } } }
-    [ dup string? [ write ] [ pprint ] if ]
-    tabular-output ;

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 ;
 

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 ;

version.factor

@@ -1,2 +1,2 @@
 IN: kernel
-: version "0.83" ;
+: version "0.84" ;