From 85a3ee3e5bfe49f316a01140592d9ac174decf6e Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Wed, 26 Mar 2008 16:43:03 +1300
Subject: [PATCH 1/9] Remove memoization in 'compile' word in pegs This creates
issues when recompiling a an existing EBNF parser for reasons I've not yet
tracked down. Disabling it slows things down but makes things work correctly
till I investigate the issue.
---
extra/peg/peg.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 00271a9ad3..e9477dc408 100755
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -28,7 +28,7 @@ GENERIC: (compile) ( parser -- quot )
[ swap compiled-parsers get set-at ] keep
] if* ;
-MEMO: compile ( parser -- word )
+: compile ( parser -- word )
H{ } clone compiled-parsers [
[ compiled-parser ] with-compilation-unit
] with-variable ;
From c793a381fe651b9d09e0b5689c20703de546aca2 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Wed, 26 Mar 2008 17:38:30 +1300
Subject: [PATCH 2/9] Add hook for packrat implementation
---
extra/peg/peg.factor | 8 +++++++-
1 file changed, 7 insertions(+), 1 deletion(-)
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index e9477dc408..af26f888f1 100755
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -17,6 +17,12 @@ SYMBOL: compiled-parsers
GENERIC: (compile) ( parser -- quot )
+: run-parser ( input quot -- result )
+ #! Eventually this will be replaced with something that
+ #! can do packrat parsing by memoizing the results of
+ #! a parser. For now, it just calls the quotation.
+ call ; inline
+
: compiled-parser ( parser -- word )
#! Look to see if the given parser has been compiled.
#! If not, compile it to a temporary word, cache it,
@@ -24,7 +30,7 @@ GENERIC: (compile) ( parser -- quot )
dup compiled-parsers get at [
nip
] [
- dup (compile) define-temp
+ dup (compile) [ run-parser ] curry define-temp
[ swap compiled-parsers get set-at ] keep
] if* ;
From bd33e2fef9e77195aefa384639978b33179aab45 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Thu, 27 Mar 2008 11:23:19 +1300
Subject: [PATCH 3/9] Fix cache to handle the case of 'f' being a valid cached
value
---
core/assocs/assocs.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index ff0938e001..196ec614b7 100755
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -134,11 +134,11 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
(substitute) map ;
: cache ( key assoc quot -- value )
- 2over at [
+ 2over at* [
>r 3drop r>
] [
- pick rot >r >r call dup r> r> set-at
- ] if* ; inline
+ drop pick rot >r >r call dup r> r> set-at
+ ] if ; inline
: change-at ( key assoc quot -- )
[ >r at r> call ] 3keep drop set-at ; inline
From 2614792254e590c280f9e5a9c69ba8146a7fa147 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Thu, 27 Mar 2008 11:23:58 +1300
Subject: [PATCH 4/9] Implement packrat algorithm
---
extra/peg/peg.factor | 19 ++++++++++++++-----
1 file changed, 14 insertions(+), 5 deletions(-)
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index af26f888f1..44a762cec2 100755
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -3,7 +3,8 @@
USING: kernel sequences strings namespaces math assocs shuffle
vectors arrays combinators.lib math.parser match
unicode.categories sequences.lib compiler.units parser
- words quotations effects memoize accessors combinators.cleave ;
+ words quotations effects memoize accessors
+ combinators.cleave locals ;
IN: peg
TUPLE: parse-result remaining ast ;
@@ -14,14 +15,22 @@ SYMBOL: ignore
parse-result construct-boa ;
SYMBOL: compiled-parsers
+SYMBOL: packrat
+SYMBOL: failed
GENERIC: (compile) ( parser -- quot )
+:: run-packrat-parser ( input quot c -- result )
+ input slice? [ input slice-from ] [ 0 ] if
+ quot c [ drop H{ } clone ] cache
+ [
+ drop input quot call
+ ] cache* ; inline
+
: run-parser ( input quot -- result )
- #! Eventually this will be replaced with something that
- #! can do packrat parsing by memoizing the results of
- #! a parser. For now, it just calls the quotation.
- call ; inline
+ #! If a packrat cache is available, use memoization for
+ #! packrat parsing, otherwise do a standard peg call.
+ packrat get [ run-packrat-parser ] [ call ] if* ; inline
: compiled-parser ( parser -- word )
#! Look to see if the given parser has been compiled.
From c0f4e3742746573a5ae93df138cd80bf078ad4b6 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Thu, 27 Mar 2008 12:58:53 +1300
Subject: [PATCH 5/9] Fix usage of cache in pegs
---
extra/peg/peg.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index 44a762cec2..dd0b11fce3 100755
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -25,7 +25,7 @@ GENERIC: (compile) ( parser -- quot )
quot c [ drop H{ } clone ] cache
[
drop input quot call
- ] cache* ; inline
+ ] cache ; inline
: run-parser ( input quot -- result )
#! If a packrat cache is available, use memoization for
From 4684c9cacc1c740d908510e327946b2d7bcff8a0 Mon Sep 17 00:00:00 2001
From: erg <erg@ergbook.local>
Date: Wed, 26 Mar 2008 19:40:40 -0500
Subject: [PATCH 6/9] work on normalize-pathname add two failing unit tests
---
core/io/backend/backend.factor | 2 --
core/io/files/files-tests.factor | 17 +++++++++++++++--
core/io/files/files.factor | 3 +++
3 files changed, 18 insertions(+), 4 deletions(-)
diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor
index 1595ecd576..8cfcbb71de 100755
--- a/core/io/backend/backend.factor
+++ b/core/io/backend/backend.factor
@@ -21,8 +21,6 @@ M: object normalize-directory ;
HOOK: normalize-pathname io-backend ( str -- newstr )
-M: object normalize-pathname ;
-
: set-io-backend ( io-backend -- )
io-backend set-global init-io init-stdio ;
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 36b32ea34c..51bf79e29c 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -1,6 +1,7 @@
IN: io.files.tests
-USING: tools.test io.files io threads kernel continuations io.encodings.ascii
-io.files.unique sequences strings accessors ;
+USING: tools.test io.files io threads kernel continuations
+io.encodings.ascii io.files.unique sequences strings accessors
+io.encodings.utf8 ;
[ ] [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test
[ ] [ "blahblah" temp-file make-directory ] unit-test
@@ -130,6 +131,18 @@ io.files.unique sequences strings accessors ;
[ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
+[ t ] [
+ temp-directory [ "hi" "test41" utf8 set-file-contents ] with-directory
+ temp-directory "test41" append-path utf8 file-contents "hi41" =
+] unit-test
+
+[ t ] [
+ temp-directory [
+ "test43" utf8 <file-writer> [ "hi43" write ] with-stream
+ ] with-directory
+ temp-directory "test43" append-path utf8 file-contents "hi43" =
+] unit-test
+
[ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
[ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 6500bdb387..64d8e25ee2 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -272,6 +272,9 @@ DEFER: copy-tree-into
: temp-file ( name -- path ) temp-directory prepend-path ;
+M: object normalize-pathname ( path -- path' )
+ current-directory get prepend-path ;
+
! Pathname presentations
TUPLE: pathname string ;
From e2f3888389e846843ff8bab2e1cec0f6cd589303 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 26 Mar 2008 20:42:24 -0500
Subject: [PATCH 7/9] UI listener fix
---
extra/ui/gadgets/scrollers/scrollers.factor | 5 +++--
extra/ui/tools/listener/listener.factor | 15 +++++++++++++--
2 files changed, 16 insertions(+), 4 deletions(-)
diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor
index 98951b74e3..7966f4e206 100755
--- a/extra/ui/gadgets/scrollers/scrollers.factor
+++ b/extra/ui/gadgets/scrollers/scrollers.factor
@@ -3,13 +3,14 @@
USING: arrays ui.gadgets
ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids
ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math
-namespaces sequences models combinators math.vectors ;
+namespaces sequences models combinators math.vectors
+tuples ;
IN: ui.gadgets.scrollers
TUPLE: scroller viewport x y follows ;
: find-scroller ( gadget -- scroller/f )
- [ scroller? ] find-parent ;
+ [ [ scroller? ] is? ] find-parent ;
: scroll-up-page scroller-y -1 swap slide-by-page ;
diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor
index 75401b3861..7db0d63f45 100755
--- a/extra/ui/tools/listener/listener.factor
+++ b/extra/ui/tools/listener/listener.factor
@@ -6,7 +6,8 @@ kernel models namespaces parser quotations sequences ui.commands
ui.gadgets ui.gadgets.editors ui.gadgets.labelled
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
ui.gadgets.tracks ui.gestures ui.operations vocabs words
-prettyprint listener debugger threads boxes concurrency.flags ;
+prettyprint listener debugger threads boxes concurrency.flags
+math arrays ;
IN: ui.tools.listener
TUPLE: listener-gadget input output stack ;
@@ -23,9 +24,19 @@ TUPLE: listener-gadget input output stack ;
: <listener-input> ( listener -- gadget )
listener-gadget-output <pane-stream> <interactor> ;
+TUPLE: input-scroller ;
+
+: <input-scroller> ( interactor -- scroller )
+ <scroller>
+ input-scroller construct-empty
+ [ set-gadget-delegate ] keep ;
+
+M: input-scroller pref-dim*
+ drop { 0 100 } ;
+
: listener-input, ( -- )
g <listener-input> g-> set-listener-gadget-input
- <scroller> "Input" <labelled-gadget> f track, ;
+ <input-scroller> "Input" <labelled-gadget> f track, ;
: welcome. ( -- )
"If this is your first time with Factor, please read the " print
From 24466cfc57cd1e7cda29130fef91288e22963f16 Mon Sep 17 00:00:00 2001
From: erg <erg@ergbook.local>
Date: Wed, 26 Mar 2008 22:39:16 -0500
Subject: [PATCH 8/9] normalize-pathname all ova tha place
---
core/io/files/files-tests.factor | 7 ++-----
core/io/files/files.factor | 6 +++---
extra/io/unix/files/files.factor | 4 ++--
extra/io/unix/launcher/launcher-tests.factor | 14 +++++++++++++-
extra/io/unix/launcher/launcher.factor | 5 +++--
extra/io/windows/files/files.factor | 5 ++++-
extra/io/windows/windows.factor | 2 +-
7 files changed, 28 insertions(+), 15 deletions(-)
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 51bf79e29c..bb8e997c68 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -132,15 +132,12 @@ io.encodings.utf8 ;
[ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
[ t ] [
- temp-directory [ "hi" "test41" utf8 set-file-contents ] with-directory
+ temp-directory [ "hi41" "test41" utf8 set-file-contents ] with-directory
temp-directory "test41" append-path utf8 file-contents "hi41" =
] unit-test
[ t ] [
- temp-directory [
- "test43" utf8 <file-writer> [ "hi43" write ] with-stream
- ] with-directory
- temp-directory "test43" append-path utf8 file-contents "hi43" =
+ temp-directory [ "test41" file-info size>> ] with-directory 4 =
] unit-test
[ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 64d8e25ee2..78f1612cb8 100755
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -13,13 +13,13 @@ HOOK: (file-writer) io-backend ( path -- stream )
HOOK: (file-appender) io-backend ( path -- stream )
: <file-reader> ( path encoding -- stream )
- swap (file-reader) swap <decoder> ;
+ swap normalize-pathname (file-reader) swap <decoder> ;
: <file-writer> ( path encoding -- stream )
- swap (file-writer) swap <encoder> ;
+ swap normalize-pathname (file-writer) swap <encoder> ;
: <file-appender> ( path encoding -- stream )
- swap (file-appender) swap <encoder> ;
+ swap normalize-pathname (file-appender) swap <encoder> ;
: file-lines ( path encoding -- seq )
<file-reader> lines ;
diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor
index 1e7d682314..2888231e20 100755
--- a/extra/io/unix/files/files.factor
+++ b/extra/io/unix/files/files.factor
@@ -94,7 +94,7 @@ M: unix-io copy-file ( from to -- )
\ file-info construct-boa ;
M: unix-io file-info ( path -- info )
- stat* stat>file-info ;
+ normalize-pathname stat* stat>file-info ;
M: unix-io link-info ( path -- info )
- lstat* stat>file-info ;
+ normalize-pathname lstat* stat>file-info ;
diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor
index 9e19245d01..7e527196be 100755
--- a/extra/io/unix/launcher/launcher-tests.factor
+++ b/extra/io/unix/launcher/launcher-tests.factor
@@ -1,7 +1,7 @@
IN: io.unix.launcher.tests
USING: io.files tools.test io.launcher arrays io namespaces
continuations math io.encodings.binary io.encodings.ascii
-accessors kernel sequences ;
+accessors kernel sequences io.encodings.utf8 ;
[ ] [
[ "launcher-test-1" temp-file delete-file ] ignore-errors
@@ -95,3 +95,15 @@ accessors kernel sequences ;
+replace-environment+ >>environment-mode
ascii <process-stream> lines
] unit-test
+
+[ "hi\n" ] [
+ temp-directory [
+ [ "aloha" delete-file ] ignore-errors
+ <process>
+ { "echo" "hi" } >>command
+ "aloha" >>stdout
+ try-process
+ ] with-directory
+ temp-directory "aloha" append-path
+ utf8 file-contents
+] unit-test
diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor
index 0cbb78b881..1292f2cacf 100755
--- a/extra/io/unix/launcher/launcher.factor
+++ b/extra/io/unix/launcher/launcher.factor
@@ -37,7 +37,8 @@ USE: unix
2nip reset-fd ;
: redirect-file ( obj mode fd -- )
- >r file-mode open dup io-error r> redirect-fd ;
+ >r >r normalize-pathname r> file-mode
+ open dup io-error r> redirect-fd ;
: redirect-closed ( obj mode fd -- )
>r >r drop "/dev/null" r> r> redirect-file ;
@@ -67,9 +68,9 @@ USE: unix
: spawn-process ( process -- * )
[
- current-directory get cd
setup-priority
setup-redirection
+ current-directory get cd
dup pass-environment? [
dup get-environment set-os-envs
] when
diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor
index 094014fac6..b4513f7da8 100755
--- a/extra/io/windows/files/files.factor
+++ b/extra/io/windows/files/files.factor
@@ -89,4 +89,7 @@ SYMBOLS: +read-only+ +hidden+ +system+
] if ;
M: windows-nt-io file-info ( path -- info )
- get-file-information-stat ;
+ normalize-pathname get-file-information-stat ;
+
+M: windows-nt-io link-info ( path -- info )
+ file-info ;
diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor
index dac55664a4..635a992777 100755
--- a/extra/io/windows/windows.factor
+++ b/extra/io/windows/windows.factor
@@ -51,7 +51,7 @@ M: win32-file close-handle ( handle -- )
! Clean up resources (open handle) if add-completion fails
: open-file ( path access-mode create-mode flags -- handle )
[
- >r >r >r normalize-pathname r>
+ >r >r
share-mode security-attributes-inherit r> r> CreateFile-flags f CreateFile
dup invalid-handle? dup close-later
dup add-completion
From 5bab5de16d64a49e9157f4e9835a185cd3638c02 Mon Sep 17 00:00:00 2001
From: erg <erg@ergbook.local>
Date: Wed, 26 Mar 2008 22:47:13 -0500
Subject: [PATCH 9/9] make directory work inside with-directory
---
core/io/backend/backend.factor | 4 ++--
core/io/files/files-tests.factor | 6 ++++++
2 files changed, 8 insertions(+), 2 deletions(-)
diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor
index 8cfcbb71de..151dbc7df7 100755
--- a/core/io/backend/backend.factor
+++ b/core/io/backend/backend.factor
@@ -17,10 +17,10 @@ HOOK: io-multiplex io-backend ( ms -- )
HOOK: normalize-directory io-backend ( str -- newstr )
-M: object normalize-directory ;
-
HOOK: normalize-pathname io-backend ( str -- newstr )
+M: object normalize-directory normalize-pathname ;
+
: set-io-backend ( io-backend -- )
io-backend set-global init-io init-stdio ;
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index bb8e997c68..369ecc6868 100755
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -83,6 +83,12 @@ io.encodings.utf8 ;
"delete-tree-test" temp-file delete-tree
] unit-test
+[ { { "kernel" t } } ] [
+ "core" resource-path [
+ "." directory [ first "kernel" = ] subset
+ ] with-directory
+] unit-test
+
[ ] [
"copy-tree-test/a/b/c" temp-file make-directories
] unit-test