Merge commit 'origin/master'

core/bootstrap/syntax.factor

@@ -43,6 +43,7 @@ IN: bootstrap.syntax
     "PRIMITIVE:"
     "PRIVATE>"
     "SBUF\""
+    "SINGLETON:"
     "SYMBOL:"
     "TUPLE:"
     "T{"

core/classes/singleton/singleton-tests.factor

@@ -0,0 +1,12 @@
+USING: kernel classes.singleton tools.test prettyprint io.streams.string ;
+IN: classes.singleton.tests
+
+[ ] [ SINGLETON: bzzt ] unit-test
+[ t ] [ bzzt bzzt? ] unit-test
+[ t ] [ bzzt bzzt eq? ] unit-test
+GENERIC: zammo ( obj -- str )
+[ ] [ M: bzzt zammo drop "yes!" ; ] unit-test
+[ "yes!" ] [ bzzt zammo ] unit-test
+[ ] [ SINGLETON: omg ] unit-test
+[ t ] [ omg singleton-class? ] unit-test
+[ "IN: classes.singleton.tests\nSINGLETON: omg\n" ] [ [ omg see ] with-string-writer ] unit-test

core/classes/singleton/singleton.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes.predicate kernel sequences words ;
+IN: classes.singleton
+
+PREDICATE: singleton-class < predicate-class
+    [ "predicate-definition" word-prop ]
+    [ [ eq? ] curry ] bi sequence= ;
+
+: define-singleton-class ( word -- )
+    \ word over [ eq? ] curry define-predicate-class ;

core/io/backend/backend-tests.factor

@@ -1,4 +1,4 @@
 IN: io.backend.tests
 USING: tools.test io.backend kernel ;
 
-[ ] [ "a" normalize-pathname drop ] unit-test
+[ ] [ "a" normalize-path drop ] unit-test

core/io/backend/backend.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init kernel system namespaces io io.encodings
-io.encodings.utf8 init assocs ;
+io.encodings.utf8 init assocs splitting ;
 IN: io.backend
 
 SYMBOL: io-backend
@@ -18,9 +18,9 @@ HOOK: io-multiplex io-backend ( ms -- )
 
 HOOK: normalize-directory io-backend ( str -- newstr )
 
-HOOK: normalize-pathname io-backend ( str -- newstr )
+HOOK: normalize-path io-backend ( str -- newstr )
 
-M: object normalize-directory normalize-pathname ;
+M: object normalize-directory normalize-path ;
 
 : set-io-backend ( io-backend -- )
     io-backend set-global init-io init-stdio

core/io/files/files-docs.factor

@@ -252,7 +252,7 @@ HELP: normalize-directory
 { $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
 { $description "Called by the " { $link directory } " word to prepare a pathname before passing it to the " { $link (directory) } " primitive." } ;
 
-HELP: normalize-pathname
+HELP: normalize-path
 { $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
 { $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;
 

core/io/files/files-tests.factor

@@ -220,8 +220,6 @@ io.encodings.utf8 ;
 
 [ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
 [ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test
-[ "/lib" ] [ "/usr/" "/lib" append-path ] unit-test
-[ "/lib/" ] [ "/usr/" "/lib/" append-path ] unit-test
 [ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test
 [ "/usr/lib/" ] [ "/usr" "./lib/" append-path ] unit-test
 [ "/lib" ] [ "/usr" "../lib" append-path ] unit-test
@@ -239,9 +237,6 @@ io.encodings.utf8 ;
 [ "lib" ] [ "" "lib" append-path ] unit-test
 [ "lib" ] [ "" "./lib" append-path ] unit-test
 
-[ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test
-[ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test
-
 [ "foo/bar/." parent-directory ] must-fail
 [ "foo/bar/./" parent-directory ] must-fail
 [ "foo/bar/baz/.." parent-directory ] must-fail
@@ -263,5 +258,4 @@ io.encodings.utf8 ;
 [ "bar/foo" ] [ "bar/baz" "./../././././././///foo" append-path ] unit-test
 
 [ t ] [ "resource:core" absolute-path? ] unit-test
-[ t ] [ "/foo" absolute-path? ] unit-test
 [ f ] [ "" absolute-path? ] unit-test

core/io/files/files.factor

@@ -13,13 +13,13 @@ HOOK: (file-writer) io-backend ( path -- stream )
 HOOK: (file-appender) io-backend ( path -- stream )
 
 : <file-reader> ( path encoding -- stream )
-    swap normalize-pathname (file-reader) swap <decoder> ;
+    swap normalize-path (file-reader) swap <decoder> ;
 
 : <file-writer> ( path encoding -- stream )
-    swap normalize-pathname (file-writer) swap <encoder> ;
+    swap normalize-path (file-writer) swap <encoder> ;
 
 : <file-appender> ( path encoding -- stream )
-    swap normalize-pathname (file-appender) swap <encoder> ;
+    swap normalize-path (file-appender) swap <encoder> ;
 
 : file-lines ( path encoding -- seq )
     <file-reader> lines ;
@@ -102,6 +102,7 @@ PRIVATE>
 
 : windows-absolute-path? ( path -- path ? )
     {
+        { [ dup "\\\\?\\" head? ] [ t ] }
         { [ dup length 2 < ] [ f ] }
         { [ dup second CHAR: : = ] [ t ] }
         { [ t ] [ f ] }
@@ -111,8 +112,8 @@ PRIVATE>
     {
         { [ dup empty? ] [ f ] }
         { [ dup "resource:" head? ] [ t ] }
-        { [ dup first path-separator? ] [ t ] }
         { [ windows? ] [ windows-absolute-path? ] }
+        { [ dup first path-separator? ] [ t ] }
         { [ t ] [ f ] }
     } cond nip ;
 
@@ -126,6 +127,9 @@ PRIVATE>
             2 tail left-trim-separators
             >r parent-directory r> append-path
         ] }
+        { [ over absolute-path? over first path-separator? and ] [
+            >r 2 head r> append
+        ] }
         { [ t ] [
             >r right-trim-separators "/" r>
             left-trim-separators 3append
@@ -167,7 +171,7 @@ SYMBOL: +unknown+
 
 ! File metadata
 : exists? ( path -- ? )
-    normalize-pathname (exists?) ;
+    normalize-path (exists?) ;
 
 : directory? ( path -- ? )
     file-info file-info-type +directory+ = ;
@@ -183,18 +187,33 @@ M: object cwd ( -- path ) "." ;
 
 [ cwd current-directory set-global ] "io.files" add-init-hook
 
+: resource-path ( path -- newpath )
+    "resource-path" get [ image parent-directory ] unless*
+    prepend-path ;
+
+: (normalize-path) ( path -- path' )
+    "resource:" ?head [
+        left-trim-separators resource-path
+        (normalize-path)
+    ] [
+        current-directory get prepend-path
+    ] if ;
+
+M: object normalize-path ( path -- path' )
+    (normalize-path) ;
+
 : with-directory ( path quot -- )
-    >r normalize-pathname r>
+    >r (normalize-path) r>
     current-directory swap with-variable ; inline
 
 : set-current-directory ( path -- )
-    normalize-pathname current-directory set ;
+    normalize-path current-directory set ;
 
 ! Creating directories
 HOOK: make-directory io-backend ( path -- )
 
 : make-directories ( path -- )
-    normalize-pathname right-trim-separators {
+    normalize-path right-trim-separators {
         { [ dup "." = ] [ ] }
         { [ dup root-directory? ] [ ] }
         { [ dup empty? ] [ ] }
@@ -267,7 +286,7 @@ M: object copy-file
 DEFER: copy-tree-into
 
 : copy-tree ( from to -- )
-    normalize-pathname
+    normalize-path
     over link-info type>>
     {
         { +symbolic-link+ [ copy-link ] }
@@ -286,9 +305,6 @@ DEFER: copy-tree-into
     [ copy-tree-into ] curry each ;
 
 ! Special paths
-: resource-path ( path -- newpath )
-    "resource-path" get [ image parent-directory ] unless*
-    prepend-path ;
 
 : temp-directory ( -- path )
     "temp" resource-path dup make-directories ;
@@ -296,14 +312,6 @@ DEFER: copy-tree-into
 : temp-file ( name -- path )
     temp-directory prepend-path ;
 
-M: object normalize-pathname ( path -- path' )
-    "resource:" ?head [
-        left-trim-separators resource-path
-        normalize-pathname
-    ] [
-        current-directory get prepend-path
-    ] if ;
-
 ! Pathname presentations
 TUPLE: pathname string ;
 

core/prettyprint/prettyprint.factor

@@ -7,7 +7,7 @@ vectors words prettyprint.backend prettyprint.sections
 prettyprint.config sorting splitting math.parser vocabs
 definitions effects classes.tuple io.files classes continuations
 hashtables classes.mixin classes.union classes.predicate
-combinators quotations ;
+classes.singleton combinators quotations ;
 
 : make-pprint ( obj quot -- block in use )
     [
@@ -254,6 +254,9 @@ M: predicate-class see-class*
     "predicate-definition" word-prop pprint-elements
     pprint-; block> block> ;
 
+M: singleton-class see-class* ( class -- )
+    \ SINGLETON: pprint-word pprint-word ;
+
 M: tuple-class see-class*
     <colon \ TUPLE: pprint-word
     dup pprint-word

core/syntax/syntax.factor

@@ -5,8 +5,8 @@ byte-vectors definitions generic hashtables kernel math
 namespaces parser sequences strings sbufs vectors words
 quotations io assocs splitting classes.tuple generic.standard
 generic.math classes io.files vocabs float-arrays float-vectors
-classes.union classes.mixin classes.predicate compiler.units
+classes.union classes.mixin classes.predicate classes.singleton
-combinators debugger ;
+compiler.units combinators debugger ;
 IN: bootstrap.syntax
 
 ! These words are defined as a top-level form, instead of with
@@ -154,6 +154,11 @@ IN: bootstrap.syntax
         parse-definition define-predicate-class
     ] define-syntax
 
+    "SINGLETON:" [
+        scan create-class-in
+        dup save-location define-singleton-class
+    ] define-syntax
+
     "TUPLE:" [
         parse-tuple-definition define-tuple-class
     ] define-syntax

extra/cairo/png/png.factor

@@ -24,7 +24,7 @@ ERROR: cairo-error string ;
     } cond ;
 
 : <png> ( path -- png )
-    normalize-pathname
+    normalize-path
     cairo_image_surface_create_from_png
     dup cairo_surface_status cairo-png-error
     dup [ cairo_image_surface_get_width check-zero ]

extra/classes/singleton/singleton-tests.factor

@@ -1,12 +0,0 @@
-USING: kernel singleton tools.test prettyprint io.streams.string ;
-IN: classes.singleton.tests
-
-[ ] [ SINGLETON: bzzt ] unit-test
-[ t ] [ bzzt bzzt? ] unit-test
-[ t ] [ bzzt bzzt eq? ] unit-test
-GENERIC: zammo ( obj -- )
-[ ] [ M: bzzt zammo drop "yes!" ; ] unit-test
-[ "yes!" ] [ bzzt zammo ] unit-test
-[ ] [ SINGLETON: omg ] unit-test
-[ t ] [ omg singleton? ] unit-test
-[ "USING: singleton ;\nIN: classes.singleton.tests\nSINGLETON: omg\n" ] [ [ omg see ] with-string-writer ] unit-test

extra/classes/singleton/singleton.factor

@@ -1,22 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: classes.predicate kernel namespaces parser quotations
-sequences words prettyprint prettyprint.backend prettyprint.sections
-compiler.units classes ;
-IN: classes.singleton
-
-PREDICATE: singleton < predicate-class
-    [ "predicate-definition" word-prop ]
-    [ [ eq? ] curry ] bi sequence= ;
-
-: define-singleton ( token -- )
-    create-class-in
-    dup save-location
-    \ singleton
-    over [ eq? ] curry define-predicate-class ;
-
-: SINGLETON:
-    scan define-singleton ; parsing
-
-M: singleton see-class* ( class -- )
-    <colon \ SINGLETON: pprint-word pprint-word ;

extra/editors/editors.factor

@@ -26,7 +26,7 @@ SYMBOL: edit-hook
     require ;
 
 : edit-location ( file line -- )
-    >r normalize-pathname "\\\\?\\" ?head drop r>
+    >r (normalize-path) "\\\\?\\" ?head drop r>
     edit-hook get [ call ] [ no-edit-hook edit-location ] if* ;
 
 : edit ( defspec -- )

extra/editors/textwrangler/authors.txt

@@ -0,0 +1 @@
+Ben Schlingelhof

extra/editors/textwrangler/summary.txt

@@ -0,0 +1 @@
+Textwrangler editor integration

extra/editors/textwrangler/textwrangler.factor

@@ -0,0 +1,13 @@
+! Copyright (C) 2008 Ben Schlingelhof.
+! See http://factorcode.org/license.txt for BSD license.
+USING: definitions io.launcher kernel parser words sequences
+math math.parser namespaces editors ;
+IN: editors.textwrangler
+
+: tw ( file line -- )
+    [ "edit +" % # " " % % ] "" make run-process drop ;
+
+: tw-word ( word -- )
+    where first2 tw ;
+
+[ tw ] edit-hook set-global

extra/io/sockets/sockets.factor

@@ -7,7 +7,7 @@ IN: io.sockets
 TUPLE: local path ;
 
 : <local> ( path -- addrspec )
-    normalize-pathname local construct-boa ;
+    normalize-path local construct-boa ;
 
 TUPLE: inet4 host port ;
 

extra/io/unix/files/files-tests.factor

@@ -21,3 +21,9 @@ IN: io.unix.files.tests
 [ "/lib/" ] [ "/" "../lib/" append-path ] unit-test
 [ "/lib" ] [ "/" "../../lib" append-path ] unit-test
 [ "/lib/" ] [ "/" "../../lib/" append-path ] unit-test
+
+[ "/lib" ] [ "/usr/" "/lib" append-path ] unit-test
+[ "/lib/" ] [ "/usr/" "/lib/" append-path ] unit-test
+[ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test
+[ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test
+[ t ] [ "/foo" absolute-path? ] unit-test

extra/io/unix/files/files.factor

@@ -43,22 +43,22 @@ M: unix-io (file-appender) ( path -- stream )
     { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable
 
 M: unix-io touch-file ( path -- )
-    normalize-pathname
+    normalize-path
     touch-mode file-mode open
     dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when
     close ;
 
 M: unix-io move-file ( from to -- )
-    [ normalize-pathname ] bi@ rename io-error ;
+    [ normalize-path ] bi@ rename io-error ;
 
 M: unix-io delete-file ( path -- )
-    normalize-pathname unlink io-error ;
+    normalize-path unlink io-error ;
 
 M: unix-io make-directory ( path -- )
-    normalize-pathname OCT: 777 mkdir io-error ;
+    normalize-path OCT: 777 mkdir io-error ;
 
 M: unix-io delete-directory ( path -- )
-    normalize-pathname rmdir io-error ;
+    normalize-path rmdir io-error ;
 
 : (copy-file) ( from to -- )
     dup parent-directory make-directories
@@ -69,7 +69,7 @@ M: unix-io delete-directory ( path -- )
     ] with-disposal ;
 
 M: unix-io copy-file ( from to -- )
-    [ normalize-pathname ] bi@
+    [ normalize-path ] bi@
     [ (copy-file) ]
     [ swap file-info file-info-permissions chmod io-error ]
     2bi ;
@@ -96,15 +96,15 @@ M: unix-io copy-file ( from to -- )
     \ file-info construct-boa ;
 
 M: unix-io file-info ( path -- info )
-    normalize-pathname stat* stat>file-info ;
+    normalize-path stat* stat>file-info ;
 
 M: unix-io link-info ( path -- info )
-    normalize-pathname lstat* stat>file-info ;
+    normalize-path lstat* stat>file-info ;
 
 M: unix-io make-link ( path1 path2 -- )
-    normalize-pathname symlink io-error ;
+    normalize-path symlink io-error ;
 
 M: unix-io read-link ( path -- path' )
-    normalize-pathname
+    normalize-path
     PATH_MAX [ <byte-array> tuck ] [ ] bi readlink
     dup io-error head-slice >string ;

extra/io/unix/launcher/launcher.factor

@@ -37,7 +37,7 @@ USE: unix
     2nip reset-fd ;
 
 : redirect-file ( obj mode fd -- )
-    >r >r normalize-pathname r> file-mode
+    >r >r normalize-path r> file-mode
     open dup io-error r> redirect-fd ;
 
 : redirect-closed ( obj mode fd -- )

extra/io/windows/ce/files/files.factor

@@ -4,7 +4,7 @@ prettyprint sequences strings threads threads.private
 windows windows.kernel32 io.windows.ce.backend ;
 IN: windows.ce.files
 
-! M: windows-ce-io normalize-pathname ( string -- string )
+! M: windows-ce-io normalize-path ( string -- string )
     ! dup 1 tail* CHAR: \\ = [ "*" append ] [ "\\*" append ] if ;
 
 M: windows-ce-io CreateFile-flags ( DWORD -- DWORD )

extra/io/windows/files/files.factor

@@ -89,14 +89,14 @@ SYMBOLS: +read-only+ +hidden+ +system+
     ] if ;
 
 M: windows-nt-io file-info ( path -- info )
-    normalize-pathname get-file-information-stat ;
+    normalize-path get-file-information-stat ;
 
 M: windows-nt-io link-info ( path -- info )
     file-info ;
 
 : file-times ( path -- timestamp timestamp timestamp )
     [
-        normalize-pathname open-existing dup close-always
+        normalize-path open-existing dup close-always
         "FILETIME" <c-object>
         "FILETIME" <c-object>
         "FILETIME" <c-object>
@@ -112,7 +112,7 @@ M: windows-nt-io link-info ( path -- info )
     #! timestamp order: creation access write
     [
         >r >r >r
-            normalize-pathname open-existing dup close-always
+            normalize-path open-existing dup close-always
         r> r> r> (set-file-times)
     ] with-destructors ;
 
@@ -127,7 +127,7 @@ M: windows-nt-io link-info ( path -- info )
 
 M: windows-nt-io touch-file ( path -- )
     [
-        normalize-pathname
+        normalize-path
         maybe-create-file over close-always
         [ drop ] [ f now dup (set-file-times) ] if
     ] with-destructors ;

extra/io/windows/launcher/launcher.factor

@@ -28,7 +28,7 @@ TUPLE: CreateProcess-args
     "PROCESS_INFORMATION" <c-object> >>lpProcessInformation
     TRUE >>bInheritHandles
     0 >>dwCreateFlags
-    current-directory get normalize-pathname >>lpCurrentDirectory ;
+    current-directory get (normalize-path) >>lpCurrentDirectory ;
 
 : call-CreateProcess ( CreateProcess-args -- )
     {

extra/io/windows/nt/files/files-tests.factor

@@ -1,9 +1,9 @@
 USING: io.files kernel tools.test io.backend
-io.windows.nt.files splitting ;
+io.windows.nt.files splitting sequences ;
 IN: io.windows.nt.files.tests
 
-[ t ] [ "\\foo" absolute-path? ] unit-test
+[ f ] [ "\\foo" absolute-path? ] unit-test
-[ t ] [ "\\\\?\\foo" absolute-path? ] unit-test
+[ t ] [ "\\\\?\\c:\\foo" absolute-path? ] unit-test
 [ t ] [ "c:\\foo" absolute-path? ] unit-test
 [ t ] [ "c:" absolute-path? ] unit-test
 
@@ -29,19 +29,22 @@ IN: io.windows.nt.files.tests
 
 [ ] [ "" resource-path cd ] unit-test
 
-[ "\\foo\\bar" ] [ "/foo/bar" normalize-pathname ":" split1 nip ] unit-test
+[ "\\foo\\bar" ] [ "/foo/bar" normalize-path ":" split1 nip ] unit-test
 
 [ "\\\\?\\C:\\builds\\factor\\log.txt" ] [
     "C:\\builds\\factor\\12345\\"
-    "..\\log.txt" append-path normalize-pathname
+    "..\\log.txt" append-path normalize-path
 ] unit-test
 
 [ "\\\\?\\C:\\builds\\" ] [
     "C:\\builds\\factor\\12345\\"
-    "..\\.." append-path normalize-pathname
+    "..\\.." append-path normalize-path
 ] unit-test
 
 [ "\\\\?\\C:\\builds\\" ] [
     "C:\\builds\\factor\\12345\\"
-    "..\\.." append-path normalize-pathname
+    "..\\.." append-path normalize-path
 ] unit-test
+
+[ "c:\\blah" ] [ "c:\\foo\\bar" "\\blah" append-path ] unit-test
+[ t ] [ "" resource-path 2 tail exists? ] unit-test

extra/io/windows/nt/files/files.factor

@@ -36,28 +36,14 @@ ERROR: not-absolute-path ;
     } && [ 2 head ] [ not-absolute-path ] if ;
 
 : prepend-prefix ( string -- string' )
-    unicode-prefix prepend ;
-
-ERROR: nonstring-pathname ;
-ERROR: empty-pathname ;
-
-M: windows-nt-io normalize-pathname ( string -- string )
-    "resource:" ?head [
-        left-trim-separators resource-path
-        normalize-pathname
-    ] [
-        dup empty? [ empty-pathname ] when
-        current-directory get prepend-path
     dup unicode-prefix head? [
-            dup first path-separator? [
-                left-trim-separators
-                current-directory get 2 head
-                prepend-path
-            ] when
         unicode-prefix prepend
-        ] unless
+    ] unless ;
-        { { CHAR: / CHAR: \\ } } substitute ! necessary
+
-    ] if ;
+M: windows-nt-io normalize-path ( string -- string' )
+    (normalize-path)
+    { { CHAR: / CHAR: \\ } } substitute
+    prepend-prefix ;
 
 M: windows-nt-io CreateFile-flags ( DWORD -- DWORD )
     FILE_FLAG_OVERLAPPED bitor ;

extra/io/windows/nt/launcher/launcher.factor

@@ -32,7 +32,7 @@ IN: io.windows.nt.launcher
     drop 2nip null-pipe ;
 
 :: redirect-file ( default path access-mode create-mode -- handle )
-    path normalize-pathname
+    path normalize-path
     access-mode
     share-mode
     security-attributes-inherit

extra/io/windows/windows.factor

@@ -25,7 +25,7 @@ HOOK: FileArgs-overlapped io-backend ( port -- overlapped/f )
 HOOK: add-completion io-backend ( port -- )
 
 M: windows-io normalize-directory ( string -- string )
-    normalize-pathname "\\" ?tail drop "\\*" append ;
+    normalize-path "\\" ?tail drop "\\*" append ;
 
 : share-mode ( -- fixnum )
     {
@@ -135,21 +135,21 @@ M: windows-io (file-appender) ( path -- stream )
     open-append <win32-file> <writer> ;
 
 M: windows-io move-file ( from to -- )
-    [ normalize-pathname ] bi@ MoveFile win32-error=0/f ;
+    [ normalize-path ] bi@ MoveFile win32-error=0/f ;
 
 M: windows-io delete-file ( path -- )
-    normalize-pathname DeleteFile win32-error=0/f ;
+    normalize-path DeleteFile win32-error=0/f ;
 
 M: windows-io copy-file ( from to -- )
     dup parent-directory make-directories
-    [ normalize-pathname ] bi@ 0 CopyFile win32-error=0/f ;
+    [ normalize-path ] bi@ 0 CopyFile win32-error=0/f ;
 
 M: windows-io make-directory ( path -- )
-    normalize-pathname
+    normalize-path
     f CreateDirectory win32-error=0/f ;
 
 M: windows-io delete-directory ( path -- )
-    normalize-pathname
+    normalize-path
     RemoveDirectory win32-error=0/f ;
 
 HOOK: WSASocket-flags io-backend ( -- DWORD )

extra/new-effects/new-effects.factor

@@ -1,17 +0,0 @@
-USING: assocs kernel sequences ;
-IN: new-effects
-
-: new-nth ( seq n -- elt )
-    swap nth ; inline
-
-: new-set-nth ( seq obj n -- seq )
-    pick set-nth ; inline
-
-: new-at ( assoc key -- elt )
-    swap at ; inline
-
-: new-at* ( assoc key -- elt ? )
-    swap at* ; inline
-
-: new-set-at ( assoc value key -- assoc )
-    pick set-at ; inline

extra/newfx/newfx.factor

@@ -18,11 +18,18 @@ IN: newfx
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
 : nth-is ( seq   i val -- seq ) swap pick set-nth ;
-
 : is-nth ( seq val   i -- seq )      pick set-nth ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: mutate-nth    ( seq i val -- ) swap rot set-nth ;
+: mutate-at-nth ( seq val i -- )      rot set-nth ;
+
+: mutate-nth-of    (   i val seq -- ) swapd set-nth ;
+: mutate-at-nth-of ( val   i seq -- )       set-nth ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : at-key ( tbl key -- val ) swap at ;
 : key-of ( key tbl -- val )      at ;
 
@@ -33,6 +40,14 @@ IN: newfx
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: mutate-key    ( tbl key val -- ) swap rot set-at ;
+: mutate-at-key ( tbl val key -- )      rot set-at ;
+
+: mutate-key-of    ( key val tbl -- ) swapd set-at ;
+: mutate-at-key-of ( val key tbl -- )       set-at ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : push    ( seq obj -- seq ) over sequences:push ;
 : push-on ( obj seq -- seq ) tuck sequences:push ;
 
@@ -48,3 +63,6 @@ IN: newfx
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+! A note about the 'mutate' qualifier. Other words also technically mutate
+! their primary object. However, the 'mutate' qualifier is supposed to
+! indicate that this is the main objective of the word, as a side effect.

extra/random/mersenne-twister/mersenne-twister.factor

@@ -4,7 +4,7 @@
 ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
 
 USING: arrays kernel math namespaces sequences system init
-accessors math.ranges random ;
+accessors math.ranges random circular ;
 IN: random.mersenne-twister
 
 <PRIVATE
@@ -16,8 +16,6 @@ TUPLE: mersenne-twister seq i ;
 : mt-a HEX: 9908b0df ; inline
 : mt-hi HEX: 80000000 bitand ; inline
 : mt-lo HEX: 7fffffff bitand ; inline
-: wrap ( x n -- y ) 2dup >= [ - ] [ drop ] if ; inline
-: mt-wrap ( x -- y ) mt-n wrap ; inline
 
 : set-generated ( y from-elt to seq -- )
     >r >r >r [ 2/ ] [ odd? mt-a 0 ? ] bi
@@ -27,8 +25,8 @@ TUPLE: mersenne-twister seq i ;
     tuck [ nth mt-hi ] [ nth mt-lo ] 2bi* bitor ; inline
 
 : (mt-generate) ( n mt-seq -- y to from-elt )
-    [ >r dup 1+ mt-wrap r> calculate-y ]
+    [ >r dup 1+ r> calculate-y ]
-    [ >r mt-m + mt-wrap r> nth ]
+    [ >r mt-m + r> nth ]
     [ drop ] 2tri ;
 
 : mt-generate ( mt -- )
@@ -36,7 +34,7 @@ TUPLE: mersenne-twister seq i ;
     [ 0 >>i drop ] bi ;
 
 : init-mt-first ( seed -- seq )
-    >r mt-n 0 <array> r>
+    >r mt-n 0 <array> <circular> r>
     HEX: ffffffff bitand 0 pick set-nth ;
 
 : init-mt-formula ( seq i -- f(seq[i]) )