From b1016e6ea5355cb867c5f1a2af22c16916aca15f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Apr 2008 19:46:52 -0500 Subject: [PATCH 1/9] and mmaped-file use normalize-path now --- extra/io/monitors/monitors.factor | 2 +- extra/io/unix/mmap/mmap.factor | 4 ++-- extra/io/windows/mmap/mmap.factor | 1 + 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/io/monitors/monitors.factor b/extra/io/monitors/monitors.factor index 863c8fc95c..fb404f24f5 100755 --- a/extra/io/monitors/monitors.factor +++ b/extra/io/monitors/monitors.factor @@ -39,7 +39,7 @@ M: monitor set-timeout (>>timeout) ; HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor ) : ( path recursive? -- monitor ) - (monitor) ; + >r normalize-path r> (monitor) ; : next-change ( monitor -- path changed ) [ queue>> ] [ timeout ] bi mailbox-get-timeout first2 ; diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index 2815a49cd3..332c1927c8 100755 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien io io.files kernel math system unix io.unix.backend -io.mmap ; +io.mmap io.backend ; IN: io.unix.mmap : open-r/w ( path -- fd ) O_RDWR file-mode open dup io-error ; @@ -11,7 +11,7 @@ IN: io.unix.mmap over MAP_FAILED = [ close (io-error) ] when ; M: unix ( path length -- obj ) - swap >r + swap normalize-path >r dup PROT_READ PROT_WRITE bitor MAP_FILE MAP_SHARED bitor r> mmap-open f mapped-file boa ; diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor index 0164ed1697..96b68d5a6d 100755 --- a/extra/io/windows/mmap/mmap.factor +++ b/extra/io/windows/mmap/mmap.factor @@ -61,6 +61,7 @@ M: wince with-privileges nip call ; : mmap-open ( path access-mode create-mode flProtect access -- handle handle address ) + >r >r >r >r normalize-path r> r> r> r> { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [ >r >r 0 open-file dup f r> 0 0 f CreateFileMapping [ win32-error=0/f ] keep From e5575e0dc076979eba0aba6c0873b7d1a4b70751 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Apr 2008 20:13:18 -0500 Subject: [PATCH 2/9] use host-name if smtp-host symbol not set --- extra/smtp/smtp.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/smtp/smtp.factor b/extra/smtp/smtp.factor index d565117e5f..4d548738d2 100755 --- a/extra/smtp/smtp.factor +++ b/extra/smtp/smtp.factor @@ -131,7 +131,7 @@ M: email clone "-" % millis # "@" % - smtp-domain get % + smtp-domain get [ host-name ] unless* % ">" % ] "" make ; From 9318726fc23c78a9248480285583f7dd2be5a4ee Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 24 Apr 2008 20:16:45 -0500 Subject: [PATCH 3/9] use normalize-path in mmap tests --- extra/io/mmap/mmap-tests.factor | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/extra/io/mmap/mmap-tests.factor b/extra/io/mmap/mmap-tests.factor index a00f7cd92b..da3ed38688 100755 --- a/extra/io/mmap/mmap-tests.factor +++ b/extra/io/mmap/mmap-tests.factor @@ -2,9 +2,11 @@ USING: io io.mmap io.files kernel tools.test continuations sequences io.encodings.ascii accessors ; IN: io.mmap.tests -[ "mmap-test-file.txt" resource-path delete-file ] ignore-errors -[ ] [ "12345" "mmap-test-file.txt" resource-path ascii set-file-contents ] unit-test -[ ] [ "mmap-test-file.txt" resource-path dup file-info size>> [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test -[ 5 ] [ "mmap-test-file.txt" resource-path dup file-info size>> [ length ] with-mapped-file ] unit-test -[ "22345" ] [ "mmap-test-file.txt" resource-path ascii file-contents ] unit-test -[ "mmap-test-file.txt" resource-path delete-file ] ignore-errors +[ "resource:mmap-test-file.txt" delete-file ] ignore-errors +[ ] [ "12345" "resource:mmap-test-file.txt" ascii set-file-contents ] unit-test +[ ] [ "resource:mmap-test-file.txt" dup file-info size>> [ CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test +[ 5 ] [ "resource:mmap-test-file.txt" dup file-info size>> [ length ] with-mapped-file ] unit-test +[ "22345" ] [ "resource:mmap-test-file.txt" ascii file-contents ] unit-test +[ "resource:mmap-test-file.txt" delete-file ] ignore-errors + + From ad0139ac0c847421474a3808ed309bef6561a059 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 25 Apr 2008 00:23:49 -0500 Subject: [PATCH 4/9] default vocab is now f when parsing files --- core/parser/parser-docs.factor | 16 +++++++++++----- core/parser/parser.factor | 17 ++++++++++++----- 2 files changed, 23 insertions(+), 10 deletions(-) diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor index 23363c30ad..b69985fb1d 100755 --- a/core/parser/parser-docs.factor +++ b/core/parser/parser-docs.factor @@ -51,9 +51,11 @@ ARTICLE: "vocabulary-search-errors" "Word lookup errors" ARTICLE: "vocabulary-search" "Vocabulary search path" "When the parser reads a token, it attempts to look up a word named by that token. The lookup is performed by searching each vocabulary in the search path, in order." $nl -"For a source file the vocabulary search path starts off with two vocabularies:" -{ $code "syntax\nscratchpad" } -"The " { $vocab-link "syntax" } " vocabulary consists of a set of parsing words for reading Factor data and defining new words. The " { $vocab-link "scratchpad" } " vocabulary is the default vocabulary for new word definitions." +"For a source file the vocabulary search path starts off with one vocabulary:" +{ $code "syntax" } +"The " { $vocab-link "syntax" } " vocabulary consists of a set of parsing words for reading Factor data and defining new words." +$nl +"In the listener, the " { $vocab-link "scratchpad" } " is the default vocabulary for new word definitions. However, when loading source files, there is no default vocabulary. Defining words before declaring a vocabulary with " { $link POSTPONE: IN: } " results in an error." $nl "At the interactive listener, the default search path contains many more vocabularies. Details on the default search path and parser invocation are found in " { $link "parser" } "." $nl @@ -294,6 +296,10 @@ HELP: use HELP: in { $var-description "A variable holding the name of the current vocabulary for new definitions." } ; +HELP: current-vocab +{ $values { "str" "a vocabulary" } } +{ $description "Returns the vocabulary stored in the " { $link in } " symbol. Throws an error if the current vocabulary is " { $link f } "." } ; + HELP: (use+) { $values { "vocab" "an assoc mapping strings to words" } } { $description "Adds an assoc at the front of the search path." } @@ -323,7 +329,7 @@ HELP: set-in $parsing-note ; HELP: create-in -{ $values { "string" "a word name" } { "word" "a new word" } } +{ $values { "str" "a word name" } { "word" "a new word" } } { $description "Creates a word in the current vocabulary. Until re-defined, the word throws an error when invoked." } $parsing-note ; @@ -451,7 +457,7 @@ HELP: bootstrap-syntax HELP: with-file-vocabs { $values { "quot" quotation } } -{ $description "Calls the quotation in a scope with the initial the vocabulary search path for parsing a file. This consists of the " { $snippet "syntax" } " vocabulary together with the " { $snippet "scratchpad" } " vocabulary." } ; +{ $description "Calls the quotation in a scope with the initial the vocabulary search path for parsing a file. This consists of just the " { $snippet "syntax" } " vocabulary." } ; HELP: parse-fresh { $values { "lines" "a sequence of strings" } { "quot" quotation } } diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 7639ebaa69..961fa89d8f 100755 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -233,8 +233,16 @@ PREDICATE: unexpected-eof < unexpected : parse-tokens ( end -- seq ) 100 swap (parse-tokens) >array ; -: create-in ( string -- word ) - in get create dup set-word dup save-location ; +ERROR: no-current-vocab ; + +M: no-current-vocab summary ( obj -- ) + drop "Current vocabulary is f, use IN:" ; + +: current-vocab ( -- str ) + in get [ no-current-vocab ] unless* ; + +: create-in ( str -- word ) + current-vocab create dup set-word dup save-location ; : CREATE ( -- word ) scan create-in ; @@ -243,7 +251,7 @@ PREDICATE: unexpected-eof < unexpected : CREATE-WORD ( -- word ) CREATE dup reset-generic ; : create-class-in ( word -- word ) - in get create + current-vocab create dup save-class-location dup predicate-word dup set-word save-location ; @@ -440,8 +448,7 @@ SYMBOL: bootstrap-syntax : with-file-vocabs ( quot -- ) [ - "scratchpad" in set - { "syntax" "scratchpad" } set-use + f in set { "syntax" } set-use bootstrap-syntax get [ use get push ] when* call ] with-scope ; inline From b440bda681762dfca5f0eeea84121d62decb5a36 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 25 Apr 2008 00:25:37 -0500 Subject: [PATCH 5/9] error message --- extra/math/miller-rabin/miller-rabin.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor index 7835277b9b..a1f90d74c9 100755 --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/extra/math/miller-rabin/miller-rabin.factor @@ -1,4 +1,4 @@ -USING: combinators combinators.lib io locals kernel math +eSING: combinators combinators.lib io locals kernel math math.functions math.ranges namespaces random sequences hashtables sets ; IN: math.miller-rabin @@ -76,7 +76,9 @@ TUPLE: miller-rabin-bounds ; : find-relative-prime ( n -- p ) dup random find-relative-prime* ; +ERROR: too-few-primes ; + : unique-primes ( numbits n -- seq ) #! generate two primes - over 5 < [ "not enough primes below 5 bits" throw ] when + over 5 < [ too-few-primes ] when [ [ drop random-prime ] with map ] [ all-unique? ] generate ; From 13c2e444a8d53dcd42d8e49be369a240adb95337 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 25 Apr 2008 00:59:44 -0500 Subject: [PATCH 6/9] normalize-path on windows file monitor --- extra/io/monitors/monitors.factor | 2 +- extra/io/windows/nt/monitors/monitors.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/io/monitors/monitors.factor b/extra/io/monitors/monitors.factor index fb404f24f5..863c8fc95c 100755 --- a/extra/io/monitors/monitors.factor +++ b/extra/io/monitors/monitors.factor @@ -39,7 +39,7 @@ M: monitor set-timeout (>>timeout) ; HOOK: (monitor) io-backend ( path recursive? mailbox -- monitor ) : ( path recursive? -- monitor ) - >r normalize-path r> (monitor) ; + (monitor) ; : next-change ( monitor -- path changed ) [ queue>> ] [ timeout ] bi mailbox-get-timeout first2 ; diff --git a/extra/io/windows/nt/monitors/monitors.factor b/extra/io/windows/nt/monitors/monitors.factor index 4c2277acb9..2397d207b9 100755 --- a/extra/io/windows/nt/monitors/monitors.factor +++ b/extra/io/windows/nt/monitors/monitors.factor @@ -98,7 +98,7 @@ TUPLE: win32-monitor < monitor port ; M:: winnt (monitor) ( path recursive? mailbox -- monitor ) [ - path mailbox win32-monitor new-monitor + path normalize-path mailbox win32-monitor new-monitor path open-directory \ win32-monitor-port recursive? >>recursive >>port From 9e3cab4327d61741a3e4b9a50393da1690644a8d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 25 Apr 2008 01:10:40 -0500 Subject: [PATCH 7/9] move normalize-path to (mapped-file) is now the hook --- extra/io/mmap/mmap.factor | 5 ++++- extra/io/unix/mmap/mmap.factor | 4 ++-- extra/io/windows/mmap/mmap.factor | 3 +-- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/extra/io/mmap/mmap.factor b/extra/io/mmap/mmap.factor index 59246115cf..a07443783c 100755 --- a/extra/io/mmap/mmap.factor +++ b/extra/io/mmap/mmap.factor @@ -21,7 +21,10 @@ M: mapped-file set-nth-unsafe INSTANCE: mapped-file sequence -HOOK: io-backend ( path length -- mmap ) +HOOK: (mapped-file) io-backend ( path length -- mmap ) + +: ( path length -- mmap ) + >r normalize-path r> (mapped-file) ; HOOK: close-mapped-file io-backend ( mmap -- ) diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index 332c1927c8..72ff107f8f 100755 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -10,8 +10,8 @@ IN: io.unix.mmap >r f -roll r> open-r/w [ 0 mmap ] keep over MAP_FAILED = [ close (io-error) ] when ; -M: unix ( path length -- obj ) - swap normalize-path >r +M: unix (mapped-file) ( path length -- obj ) + swap >r dup PROT_READ PROT_WRITE bitor MAP_FILE MAP_SHARED bitor r> mmap-open f mapped-file boa ; diff --git a/extra/io/windows/mmap/mmap.factor b/extra/io/windows/mmap/mmap.factor index 96b68d5a6d..dc29405b12 100755 --- a/extra/io/windows/mmap/mmap.factor +++ b/extra/io/windows/mmap/mmap.factor @@ -61,7 +61,6 @@ M: wince with-privileges nip call ; : mmap-open ( path access-mode create-mode flProtect access -- handle handle address ) - >r >r >r >r normalize-path r> r> r> r> { "SeCreateGlobalPrivilege" "SeLockMemoryPrivilege" } [ >r >r 0 open-file dup f r> 0 0 f CreateFileMapping [ win32-error=0/f ] keep @@ -71,7 +70,7 @@ M: wince with-privileges dup close-later ] with-privileges ; -M: windows ( path length -- mmap ) +M: windows (mapped-file) ( path length -- mmap ) [ swap GENERIC_WRITE GENERIC_READ bitor From 9f97ae2b0c348304be99b08191b8bd2d3ddf047a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 25 Apr 2008 01:54:42 -0500 Subject: [PATCH 8/9] add unit test for parser --- core/parser/parser-tests.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index ab193e1c02..20d51f3461 100755 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -3,6 +3,7 @@ io.streams.string namespaces classes effects source-files assocs sequences strings io.files definitions continuations sorting classes.tuple compiler.units debugger vocabs vocabs.loader accessors ; + IN: parser.tests [ @@ -429,3 +430,5 @@ must-fail-with [ "USE: this-better-not-exist" eval ] must-fail + +[ ": foo ;" eval ] [ error>> no-current-vocab? ] must-fail-with From a9c9f268220e2c86cce26511baa142acea338a95 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 25 Apr 2008 01:55:24 -0500 Subject: [PATCH 9/9] remove extra using --- extra/io/unix/mmap/mmap.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/io/unix/mmap/mmap.factor b/extra/io/unix/mmap/mmap.factor index 72ff107f8f..ada1f94d87 100755 --- a/extra/io/unix/mmap/mmap.factor +++ b/extra/io/unix/mmap/mmap.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien io io.files kernel math system unix io.unix.backend -io.mmap io.backend ; +io.mmap ; IN: io.unix.mmap : open-r/w ( path -- fd ) O_RDWR file-mode open dup io-error ;