Merge branch 'master' of git://factorcode.org/git/factor

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

@@ -2,7 +2,7 @@ USING: tools.test io.files io.files.temp io.pathnames
 io.directories io.files.info io.files.info.unix continuations
 kernel io.files.unix math.bitwise calendar accessors
 math.functions math unix.users unix.groups arrays sequences
-grouping ;
+grouping io.pathnames.private ;
 IN: io.files.unix.tests
 
 [ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test

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

@@ -1,5 +1,5 @@
 USING: io.files io.pathnames kernel tools.test io.backend
-io.files.windows.nt splitting sequences ;
+io.files.windows.nt splitting sequences io.pathnames.private ;
 IN: io.files.windows.nt.tests
 
 [ f ] [ "\\foo" absolute-path? ] unit-test

core/io/pathnames/pathnames-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io.backend io.files io.directories strings
-sequences ;
+sequences io.pathnames.private ;
 IN: io.pathnames
 
 HELP: path-separator?
@@ -46,12 +46,24 @@ HELP: path-components
 { $description "Splits a pathname on the " { $link path-separator } " into its its component strings." } ;
 
 HELP: append-path
-{ $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
-{ $description "Appends " { $snippet "str1" } " and " { $snippet "str2" } " to form a pathname." } ;
+{ $values { "path1" "a pathname string" } { "path2" "a pathname string" } { "path" "a pathname string" } }
+{ $description "Appends " { $snippet "path1" } " and " { $snippet "path2" } " to form a pathname." }
+{ $examples
+    { $unchecked-example """USING: io.pathnames prettyprint ;
+"first" "second.txt" append-path ."""
+"first/second.txt"
+    }
+} ;
 
 HELP: prepend-path
-{ $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
-{ $description "Appends " { $snippet "str2" } " and " { $snippet "str1" } " to form a pathname." } ;
+{ $values { "path1" "a pathname string" } { "path2" "a pathname string" } { "path" "a pathname string" } }
+{ $description "Appends " { $snippet "path2" } " and " { $snippet "path1" } " to form a pathname." }
+{ $examples
+    { $unchecked-example """USING: io.pathnames prettyprint ;
+"second.txt" "first" prepend-path ."""
+"first/second.txt"
+    }
+} ;
 
 { append-path prepend-path } related-words
 
@@ -77,9 +89,10 @@ HELP: pathname
 { $class-description "Class of path name objects. Path name objects can be created by calling " { $link <pathname> } "." } ;
 
 HELP: normalize-path
-{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
-{ $description "Prepends the " { $link current-directory } " to the pathname, resolves a " { $snippet "resource:" } " prefix, if present, and performs any platform-specific pathname normalization." }
+{ $values { "string" "a pathname string" } { "string'" "a new pathname string" } }
+{ $description "Prepends the " { $link current-directory } " to the pathname, resolves a " { $snippet "resource:" } " or " { $snippet "voacb:" } " prefix, if present, and performs any platform-specific pathname normalization." }
 { $notes "High-level words, such as " { $link <file-reader> } " and " { $link delete-file } " call this word for you. It only needs to be called directly when passing pathnames to C functions or external processes. This is because Factor does not use the operating system's notion of a current directory, and instead maintains its own dynamically-scoped " { $link current-directory } " variable." }
+{ $notes "On Windows NT platforms, this word does prepends the Unicode path prefix." }
 { $examples
   "For example, if you create a file named " { $snippet "data.txt" } " in the current directory, and wish to pass it to a process, you must normalize it:"
   { $code
@@ -88,9 +101,18 @@ HELP: normalize-path
   }
 } ;
 
+HELP: (normalize-path)
+{ $values
+    { "path" "a pathname string" }
+    { "path'" "a pathname string" }
+}
+{ $description "Prepends the " { $link current-directory } " to the pathname and resolves a " { $snippet "resource:" } " prefix, if present." }
+{ $notes "On Windows NT platforms, this word does not prepend the Unicode path prefix." } ;
+
 HELP: canonicalize-path
 { $values { "path" "a pathname string" } { "path'" "a new pathname string" } }
-{ $description "Returns an canonical name for a path. The canonical name is an absolute path containing no symlinks." } ;
+{ $description "Outputs a path where none of the path components are symlinks. This word is useful for determining the actual path on disk where a file is stored; the root of this absolute path is a mount point in the file-system." }
+{ $notes "Most code should not need to call this word except in very special circumstances. One use case is finding the actual file-system on which a file is stored." } ;
 
 HELP: <pathname>
 { $values { "string" "a pathname string" } { "pathname" pathname } }
@@ -98,20 +120,28 @@ HELP: <pathname>
 
 HELP: home
 { $values { "dir" string } }
-{ $description "Outputs the user's home directory." } ;
+{ $description "Outputs the user's home directory." }
+{ $examples
+    { $unchecked-example "USING: io.pathnames prettyprint ;"
+                "home ."
+                "/home/factor-user"
+    }
+} ;
 
-ARTICLE: "io.pathnames" "Pathname manipulation"
-"Pathname manipulation:"
+ARTICLE: "io.pathnames" "Pathnames"
+"Pathnames are objects that contain a string representing the path to a file on disk. Pathnames are cross-platform; Windows accepts both forward and backward slashes as directory separators and new separators are added as a forward slash on all platforms. Clicking a pathname object in the UI brings up the file in one of the supported editors, but otherwise, pathnames and strings are interchangeable. See " { $link "editor" } " for more details." $nl
+"Pathname introspection:"
 { $subsections
     parent-directory
     file-name
     file-stem
     file-extension
-    last-path-separator
     path-components
+}
+"Appending pathnames:"
+{ $subsections
     prepend-path
     append-path
-    canonicalize-path
 }
 "Pathname presentations:"
 { $subsections
@@ -120,7 +150,11 @@ ARTICLE: "io.pathnames" "Pathname manipulation"
 }
 "Literal pathnames:"
 { $subsections POSTPONE: P" }
-"Low-level word:"
-{ $subsections normalize-path } ;
+"Low-level words:"
+{ $subsections
+    normalize-path
+    (normalize-path)
+    canonicalize-path
+} ;
 
 ABOUT: "io.pathnames"

core/io/pathnames/pathnames-tests.factor

@@ -1,6 +1,6 @@
 USING: io.pathnames io.files.temp io.directories
 continuations math io.files.private kernel
-namespaces tools.test ;
+namespaces tools.test io.pathnames.private ;
 IN: io.pathnames.tests
 
 [ "passwd" ] [ "/etc/passwd" file-name ] unit-test

core/io/pathnames/pathnames.factor

@@ -10,10 +10,10 @@ SYMBOL: current-directory
 
 : path-separator ( -- string ) os windows? "\\" "/" ? ;
 
-: trim-tail-separators ( str -- newstr )
+: trim-tail-separators ( string -- string' )
     [ path-separator? ] trim-tail ;
 
-: trim-head-separators ( str -- newstr )
+: trim-head-separators ( string -- string' )
     [ path-separator? ] trim-head ;
 
 : last-path-separator ( path -- n ? )
@@ -61,8 +61,6 @@ ERROR: no-parent-directory path ;
         [ nip ]
     } cond ;
 
-PRIVATE>
-
 : windows-absolute-path? ( path -- path ? )
     {
         { [ dup "\\\\?\\" head? ] [ t ] }
@@ -87,7 +85,9 @@ PRIVATE>
         [ f ]
     } cond nip ;
 
-: append-path ( str1 str2 -- str )
+PRIVATE>
+
+: append-path ( path1 path2 -- path )
     {
         { [ over empty? ] [ append-path-empty ] }
         { [ dup empty? ] [ drop ] }
@@ -107,7 +107,7 @@ PRIVATE>
         ]
     } cond ;
 
-: prepend-path ( str1 str2 -- str )
+: prepend-path ( path1 path2 -- path )
     swap append-path ; inline
 
 : file-name ( path -- string )

core/syntax/syntax-docs.factor

@@ -574,7 +574,7 @@ HELP: SBUF"
 HELP: P"
 { $syntax "P\" pathname\"" }
 { $values { "pathname" "a pathname string" } }
-{ $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", creates a new " { $link pathname } ", and appends it to the parse tree." }
+{ $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", creates a new " { $link pathname } ", and appends it to the parse tree. Pathnames presented in the UI are clickable, which opens them in a text editor configured with " { $link "editor" } "." }
 { $examples { $example "USING: accessors io io.files ;" "P\" foo.txt\" string>> print" "foo.txt" } } ;
 
 HELP: (

extra/random/cmwc/cmwc-tests.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel random random.cmwc sequences tools.test ;
+USING: alien.c-types arrays kernel random random.cmwc sequences
+specialized-arrays specialized-arrays.instances.uint tools.test ;
 IN: random.cmwc.tests
 
 [ ] [
@@ -24,18 +25,18 @@ IN: random.cmwc.tests
 }
 ] [
     cmwc-4096
-    4096 iota >array 362436 <cmwc-seed> seed-random [
+    4096 iota >uint-array 362436 <cmwc-seed> seed-random [
         10 [ random-32 ] replicate
     ] with-random
 ] unit-test
 
 [ t ] [
     cmwc-4096 [
-        4096 iota >array 362436 <cmwc-seed> seed-random [
+        4096 iota >uint-array 362436 <cmwc-seed> seed-random [
             10 [ random-32 ] replicate
         ] with-random
     ] [
-        4096 iota >array 362436 <cmwc-seed> seed-random [
+        4096 iota >uint-array 362436 <cmwc-seed> seed-random [
             10 [ random-32 ] replicate
         ] with-random
     ] bi =

extra/random/cmwc/cmwc.factor

@@ -1,28 +1,34 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays fry kernel locals math math.bitwise
-random sequences ;
+USING: accessors alien.c-types arrays fry kernel locals math
+math.bitwise random sequences sequences.private
+specialized-arrays specialized-arrays.instances.uint ;
 IN: random.cmwc
 
 ! Multiply-with-carry RNG
 
-TUPLE: cmwc Q a b c i r mod ;
+TUPLE: cmwc
+    { Q uint-array }
+    { a fixnum }
+    { b fixnum }
+    { c fixnum }
+    { i fixnum }
+    { r fixnum }
+    { mod fixnum } ;
 
-TUPLE: cmwc-seed Q c ;
+TUPLE: cmwc-seed { Q uint-array read-only } { c read-only } ;
 
 : <cmwc> ( length a b c -- cmwc )
     cmwc new
         swap >>c
         swap >>b
         swap >>a
-        swap [ 1 - >>i ] [ 0 <array> >>Q ] bi
+        swap [ 1 - >>i ] [ <uint-array> >>Q ] bi
         dup b>> 1 - >>r
-        dup Q>> length 1 - >>mod ;
+        dup Q>> length 1 - >>mod ; inline
 
 : <cmwc-seed> ( Q c -- cmwc-seed )
-    cmwc-seed new
-        swap >>c
-        swap >>Q ; inline
+    cmwc-seed boa ; inline
 
 M: cmwc seed-random
     [ Q>> >>Q ]
@@ -32,23 +38,25 @@ M: cmwc seed-random
 M:: cmwc random-32* ( cmwc -- n )
     cmwc dup mod>> '[ 1 + _ bitand ] change-i
     [ a>> ]
-    [ [ i>> ] [ Q>> ] bi nth * ]
-    [ c>> + ] tri :> t!
+    [ [ i>> ] [ Q>> ] bi nth-unsafe * ]
+    [ c>> + ] tri
 
-    t -32 shift cmwc (>>c)
+    [ >fixnum -32 shift cmwc (>>c) ]
+    [ cmwc [ b>> bitand ] [ c>> + ] bi 32 bits ] bi
 
-    t cmwc [ b>> bitand ] [ c>> + ] bi 64 bits t!
-    t cmwc r>> > [
+    dup cmwc r>> > [
         cmwc [ 1 + ] change-c drop
-        t cmwc b>> - 64 bits t!
+        cmwc b>> - 32 bits
     ] when
 
-    cmwc [ r>> t - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth ;
+    cmwc swap '[ r>> _ - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth-unsafe ;
 
 : cmwc-4096 ( -- cmwc )
     4096
     [ 18782 4294967295 362436 <cmwc> ]
     [
-        '[ [ random-32 ] replicate ] with-system-random
+        '[ [ random-32 ] uint-array{ } replicate-as ] with-system-random
         362436 <cmwc-seed> seed-random
     ] bi ;
+
+: default-cmwc ( -- cmwc ) cmwc-4096 ;

extra/random/lagged-fibonacci/lagged-fibonacci.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types fry kernel literals locals math
-random sequences specialized-arrays namespaces ;
+random sequences specialized-arrays namespaces sequences.private ;
 SPECIALIZED-ARRAY: double
 IN: random.lagged-fibonacci
 
-TUPLE: lagged-fibonacci u pt0 pt1 ;
+TUPLE: lagged-fibonacci { u double-array } { pt0 fixnum } { pt1 fixnum } ;
 
 <PRIVATE
 
@@ -17,10 +17,10 @@ CONSTANT: lagged-fibonacci-max-seed 900000000
 CONSTANT: lagged-fibonacci-sig-bits 24
 
 : normalize-seed ( seed -- seed' )
-    abs lagged-fibonacci-max-seed mod ;
+    abs lagged-fibonacci-max-seed mod ; inline
 
 : adjust-ptr ( ptr -- ptr' )
-    1 - dup 0 < [ drop p-r ] when ;
+    1 - dup 0 < [ drop p-r ] when ; inline
 
 PRIVATE>
 
@@ -50,22 +50,26 @@ M:: lagged-fibonacci seed-random ( lagged-fibonacci seed! -- lagged-fibonacci )
         s
     ] change-each
     lagged-fibonacci p-r >>pt0
-        q-r >>pt1 ;
+        q-r >>pt1 ; inline
 
 : <lagged-fibonacci> ( seed -- lagged-fibonacci )
     lagged-fibonacci new
         p-r 1 + <double-array> >>u
-        swap seed-random ;
+        swap seed-random ; inline
 
 GENERIC: random-float* ( tuple -- r )
  
-: random-float ( -- n ) random-generator get random-float* ;
+: random-float ( -- n ) random-generator get random-float* ; inline
 
 M:: lagged-fibonacci random-float* ( lagged-fibonacci -- x )
-    lagged-fibonacci [ pt0>> ] [ u>> ] bi nth
-    lagged-fibonacci [ pt1>> ] [ u>> ] bi nth - :> uni!
-    uni 0.0 < [ uni 1.0 + uni! ] when
-    uni lagged-fibonacci [ pt0>> ] [ u>> ] bi set-nth
-    lagged-fibonacci [ adjust-ptr ] change-pt0 drop
-    lagged-fibonacci [ adjust-ptr ] change-pt1 drop
-    uni ; inline
+    lagged-fibonacci [ pt0>> ] [ u>> ] bi nth-unsafe
+    lagged-fibonacci [ pt1>> ] [ u>> ] bi nth-unsafe -
+    dup 0.0 < [ 1.0 + ] when
+    [
+        lagged-fibonacci [ pt0>> ] [ u>> ] bi set-nth-unsafe
+        lagged-fibonacci [ adjust-ptr ] change-pt0 drop
+        lagged-fibonacci [ adjust-ptr ] change-pt1 drop
+    ] keep ; inline
+
+: default-lagged-fibonacci ( -- obj )
+    [ random-32 ] with-system-random <lagged-fibonacci> ; inline