steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2008-04-04 07:09:21 -05:00
parent c8588a37ee 3a374f2045
commit 8d39853248
17 changed files with 193 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
core/debugger/debugger-docs.factor
View File

@ -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"

7
core/definitions/definitions-docs.factor
View File

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

7
core/definitions/definitions.factor
View File

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

161
core/io/files/files-docs.factor
View File

@ -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:"
{ $subsection cwd }
{ $subsection cd }
"Current directory:"
{ $subsection current-directory }
{ $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"
! { $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:"
@ -120,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: <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." }
{ $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" } }
{ $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." } ;

17
core/io/files/files.factor
View File

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

5
core/kernel/kernel-docs.factor
View File

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

23
core/math/math-docs.factor
View File

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

24
core/words/words.factor
View File

@ -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 ;
<PRIVATE
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

2
extra/editors/jedit/jedit.factor
View File

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

3
extra/io/unix/files/files.factor
View File

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

2
extra/io/unix/launcher/launcher.factor
View File

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

2
extra/io/unix/sockets/sockets.factor
View File

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

4
extra/io/windows/files/files.factor
View File

@ -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+

3
extra/io/windows/nt/files/files.factor
View File

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

5
extra/math/bitfields/lib/lib.factor
View File

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

9
extra/random/mersenne-twister/mersenne-twister.factor
View File

@ -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*

2
vm/types.c
View File

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