From 4cec00f2094029a61f4440792955773424716f8a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 05:48:37 -0500 Subject: [PATCH 01/11] improve io.pathnames docs --- core/io/pathnames/pathnames-docs.factor | 55 +++++++++++++++++------- core/io/pathnames/pathnames-tests.factor | 2 +- core/io/pathnames/pathnames.factor | 16 ++++--- core/syntax/syntax-docs.factor | 2 +- 4 files changed, 52 insertions(+), 23 deletions(-) diff --git a/core/io/pathnames/pathnames-docs.factor b/core/io/pathnames/pathnames-docs.factor index db8a0d46ec..cc65d5da5d 100644 --- a/core/io/pathnames/pathnames-docs.factor +++ b/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? @@ -7,7 +7,7 @@ HELP: path-separator? { $description "Tests if the code point is a platform-specific path separator." } { $examples "On Unix:" - { $example "USING: io.pathnames prettyprint ;" "CHAR: / path-separator? ." "t" } + { $example "USING: io.pathnames.private prettyprint ;" "CHAR: / path-separator? ." "t" } } ; HELP: parent-directory @@ -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,7 +89,7 @@ HELP: pathname { $class-description "Class of path name objects. Path name objects can be created by calling " { $link } "." } ; HELP: normalize-path -{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } } +{ $values { "string" "a pathname string" } { "string'" "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." } { $notes "High-level words, such as " { $link } " 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." } { $examples @@ -90,7 +102,8 @@ HELP: normalize-path 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: { $values { "string" "a pathname string" } { "pathname" pathname } } @@ -98,20 +111,28 @@ HELP: 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 +141,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" diff --git a/core/io/pathnames/pathnames-tests.factor b/core/io/pathnames/pathnames-tests.factor index c3e419e60d..7a98a47f42 100644 --- a/core/io/pathnames/pathnames-tests.factor +++ b/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 diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index 6a49ed5797..4a38d2e4aa 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -6,14 +6,16 @@ IN: io.pathnames SYMBOL: current-directory + + ERROR: no-parent-directory path ; : parent-directory ( path -- parent ) @@ -61,8 +65,6 @@ ERROR: no-parent-directory path ; [ nip ] } cond ; -PRIVATE> - : windows-absolute-path? ( path -- path ? ) { { [ dup "\\\\?\\" head? ] [ t ] } @@ -87,7 +89,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 +111,7 @@ PRIVATE> ] } cond ; -: prepend-path ( str1 str2 -- str ) +: prepend-path ( path1 path2 -- path ) swap append-path ; inline : file-name ( path -- string ) diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 854db7a0ce..df78083f30 100644 --- a/core/syntax/syntax-docs.factor +++ b/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: ( From 7e2fdfe1ec7e031c711d286fe5d0b4590d7cbaf9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 05:48:51 -0500 Subject: [PATCH 02/11] fix using for io.pathnames changes --- basis/io/files/unix/unix-tests.factor | 2 +- basis/io/files/windows/nt/nt-tests.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/files/unix/unix-tests.factor b/basis/io/files/unix/unix-tests.factor index d2f4494b0c..1e449bc18a 100644 --- a/basis/io/files/unix/unix-tests.factor +++ b/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.tests ; IN: io.files.unix.tests [ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test diff --git a/basis/io/files/windows/nt/nt-tests.factor b/basis/io/files/windows/nt/nt-tests.factor index b3bfecaafc..a142bb844e 100644 --- a/basis/io/files/windows/nt/nt-tests.factor +++ b/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 From 3db0ad12e81619cb609a2cbb23d271e0c69340bd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 15:00:27 -0500 Subject: [PATCH 03/11] ricing lagged-fibonacci --- extra/random/lagged-fibonacci/lagged-fibonacci.factor | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/extra/random/lagged-fibonacci/lagged-fibonacci.factor b/extra/random/lagged-fibonacci/lagged-fibonacci.factor index 45a4b132dd..8c5b29ef65 100644 --- a/extra/random/lagged-fibonacci/lagged-fibonacci.factor +++ b/extra/random/lagged-fibonacci/lagged-fibonacci.factor @@ -5,7 +5,7 @@ random sequences specialized-arrays namespaces ; SPECIALIZED-ARRAY: double IN: random.lagged-fibonacci -TUPLE: lagged-fibonacci u pt0 pt1 ; +TUPLE: lagged-fibonacci { u double-array } { pt0 fixnum } { pt1 fixnum } ; @@ -59,7 +59,7 @@ M:: lagged-fibonacci seed-random ( lagged-fibonacci seed! -- lagged-fibonacci ) 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 @@ -69,3 +69,6 @@ M:: lagged-fibonacci random-float* ( lagged-fibonacci -- x ) lagged-fibonacci [ adjust-ptr ] change-pt0 drop lagged-fibonacci [ adjust-ptr ] change-pt1 drop uni ; inline + +: default-lagged-fibonacci ( -- obj ) + [ random-32 ] with-system-random ; From 69f5381d34a764c3f3e434c64b6942161920b022 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 15:07:05 -0500 Subject: [PATCH 04/11] ricing random.cmwc --- extra/random/cmwc/cmwc-tests.factor | 9 +++++---- extra/random/cmwc/cmwc.factor | 26 +++++++++++++++++--------- 2 files changed, 22 insertions(+), 13 deletions(-) diff --git a/extra/random/cmwc/cmwc-tests.factor b/extra/random/cmwc/cmwc-tests.factor index 6e3f4ac178..8dc9f8764f 100644 --- a/extra/random/cmwc/cmwc-tests.factor +++ b/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 seed-random [ + 4096 iota >uint-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] unit-test [ t ] [ cmwc-4096 [ - 4096 iota >array 362436 seed-random [ + 4096 iota >uint-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] [ - 4096 iota >array 362436 seed-random [ + 4096 iota >uint-array 362436 seed-random [ 10 [ random-32 ] replicate ] with-random ] bi = diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index 00258257be..b38dd0a28a 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/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 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 } ; : ( length a b c -- cmwc ) cmwc new swap >>c swap >>b swap >>a - swap [ 1 - >>i ] [ 0 >>Q ] bi + swap [ 1 - >>i ] [ >>Q ] bi dup b>> 1 - >>r dup Q>> length 1 - >>mod ; : ( Q c -- cmwc-seed ) - cmwc-seed new - swap >>c - swap >>Q ; inline + cmwc-seed boa ; inline M: cmwc seed-random [ Q>> >>Q ] @@ -49,6 +55,8 @@ M:: cmwc random-32* ( cmwc -- n ) 4096 [ 18782 4294967295 362436 ] [ - '[ [ random-32 ] replicate ] with-system-random + '[ [ random-32 ] uint-array{ } replicate-as ] with-system-random 362436 seed-random ] bi ; + +: default-cmwc ( -- cmwc ) cmwc-4096 ; From 1375e32c62ebcca489e143c1b030448a406600a8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 15:19:30 -0500 Subject: [PATCH 05/11] make cmwc only 32 bits wide. oops, this speeds up everything --- extra/random/cmwc/cmwc.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index b38dd0a28a..6b5b8caee2 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/extra/random/cmwc/cmwc.factor @@ -43,10 +43,10 @@ M:: cmwc random-32* ( cmwc -- n ) t -32 shift cmwc (>>c) - t cmwc [ b>> bitand ] [ c>> + ] bi 64 bits t! + t cmwc [ b>> bitand ] [ c>> + ] bi 32 bits t! t cmwc r>> > [ cmwc [ 1 + ] change-c drop - t cmwc b>> - 64 bits t! + t cmwc b>> - 32 bits t! ] when cmwc [ r>> t - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth ; From 67b41df21fcfe32d2acc25d66846483d7356fcc3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 15:47:19 -0500 Subject: [PATCH 06/11] 2x speedup on lagged-fibonacci after removing mutable local --- .../lagged-fibonacci/lagged-fibonacci.factor | 23 ++++++++++--------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/extra/random/lagged-fibonacci/lagged-fibonacci.factor b/extra/random/lagged-fibonacci/lagged-fibonacci.factor index 8c5b29ef65..c31620dd6c 100644 --- a/extra/random/lagged-fibonacci/lagged-fibonacci.factor +++ b/extra/random/lagged-fibonacci/lagged-fibonacci.factor @@ -1,7 +1,7 @@ ! 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 @@ -50,25 +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 : ( seed -- lagged-fibonacci ) lagged-fibonacci new p-r 1 + >>u - swap seed-random ; + swap seed-random ; inline GENERIC: random-float* ( tuple -- r ) : 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 ; + [ random-32 ] with-system-random ; inline From 748631ab356d643236547c180dc06e8cd809553c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 15:50:33 -0500 Subject: [PATCH 07/11] inline some words --- extra/random/cmwc/cmwc.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index 6b5b8caee2..8a52735133 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/extra/random/cmwc/cmwc.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.c-types arrays fry kernel locals math -math.bitwise random sequences specialized-arrays -specialized-arrays.instances.uint ; +math.bitwise random sequences sequences.private +specialized-arrays specialized-arrays.instances.uint ; IN: random.cmwc ! Multiply-with-carry RNG @@ -25,7 +25,7 @@ TUPLE: cmwc-seed { Q uint-array read-only } { c read-only } ; swap >>a swap [ 1 - >>i ] [ >>Q ] bi dup b>> 1 - >>r - dup Q>> length 1 - >>mod ; + dup Q>> length 1 - >>mod ; inline : ( Q c -- cmwc-seed ) cmwc-seed boa ; inline @@ -38,7 +38,7 @@ M: cmwc seed-random M:: cmwc random-32* ( cmwc -- n ) cmwc dup mod>> '[ 1 + _ bitand ] change-i [ a>> ] - [ [ i>> ] [ Q>> ] bi nth * ] + [ [ i>> ] [ Q>> ] bi nth-unsafe * ] [ c>> + ] tri :> t! t -32 shift cmwc (>>c) @@ -49,7 +49,7 @@ M:: cmwc random-32* ( cmwc -- n ) t cmwc b>> - 32 bits t! ] when - cmwc [ r>> t - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth ; + cmwc [ r>> t - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth-unsafe ; : cmwc-4096 ( -- cmwc ) 4096 From 741f19ab2f9c5aa1abca531d95e47c58efc710a7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 15:53:45 -0500 Subject: [PATCH 08/11] remove yet another slow mutable local --- extra/random/cmwc/cmwc.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index 8a52735133..e9c93c80db 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/extra/random/cmwc/cmwc.factor @@ -39,17 +39,17 @@ M:: cmwc random-32* ( cmwc -- n ) cmwc dup mod>> '[ 1 + _ bitand ] change-i [ a>> ] [ [ i>> ] [ Q>> ] bi nth-unsafe * ] - [ c>> + ] tri :> t! + [ c>> + ] tri - t -32 shift cmwc (>>c) + [ -32 shift cmwc (>>c) ] - t cmwc [ b>> bitand ] [ c>> + ] bi 32 bits t! - t cmwc r>> > [ + [ cmwc [ b>> bitand ] [ c>> + ] bi 32 bits ] bi + dup cmwc r>> > [ cmwc [ 1 + ] change-c drop - t cmwc b>> - 32 bits t! + cmwc b>> - 32 bits ] when - cmwc [ r>> t - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth-unsafe ; + cmwc swap '[ r>> _ - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth-unsafe ; : cmwc-4096 ( -- cmwc ) 4096 From 65a24191341873ceb602708a47bc77269dcddfdc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 16:08:59 -0500 Subject: [PATCH 09/11] remove most of the overhead in cmwc, it's fast now --- extra/random/cmwc/cmwc.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor index e9c93c80db..1be58d489f 100644 --- a/extra/random/cmwc/cmwc.factor +++ b/extra/random/cmwc/cmwc.factor @@ -41,9 +41,9 @@ M:: cmwc random-32* ( cmwc -- n ) [ [ i>> ] [ Q>> ] bi nth-unsafe * ] [ c>> + ] tri - [ -32 shift cmwc (>>c) ] - + [ >fixnum -32 shift cmwc (>>c) ] [ cmwc [ b>> bitand ] [ c>> + ] bi 32 bits ] bi + dup cmwc r>> > [ cmwc [ 1 + ] change-c drop cmwc b>> - 32 bits From 6af901a35dbd619a9c57fd2fcad24f168f46d863 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 16:59:25 -0500 Subject: [PATCH 10/11] make words public again --- core/io/pathnames/pathnames-docs.factor | 13 +++++++++++-- core/io/pathnames/pathnames.factor | 4 ---- 2 files changed, 11 insertions(+), 6 deletions(-) diff --git a/core/io/pathnames/pathnames-docs.factor b/core/io/pathnames/pathnames-docs.factor index cc65d5da5d..8b293da3cc 100644 --- a/core/io/pathnames/pathnames-docs.factor +++ b/core/io/pathnames/pathnames-docs.factor @@ -7,7 +7,7 @@ HELP: path-separator? { $description "Tests if the code point is a platform-specific path separator." } { $examples "On Unix:" - { $example "USING: io.pathnames.private prettyprint ;" "CHAR: / path-separator? ." "t" } + { $example "USING: io.pathnames prettyprint ;" "CHAR: / path-separator? ." "t" } } ; HELP: parent-directory @@ -90,8 +90,9 @@ HELP: pathname HELP: normalize-path { $values { "string" "a pathname string" } { "string'" "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." } +{ $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 } " 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 @@ -100,6 +101,14 @@ 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 "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." } diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index 4a38d2e4aa..e8672e6771 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -6,8 +6,6 @@ IN: io.pathnames SYMBOL: current-directory - - ERROR: no-parent-directory path ; : parent-directory ( path -- parent ) From 739f61bc5627deab2d2dc4c16190df7c164428b1 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Oct 2009 19:56:48 -0500 Subject: [PATCH 11/11] fix using --- basis/io/files/unix/unix-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/files/unix/unix-tests.factor b/basis/io/files/unix/unix-tests.factor index 1e449bc18a..93e499a576 100644 --- a/basis/io/files/unix/unix-tests.factor +++ b/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 io.pathnames.tests ; +grouping io.pathnames.private ; IN: io.files.unix.tests [ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test