From d27252e2321e2ef3f9d218df773592caa32c6b09 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 3 Apr 2008 16:02:37 -0500 Subject: [PATCH 01/11] minor cleanup --- extra/random/mersenne-twister/mersenne-twister.factor | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/extra/random/mersenne-twister/mersenne-twister.factor b/extra/random/mersenne-twister/mersenne-twister.factor index d3a5fad4ca..46f2088440 100755 --- a/extra/random/mersenne-twister/mersenne-twister.factor +++ b/extra/random/mersenne-twister/mersenne-twister.factor @@ -15,14 +15,13 @@ TUPLE: mersenne-twister seq i ; : mt-m 397 ; inline : mt-a HEX: 9908b0df ; inline -: calculate-y ( y1 y2 mt -- y ) - tuck +: calculate-y ( n seq -- y ) [ nth 32 mask-bit ] - [ nth 31 bits ] 2bi* bitor ; inline + [ [ 1+ ] [ nth ] bi* 31 bits ] 2bi bitor ; inline -: (mt-generate) ( n mt-seq -- next-mt ) +: (mt-generate) ( n seq -- next-mt ) [ - [ dup 1+ ] [ calculate-y ] bi* + calculate-y [ 2/ ] [ odd? mt-a 0 ? ] bi bitxor ] [ [ mt-m + ] [ nth ] bi* From 9f085cc10a76febc7b77c314b42f7dcad49dfa4a Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 3 Apr 2008 18:11:22 -0500 Subject: [PATCH 02/11] add using --- extra/io/windows/files/files.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 4f31d2dfce..8bfbff2ba0 100755 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types io.backend io.files io.windows kernel math windows windows.kernel32 windows.time calendar combinators -math.functions sequences namespaces words symbols -combinators.lib io.nonblocking destructors system ; +math.functions sequences namespaces words symbols system +combinators.lib io.nonblocking destructors math.bitfields.lib ; IN: io.windows.files SYMBOLS: +read-only+ +hidden+ +system+ From 4acd587629093d156fe0c20b2822cc3b59ac889f Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 3 Apr 2008 18:34:47 -0500 Subject: [PATCH 03/11] move cwd and cd to private vocabs --- core/debugger/debugger-docs.factor | 3 ++- core/io/files/files-docs.factor | 11 ++++++----- core/io/files/files.factor | 9 ++++++--- extra/editors/jedit/jedit.factor | 2 +- extra/io/unix/files/files.factor | 7 ++++++- extra/io/unix/sockets/sockets.factor | 2 +- extra/io/windows/nt/files/files.factor | 4 ++++ 7 files changed, 26 insertions(+), 12 deletions(-) diff --git a/core/debugger/debugger-docs.factor b/core/debugger/debugger-docs.factor index f8b53d4abc..ca6aa59cc4 100755 --- a/core/debugger/debugger-docs.factor +++ b/core/debugger/debugger-docs.factor @@ -1,6 +1,7 @@ USING: alien arrays generic generic.math help.markup help.syntax kernel math memory strings sbufs vectors io io.files classes -help generic.standard continuations system debugger.private ; +help generic.standard continuations system debugger.private +io.files.private ; IN: debugger ARTICLE: "errors-assert" "Assertions" diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 342967acfc..d1a59f3604 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -197,19 +197,20 @@ HELP: file-contents HELP: cwd { $values { "path" "a pathname string" } } { $description "Outputs the current working directory of the Factor process." } -{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ; +{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } +{ $warning "Modifying the current directory through system calls is unsafe. Use the " { $link with-directory } " word instead." } ; HELP: cd { $values { "path" "a pathname string" } } { $description "Changes the current working directory of the Factor process." } -{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ; +{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } +{ $warning "Modifying the current directory through system calls is unsafe. Use the " { $link with-directory } " word instead." } ; -{ cd cwd with-directory } related-words +{ cd cwd current-directory with-directory } related-words HELP: with-directory { $values { "path" "a pathname string" } { "quot" quotation } } -{ $description "Changes the current working directory for the duration of a quotation's execution." } -{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ; +{ $description "Changes the " { $link current-directory } " variable for the duration of a quotation's execution. Words that use the file-system should call " { $link normalize-path } " in order to obtain a path relative to the current directory." } ; HELP: append-path { $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } } diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 45bf0602f2..08ec78492a 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -176,15 +176,18 @@ SYMBOL: +unknown+ : directory? ( path -- ? ) file-info file-info-type +directory+ = ; -! Current working directory + + +SYMBOL: current-directory + [ cwd current-directory set-global ] "io.files" add-init-hook : resource-path ( path -- newpath ) diff --git a/extra/editors/jedit/jedit.factor b/extra/editors/jedit/jedit.factor index 92320addef..e4f19781ef 100755 --- a/extra/editors/jedit/jedit.factor +++ b/extra/editors/jedit/jedit.factor @@ -4,7 +4,7 @@ USING: arrays definitions io kernel math namespaces parser prettyprint sequences strings words editors io.files io.sockets io.streams.byte-array io.binary math.parser io.encodings.ascii io.encodings.binary -io.encodings.utf8 ; +io.encodings.utf8 io.files.private ; IN: editors.jedit : jedit-server-info ( -- port auth ) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index f6bb3edcde..3085827483 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -3,10 +3,13 @@ USING: io.backend io.nonblocking io.unix.backend io.files io unix unix.stat unix.time kernel math continuations math.bitfields byte-arrays alien combinators calendar -io.encodings.binary accessors sequences strings system ; +io.encodings.binary accessors sequences strings system +io.files.private ; IN: io.unix.files + ] [ ] bi getcwd [ (io-error) ] unless* ; @@ -14,6 +17,8 @@ M: unix cwd ( -- path ) M: unix cd ( path -- ) chdir io-error ; +PRIVATE> + : read-flags O_RDONLY ; inline : open-read ( path -- fd ) diff --git a/extra/io/unix/sockets/sockets.factor b/extra/io/unix/sockets/sockets.factor index 477757e0ed..a54205a878 100755 --- a/extra/io/unix/sockets/sockets.factor +++ b/extra/io/unix/sockets/sockets.factor @@ -7,7 +7,7 @@ USING: alien alien.c-types generic io kernel math namespaces io.nonblocking parser threads unix sequences byte-arrays io.sockets io.binary io.unix.backend io.streams.duplex io.sockets.impl math.parser continuations libc -combinators io.backend io.files system ; +combinators io.backend io.files io.files.private system ; IN: io.unix.sockets : pending-init-error ( port -- ) diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 7bac540ddc..590bc59023 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -5,6 +5,8 @@ alien.c-types alien.arrays sequences combinators combinators.lib sequences.lib ascii splitting alien strings assocs namespaces ; IN: io.windows.nt.files + [ GetCurrentDirectory win32-error=0/f ] keep @@ -13,6 +15,8 @@ M: winnt cwd M: winnt cd SetCurrentDirectory win32-error=0/f ; +PRIVATE> + : unicode-prefix ( -- seq ) "\\\\?\\" ; inline From 344a98802ff651d5e078636ed0983eaecb4e18cb Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 3 Apr 2008 18:36:53 -0500 Subject: [PATCH 04/11] tweak word --- extra/math/bitfields/lib/lib.factor | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/extra/math/bitfields/lib/lib.factor b/extra/math/bitfields/lib/lib.factor index 4a8f3835ca..72b33b9ae7 100644 --- a/extra/math/bitfields/lib/lib.factor +++ b/extra/math/bitfields/lib/lib.factor @@ -4,7 +4,6 @@ IN: math.bitfields.lib : clear-bit ( x n -- y ) 2^ bitnot bitand ; foldable : set-bit ( x n -- y ) 2^ bitor ; foldable : bit-clear? ( x n -- ? ) 2^ bitand zero? ; foldable -: bit-set? ( x n -- ? ) bit-clear? not ; foldable : unmask ( x n -- ? ) bitnot bitand ; foldable : unmask? ( x n -- ? ) unmask 0 > ; foldable : mask ( x n -- ? ) bitand ; foldable @@ -18,8 +17,8 @@ IN: math.bitfields.lib : bitroll ( x s w -- y ) [ wrap ] keep - [ shift-mod ] 3keep - [ - ] keep shift-mod bitor ; inline + [ shift-mod ] + [ [ - ] keep shift-mod ] 3bi bitor ; inline : bitroll-32 ( n s -- n' ) 32 bitroll ; From 82f3239012690afbc3f884cb5b6777d63948e976 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 3 Apr 2008 18:40:51 -0500 Subject: [PATCH 05/11] remove private stuff --- extra/io/unix/files/files.factor | 4 ---- extra/io/windows/nt/files/files.factor | 4 ---- 2 files changed, 8 deletions(-) diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 3085827483..39c18b4601 100755 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -8,8 +8,6 @@ io.files.private ; IN: io.unix.files - ] [ ] bi getcwd [ (io-error) ] unless* ; @@ -17,8 +15,6 @@ M: unix cwd ( -- path ) M: unix cd ( path -- ) chdir io-error ; -PRIVATE> - : read-flags O_RDONLY ; inline : open-read ( path -- fd ) diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 590bc59023..7bac540ddc 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -5,8 +5,6 @@ alien.c-types alien.arrays sequences combinators combinators.lib sequences.lib ascii splitting alien strings assocs namespaces ; IN: io.windows.nt.files - [ GetCurrentDirectory win32-error=0/f ] keep @@ -15,8 +13,6 @@ M: winnt cwd M: winnt cd SetCurrentDirectory win32-error=0/f ; -PRIVATE> - : unicode-prefix ( -- seq ) "\\\\?\\" ; inline From 45b0dd9042625584bcd936027cd194c67721f8f7 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 3 Apr 2008 18:41:12 -0500 Subject: [PATCH 06/11] add using --- extra/io/windows/nt/files/files.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 7bac540ddc..3232ab6ff3 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -2,7 +2,8 @@ USING: continuations destructors io.buffers io.files io.backend io.timeouts io.nonblocking io.windows io.windows.nt.backend kernel libc math threads windows windows.kernel32 system alien.c-types alien.arrays sequences combinators combinators.lib -sequences.lib ascii splitting alien strings assocs namespaces ; +sequences.lib ascii splitting alien strings assocs namespaces +io.files.private ; IN: io.windows.nt.files M: winnt cwd From 36fc0b26ac9078241223853ae6c50cc002eaaa14 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 3 Apr 2008 18:51:53 -0500 Subject: [PATCH 07/11] fix load error --- extra/io/unix/launcher/launcher.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 8e5531a40c..5f0a9b96cb 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -4,7 +4,7 @@ USING: io io.backend io.launcher io.nonblocking io.unix.backend io.unix.files io.nonblocking sequences kernel namespaces math system alien.c-types debugger continuations arrays assocs combinators unix.process strings threads unix -io.unix.launcher.parser accessors io.files ; +io.unix.launcher.parser accessors io.files io.files.private ; IN: io.unix.launcher ! Search unix first From 653bc1cd80819cbfb81f2082a8240cfda7a54ab7 Mon Sep 17 00:00:00 2001 From: erg Date: Thu, 3 Apr 2008 18:59:04 -0500 Subject: [PATCH 08/11] update docs --- core/io/files/files-docs.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index d1a59f3604..85e17ded46 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -28,11 +28,14 @@ ARTICLE: "pathnames" "Pathname manipulation" { $subsection } ; ARTICLE: "directories" "Directories" -"Current and home directories:" +"Current directory:" +{ $subsection with-directory } +{ $subsection current-directory } +"Home directory:" +{ $subsection home } +"Current system directory:" { $subsection cwd } { $subsection cd } -{ $subsection with-directory } -{ $subsection home } "Directory listing:" { $subsection directory } { $subsection directory* } From e22a7a610047cc2bf768940ba64543c5f4b94937 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 3 Apr 2008 21:39:52 -0500 Subject: [PATCH 09/11] update docs pl0x --- core/io/files/files-docs.factor | 155 +++++++++++++++++++++++--------- core/io/files/files.factor | 8 +- 2 files changed, 115 insertions(+), 48 deletions(-) diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index 85e17ded46..1dd96a13fc 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -11,7 +11,9 @@ ARTICLE: "file-streams" "Reading and writing files" { $subsection with-file-reader } { $subsection with-file-writer } { $subsection with-file-appender } +{ $subsection set-file-contents } { $subsection file-contents } +{ $subsection set-file-lines } { $subsection file-lines } ; ARTICLE: "pathnames" "Pathname manipulation" @@ -27,15 +29,22 @@ ARTICLE: "pathnames" "Pathname manipulation" { $subsection pathname } { $subsection } ; +ARTICLE: "symbolic-links" "Symbolic links" +"Reading and creating links:" +{ $subsection read-link } +{ $subsection make-link } +"Copying links:" +{ $subsection copy-link } +"Not all operating systems support symbolic links." +{ $see-also link-info } ; + ARTICLE: "directories" "Directories" "Current directory:" -{ $subsection with-directory } { $subsection current-directory } +{ $subsection set-current-directory } +{ $subsection with-directory } "Home directory:" { $subsection home } -"Current system directory:" -{ $subsection cwd } -{ $subsection cd } "Directory listing:" { $subsection directory } { $subsection directory* } @@ -43,18 +52,26 @@ ARTICLE: "directories" "Directories" { $subsection make-directory } { $subsection make-directories } ; -! ARTICLE: "file-types" "File Types" - -! { $table { +directory+ "" } } - -! ; - -ARTICLE: "fs-meta" "File meta-data" +ARTICLE: "file-types" "File Types" +"Platform-independent types:" +{ $subsection +regular-file+ } +{ $subsection +directory+ } +"Platform-specific types:" +{ $subsection +character-device+ } +{ $subsection +block-device+ } +{ $subsection +fifo+ } +{ $subsection +symbolic-link+ } +{ $subsection +socket+ } +{ $subsection +unknown+ } ; +ARTICLE: "fs-meta" "File metadata" +"Querying file-system metadata:" { $subsection file-info } { $subsection link-info } { $subsection exists? } -{ $subsection directory? } ; +{ $subsection directory? } +"File types:" +{ $subsection "file-types" } ; ARTICLE: "delete-move-copy" "Deleting, moving, copying files" "Operations for deleting and copying files come in two forms:" @@ -123,39 +140,40 @@ HELP: file-name ! need a $class-description file-info HELP: file-info - - { $values { "path" "a pathname string" } - { "info" file-info } } - { $description "Queries the file system for meta data. " - "If path refers to a symbolic link, it is followed." - "If the file does not exist, an exception is thrown." } - - { $class-description "File meta data" } - - { $table - { "type" { "One of the following:" - { $list { $link +regular-file+ } - { $link +directory+ } - { $link +symbolic-link+ } } } } - - { "size" "Size of the file in bytes" } - { "modified" "Last modification timestamp." } } - - ; - -! need a see also to link-info +{ $values { "path" "a pathname string" } { "info" file-info } } +{ $description "Queries the file system for metadata. If " { $snippet "path" } " refers to a symbolic link, it is followed. See the article " { $link "file-types" } " for a list of metadata symbols." } +{ $errors "Throws an error if the file does not exist." } ; HELP: link-info - { $values { "path" "a pathname string" } - { "info" "a file-info tuple" } } - { $description "Queries the file system for meta data. " - "If path refers to a symbolic link, information about " - "the symbolic link itself is returned." - "If the file does not exist, an exception is thrown." } ; -! need a see also to file-info +{ $values { "path" "a pathname string" } { "info" "a file-info tuple" } } +{ $description "Queries the file system for metadata. If path refers to a symbolic link, information about the symbolic link itself is returned. If the file does not exist, an exception is thrown." } ; { file-info link-info } related-words +HELP: +regular-file+ +{ $description "A regular file. This type exists on all platforms. See " { $link "file-streams" } " for words operating on files." } ; + +HELP: +directory+ +{ $description "A directory. This type exists on all platforms. See " { $link "directories" } " for words operating on directories." } ; + +HELP: +symbolic-link+ +{ $description "A symbolic link file. This type is currently implemented on Unix platforms only. See " { $link "symbolic-links" } " for words operating on symbolic links." } ; + +HELP: +character-device+ +{ $description "A Unix character device file. This type exists on unix platforms only." } ; + +HELP: +block-device+ +{ $description "A Unix block device file. This type exists on unix platforms only." } ; + +HELP: +fifo+ +{ $description "A Unix fifo file. This type exists on unix platforms only." } ; + +HELP: +socket+ +{ $description "A Unix socket file. This type exists on unix platforms only." } ; + +HELP: +unknown+ +{ $description "A unknown file type." } ; + HELP: { $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" { "stream" "an input stream" } } { "stream" "an input stream" } } @@ -187,29 +205,44 @@ HELP: with-file-appender { $description "Opens a file for appending using the given encoding and calls the quotation using " { $link with-stream } "." } { $errors "Throws an error if the file cannot be opened for writing." } ; +HELP: set-file-lines +{ $values { "seq" "an array of strings" } { "path" "a pathname string" } { "encoding" "an encoding descriptor" } } +{ $description "Sets the contents of a file to the strings with the given encoding." } +{ $errors "Throws an error if the file cannot be opened for writing." } ; + HELP: file-lines { $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "seq" "an array of strings" } } { $description "Opens the file at the given path using the given encoding, and returns a list of the lines in that file." } +{ $errors "Throws an error if the file cannot be opened for reading." } ; + +HELP: set-file-contents +{ $values { "str" "a string" } { "path" "a pathname string" } { "encoding" "an encoding descriptor" } } +{ $description "Sets the contents of a file to a string with the given encoding." } { $errors "Throws an error if the file cannot be opened for writing." } ; HELP: file-contents { $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" } { "str" "a string" } } { $description "Opens the file at the given path using the given encoding, and the contents of that file as a string." } -{ $errors "Throws an error if the file cannot be opened for writing." } ; +{ $errors "Throws an error if the file cannot be opened for reading." } ; + +{ set-file-lines file-lines set-file-contents file-contents } related-words HELP: cwd { $values { "path" "a pathname string" } } { $description "Outputs the current working directory of the Factor process." } { $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } -{ $warning "Modifying the current directory through system calls is unsafe. Use the " { $link with-directory } " word instead." } ; +{ $notes "User code should use " { $link with-directory } " or " { $link set-current-directory } " instead." } ; HELP: cd { $values { "path" "a pathname string" } } { $description "Changes the current working directory of the Factor process." } { $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } -{ $warning "Modifying the current directory through system calls is unsafe. Use the " { $link with-directory } " word instead." } ; +{ $notes "User code should use " { $link with-directory } " or " { $link set-current-directory } " instead." } ; -{ cd cwd current-directory with-directory } related-words +{ cd cwd current-directory set-current-directory with-directory } related-words + +HELP: current-directory +{ $description "A variable holding the current directory. Words that use the filesystem do so in relation to this variable. On startup, an init hook sets this word to the directory from which Factor was run." } ; HELP: with-directory { $values { "path" "a pathname string" } { "quot" quotation } } @@ -219,6 +252,26 @@ HELP: append-path { $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } } { $description "Concatenates two pathnames." } ; +HELP: prepend-path +{ $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } } +{ $description "Concatenates two pathnames." } ; + +{ append-path prepend-path } related-words + +HELP: absolute-path? +{ $values { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Tests if a pathname is absolute. Examples of absolute pathnames are " { $snippet "/foo/bar" } " on Unix and " { $snippet "c:\\foo\\bar" } " on Windows." } ; + +HELP: windows-absolute-path? +{ $values { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Tests if a pathname is absolute on Windows. Examples of absolute pathnames on Windows are " { $snippet "c:\\foo\\bar" } " and " { $snippet "\\\\?\\c:\\foo\\bar" } " for absolute Unicode pathnames." } ; + +HELP: root-directory? +{ $values { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Tests if a pathname is a root directory. Examples of root directory pathnames are " { $snippet "/" } " on Unix and " { $snippet "c:\\" } " on Windows." } ; + +{ absolute-path? windows-absolute-path? root-directory? } related-words + HELP: exists? { $values { "path" "a pathname string" } { "?" "a boolean" } } { $description "Tests if the file named by " { $snippet "path" } " exists." } ; @@ -264,6 +317,20 @@ HELP: ( str -- pathname ) { $values { "str" "a pathname string" } { "pathname" pathname } } { $description "Creates a new " { $link pathname } "." } ; +HELP: make-link +{ $values { "target" "a path to the symbolic link's target" } { "symlink" "a path to new symbolic link" } } +{ $description "Creates a symbolic link." } ; + +HELP: read-link +{ $values { "symlink" "a path to an existing symbolic link" } { "path" "the path pointed to by the symbolic link" } } +{ $description "Reads the symbolic link and returns its target path." } ; + +HELP: copy-link +{ $values { "target" "a path to an existing symlink" } { "symlink" "a path to a new symbolic link" } } +{ $description "Copies a symbolic link without following the link." } ; + +{ make-link read-link copy-link } related-words + HELP: home { $values { "dir" string } } { $description "Outputs the user's home directory." } ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 08ec78492a..ed1b94e556 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -153,19 +153,19 @@ HOOK: file-info io-backend ( path -- info ) ! Symlinks HOOK: link-info io-backend ( path -- info ) -HOOK: make-link io-backend ( path1 path2 -- ) +HOOK: make-link io-backend ( target symlink -- ) -HOOK: read-link io-backend ( path -- info ) +HOOK: read-link io-backend ( symlink -- path ) -: copy-link ( path1 path2 -- ) +: copy-link ( target symlink -- ) >r read-link r> make-link ; SYMBOL: +regular-file+ SYMBOL: +directory+ +SYMBOL: +symbolic-link+ SYMBOL: +character-device+ SYMBOL: +block-device+ SYMBOL: +fifo+ -SYMBOL: +symbolic-link+ SYMBOL: +socket+ SYMBOL: +unknown+ From 1e538ccd03cf725fe71fe6dec5b2acd7e8507bbb Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 3 Apr 2008 22:16:37 -0500 Subject: [PATCH 10/11] more docs --- core/kernel/kernel-docs.factor | 5 ++++- core/math/math-docs.factor | 23 +++++++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 53618d4628..6c71db9e61 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -341,6 +341,9 @@ HELP: set-callstack ( cs -- ) HELP: clear { $description "Clears the data stack." } ; +HELP: build +{ $description "The current build number. Factor increments this number whenever a new boot image is created." } ; + HELP: hashcode* { $values { "depth" integer } { "obj" object } { "code" fixnum } } { $contract "Outputs the hashcode of an object. The hashcode operation must satisfy the following properties:" @@ -393,7 +396,7 @@ HELP: identity-tuple HELP: <=> { $values { "obj1" object } { "obj2" object } { "n" real } } { $contract - "Compares two objects using an intrinsic partial order, for example, the natural order for real numbers and lexicographic order for strings." + "Compares two objects using an intrinsic total order, for example, the natural order for real numbers and lexicographic order for strings." $nl "The output value is one of the following:" { $list diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor index 6ec1c5790f..5533c00090 100755 --- a/core/math/math-docs.factor +++ b/core/math/math-docs.factor @@ -83,6 +83,29 @@ HELP: >= { $values { "x" real } { "y" real } { "?" "a boolean" } } { $description "Tests if " { $snippet "x" } " is greater than or equal to " { $snippet "y" } "." } ; +HELP: before? +{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "obj1" } " comes before " { $snippet "obj2" } " using an intrinsic total order." } +{ $notes "Implemented using " { $link <=> } "." } ; + +HELP: after? +{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "obj1" } " comes after " { $snippet "obj2" } " using an intrinsic total order." } +{ $notes "Implemented using " { $link <=> } "." } ; + +HELP: before=? +{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "obj1" } " comes before or equals " { $snippet "obj2" } " using an intrinsic total order." } +{ $notes "Implemented using " { $link <=> } "." } ; + +HELP: after=? +{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } } +{ $description "Tests if " { $snippet "obj1" } " comes after or equals " { $snippet "obj2" } " using an intrinsic total order." } +{ $notes "Implemented using " { $link <=> } "." } ; + +{ before? after? before=? after=? } related-words + + HELP: + { $values { "x" number } { "y" number } { "z" number } } { $description From 3a374f2045ecd40df9bf80794bdea76bbef38a38 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 4 Apr 2008 07:08:03 -0500 Subject: [PATCH 11/11] Fix amazing performance regression --- core/definitions/definitions-docs.factor | 7 ------- core/definitions/definitions.factor | 7 ------- core/words/words.factor | 24 ++++++++++++++++++++++-- vm/types.c | 2 +- 4 files changed, 23 insertions(+), 17 deletions(-) diff --git a/core/definitions/definitions-docs.factor b/core/definitions/definitions-docs.factor index d855a14be9..d43c61ff70 100755 --- a/core/definitions/definitions-docs.factor +++ b/core/definitions/definitions-docs.factor @@ -12,8 +12,6 @@ $nl { $subsection forget } "Definitions can answer a sequence of definitions they directly depend on:" { $subsection uses } -"When a definition is changed, all definitions which depend on it are notified via a hook:" -{ $subsection redefined* } "Definitions must implement a few operations used for printing them in source form:" { $subsection synopsis* } { $subsection definer } @@ -108,11 +106,6 @@ HELP: usage { $description "Outputs a sequence of definitions that directly call the given definition." } { $notes "The sequence might include the definition itself, if it is a recursive word." } ; -HELP: redefined* -{ $values { "defspec" "a definition specifier" } } -{ $contract "Updates the definition to cope with a callee being redefined." } -$low-level-note ; - HELP: unxref { $values { "defspec" "a definition specifier" } } { $description "Remove edges leaving the vertex which represents the definition from the " { $link crossref } " graph." } diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index cec5109909..6ee21fc016 100755 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -42,13 +42,6 @@ M: object uses drop f ; : usage ( defspec -- seq ) \ f or crossref get at keys ; -GENERIC: redefined* ( defspec -- ) - -M: object redefined* drop ; - -: redefined ( defspec -- ) - [ crossref get at ] closure [ drop redefined* ] assoc-each ; - : unxref ( defspec -- ) dup uses crossref get remove-vertex ; diff --git a/core/words/words.factor b/core/words/words.factor index 059815e952..2510c50347 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -121,8 +121,28 @@ SYMBOL: +called+ compiled-usage [ nip +inlined+ eq? ] assoc-subset update ] with each keys ; -M: word redefined* ( word -- ) - { "inferred-effect" "no-effect" } reset-props ; + + +: redefined ( word -- ) + H{ } clone visited [ (redefined) ] with-variable ; SYMBOL: changed-words diff --git a/vm/types.c b/vm/types.c index 24bb4cb3ca..f88c3ef3cb 100755 --- a/vm/types.c +++ b/vm/types.c @@ -42,7 +42,7 @@ F_WORD *allot_word(CELL vocab, CELL name) UNREGISTER_ROOT(name); UNREGISTER_ROOT(vocab); - word->hashcode = tag_fixnum(rand()); + word->hashcode = tag_fixnum((rand() << 16) ^ rand()); word->vocabulary = vocab; word->name = name; word->def = userenv[UNDEFINED_ENV];