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

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"

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

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 ;
 

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,11 +29,21 @@ ARTICLE: "pathnames" "Pathname manipulation"
 { $subsection pathname }
 { $subsection <pathname> } ;
 
+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 and home directories:"
+"Current directory:"
-{ $subsection cwd }
+{ $subsection current-directory }
-{ $subsection cd }
+{ $subsection set-current-directory }
 { $subsection with-directory }
+"Home directory:"
 { $subsection home }
 "Directory listing:"
 { $subsection directory }
@@ -40,18 +52,26 @@ ARTICLE: "directories" "Directories"
 { $subsection make-directory }
 { $subsection make-directories } ;
 
-! ARTICLE: "file-types" "File Types"
+ARTICLE: "file-types" "File Types"
-
+"Platform-independent types:"
-!   { $table { +directory+ "" } }
+{ $subsection +regular-file+ }
-
+{ $subsection +directory+ }
-! ;
+"Platform-specific types:"
-
+{ $subsection +character-device+ }
-ARTICLE: "fs-meta" "File meta-data"
+{ $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:"
@@ -120,39 +140,40 @@ HELP: file-name
 ! need a $class-description file-info
 
 HELP: file-info
-
+{ $values { "path" "a pathname string" } { "info" file-info } }
-  { $values { "path" "a pathname string" }
+{ $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." }
-            { "info" file-info } }
+{ $errors "Throws an error if the file does not exist." } ;
-  { $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
 
 HELP: link-info
-  { $values { "path" "a pathname string" }
+{ $values { "path" "a pathname string" } { "info" "a file-info tuple" } }
-            { "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." } ;
-  { $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
 
 { 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: <file-reader>
 { $values { "path" "a pathname string" } { "encoding" "an encoding descriptor" { "stream" "an input stream" } }
     { "stream" "an input stream" } }
@@ -184,37 +205,73 @@ 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." } ;
+{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." }
+{ $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." } ;
+{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." }
+{ $notes "User code should use " { $link with-directory } " or " { $link set-current-directory } " instead." } ;
 
-{ cd cwd 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 } }
-{ $description "Changes the current working directory for the duration of a quotation's execution." }
+{ $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." } ;
-{ $errors "Windows CE has no concept of ``current directory'', so this word throws an error there." } ;
 
 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." } ;
@@ -260,6 +317,20 @@ HELP: <pathname> ( 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." } ;

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+
 
@@ -176,15 +176,18 @@ SYMBOL: +unknown+
 : directory? ( path -- ? )
     file-info file-info-type +directory+ = ;
 
-! Current working directory
+<PRIVATE
+
 HOOK: cd io-backend ( path -- )
 
 HOOK: cwd io-backend ( -- path )
 
-SYMBOL: current-directory
-
 M: object cwd ( -- path ) "." ;
 
+PRIVATE>
+
+SYMBOL: current-directory
+
 [ cwd current-directory set-global ] "io.files" add-init-hook
 
 : resource-path ( path -- newpath )

core/kernel/kernel-docs.factor

@@ -340,6 +340,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:"
@@ -392,7 +395,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

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

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 -- )
+<PRIVATE
-    { "inferred-effect" "no-effect" } reset-props ;
+
+SYMBOL: visited
+
+: reset-on-redefine { "inferred-effect" "no-effect" } ; inline
+
+: (redefined) ( word -- )
+    dup visited get key? [ drop ] [
+        [ reset-on-redefine reset-props ]
+        [ dup visited get set-at ]
+        [
+            crossref get at keys [ word? ] subset [
+                reset-on-redefine [ word-prop ] with contains?
+            ] subset
+            [ (redefined) ] each
+        ] tri
+    ] if ;
+
+PRIVATE>
+
+: redefined ( word -- )
+    H{ } clone visited [ (redefined) ] with-variable ;
 
 SYMBOL: changed-words
 

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 )

extra/io/unix/files/files.factor

@@ -3,7 +3,8 @@
 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
 

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

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 -- )

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
+math.functions sequences namespaces words symbols system
-combinators.lib io.nonblocking destructors system ;
+combinators.lib io.nonblocking destructors math.bitfields.lib ;
 IN: io.windows.files
 
 SYMBOLS: +read-only+ +hidden+ +system+

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

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
+     [ shift-mod ]
-     [ - ] keep shift-mod bitor ; inline
+     [ [ - ] keep shift-mod ] 3bi bitor ; inline
 
 : bitroll-32 ( n s -- n' ) 32 bitroll ;
 

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 )
+: calculate-y ( n seq -- y )
-    tuck
     [ 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*

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];