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

diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index e3765fead080468078d2ba7150d3dbc9651858f4..7af1b602d02877c3c8a58ad41cdd0cc152cb6765 100755 (executable)
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -178,10 +178,10 @@ io.files.unique sequences strings accessors ;
 [ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test
 [ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test
 
-[ "foo/" ] [ "foo/bar/." parent-directory ] unit-test
-[ "foo/" ] [ "foo/bar/./" parent-directory ] unit-test
-[ "foo/" ] [ "foo/bar/baz/.." parent-directory ] unit-test
-[ "foo/" ] [ "foo/bar/baz/../" parent-directory ] unit-test
+[ "foo/bar/." parent-directory ] must-fail
+[ "foo/bar/./" parent-directory ] must-fail
+[ "foo/bar/baz/.." parent-directory ] must-fail
+[ "foo/bar/baz/../" parent-directory ] must-fail
 
 [ "." parent-directory ] must-fail
 [ "./" parent-directory ] must-fail
@@ -190,6 +190,8 @@ io.files.unique sequences strings accessors ;
 [ "../../" parent-directory ] must-fail
 [ "foo/.." parent-directory ] must-fail
 [ "foo/../" parent-directory ] must-fail
+[ "" parent-directory ] must-fail
+[ "." ] [ "boot.x86.64.image" parent-directory ] unit-test
 
 [ "bar/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test
 [ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test

diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 8595f227bfa2352f68fb4fd9a3129aa7db867960..6500bdb387976a3feab1b4df5d17bd79e802c5c6 100755 (executable)
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -66,14 +66,12 @@ ERROR: no-parent-directory path ;
         right-trim-separators
         dup last-path-separator [
             1+ cut
-            {
-                { "." [ 1 head* parent-directory ] }
-                { ".." [
-                    2 head* parent-directory parent-directory
-                ] }
-                [ drop ]
-            } case
-        ] [ no-parent-directory ] if
+        ] [
+            drop "." swap
+        ] if
+        { "" "." ".." } member? [
+            no-parent-directory
+        ] when
     ] unless ;
 
 <PRIVATE
@@ -157,6 +155,8 @@ HOOK: cwd io-backend ( -- path )
 
 SYMBOL: current-directory
 
+M: object cwd ( -- path ) "." ;
+
 [ cwd current-directory set-global ] "current-directory" add-init-hook
 
 : with-directory ( path quot -- )
@@ -259,7 +259,7 @@ DEFER: copy-tree-into
     prepend-path ;
 
 : ?resource-path ( path -- newpath )
-    "resource:" ?head [ resource-path ] when ;
+    "resource:" ?head [ left-trim-separators resource-path ] when ;
 
 : resource-exists? ( path -- ? )
     ?resource-path exists? ;

diff --git a/extra/io/launcher/launcher.factor b/extra/io/launcher/launcher.factor
index ac8dc1566194939ba005feb95fe7298d08b15cf2..79382091ab6304444dfdd075bdcb76f34b3a4067 100755 (executable)
--- a/extra/io/launcher/launcher.factor
+++ b/extra/io/launcher/launcher.factor
@@ -38,6 +38,7 @@ SYMBOL: +low-priority+
 SYMBOL: +normal-priority+
 SYMBOL: +high-priority+
 SYMBOL: +highest-priority+
+SYMBOL: +realtime-priority+
 
 : <process> ( -- process )
     process construct-empty

diff --git a/extra/io/unix/files/files-tests.factor b/extra/io/unix/files/files-tests.factor
index 98de09e8f1c41a93c1ddb268efbed232dfd4421d..22b29b7a51f3fe71b67c29240b807e5f7cde82fb 100755 (executable)
--- a/extra/io/unix/files/files-tests.factor
+++ b/extra/io/unix/files/files-tests.factor
@@ -6,7 +6,6 @@ IN: io.unix.files.tests
 [ "/" ] [ "/etc/" parent-directory ] unit-test
 [ "/" ] [ "/etc" parent-directory ] unit-test
 [ "/" ] [ "/" parent-directory ] unit-test
-[ "asdf" parent-directory ] must-fail
 
 [ f ] [ "" root-directory? ] unit-test
 [ t ] [ "/" root-directory? ] unit-test

diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor
index e16ecde6fadf3985986014c7c91c1973194ced68..11c608c68fb0843c5e279c4b1b36db60da8b5494 100755 (executable)
--- a/extra/io/unix/launcher/launcher.factor
+++ b/extra/io/unix/launcher/launcher.factor
@@ -24,6 +24,7 @@ USE: unix
             { +normal-priority+ 0 }
             { +high-priority+ -10 }
             { +highest-priority+ -20 }
+            { +realtime-priority+ -20 }
         } at set-priority
     ] when* ;
 

diff --git a/extra/io/windows/launcher/launcher.factor b/extra/io/windows/launcher/launcher.factor
index ca8f5f3e59ad25c81cef586162cc1afef66b2409..2d281d0fe8b1ece58e35d2fc967158932e53e4f6 100755 (executable)
--- a/extra/io/windows/launcher/launcher.factor
+++ b/extra/io/windows/launcher/launcher.factor
@@ -49,6 +49,17 @@ TUPLE: CreateProcess-args
 : join-arguments ( args -- cmd-line )
     [ escape-argument ] map " " join ;
 
+: lookup-priority ( process -- n )
+    priority>> {
+        { +lowest-priority+ [ IDLE_PRIORITY_CLASS ] }
+        { +low-priority+ [ BELOW_NORMAL_PRIORITY_CLASS ] }
+        { +normal-priority+ [ NORMAL_PRIORITY_CLASS ] }
+        { +high-priority+ [ ABOVE_NORMAL_PRIORITY_CLASS ] }
+        { +highest-priority+ [ HIGH_PRIORITY_CLASS ] }
+        { +realtime-priority+ [ REALTIME_PRIORITY_CLASS ] }
+        [ drop f ]
+    } case ;
+
 : app-name/cmd-line ( process -- app-name cmd-line )
     command>> dup string? [
         " " split1
@@ -71,6 +82,7 @@ TUPLE: CreateProcess-args
     0
     pick pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
     pick detached>> winnt? and [ DETACHED_PROCESS bitor ] when
+    pick lookup-priority [ bitor ] when*
     >>dwCreateFlags ;
 
 : fill-lpEnvironment ( process args -- process args )

diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor
index 9a74cc65e8d6a364d1126e38d57a704dff515b80..42ade34186272728acdd14a407ac2f89555ce029 100755 (executable)
--- a/extra/multi-methods/multi-methods.factor
+++ b/extra/multi-methods/multi-methods.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences vectors classes combinators
-arrays words assocs parser namespaces definitions
+USING: kernel math sequences vectors classes classes.algebra
+combinators arrays words assocs parser namespaces definitions
 prettyprint prettyprint.backend quotations arrays.lib
 debugger io compiler.units kernel.private effects ;
 IN: multi-methods

diff --git a/extra/openssl/openssl-docs.factor b/extra/openssl/openssl-docs.factor
new file mode 100644 (file)
index 0000000..dd31bfd
--- /dev/null
+++ b/extra/openssl/openssl-docs.factor
@@ -0,0 +1,10 @@
+
+USING: help.syntax help.markup ;
+
+IN: openssl
+
+ARTICLE: "openssl" "OpenSSL"
+
+"Factor on Windows has been tested with this version of OpenSSL: "
+
+{ $url "http://www.openssl.org/related/binaries.html" } ;
\ No newline at end of file

diff --git a/extra/peg/ebnf/ebnf.factor b/extra/peg/ebnf/ebnf.factor
index db478e571f9bd17d200b6af1e1bd067effc7dba2..11e1e2ea648052e2d535bc2c7c0244042f038520 100644 (file)
--- a/extra/peg/ebnf/ebnf.factor
+++ b/extra/peg/ebnf/ebnf.factor
@@ -3,7 +3,7 @@
 USING: kernel compiler.units parser words arrays strings math.parser sequences \r
        quotations vectors namespaces math assocs continuations peg\r
        peg.parsers unicode.categories multiline combinators.lib \r
-       splitting ;\r
+       splitting accessors ;\r
 IN: peg.ebnf\r
 \r
 TUPLE: ebnf-non-terminal symbol ;\r
@@ -16,7 +16,7 @@ TUPLE: ebnf-choice options ;
 TUPLE: ebnf-sequence elements ;\r
 TUPLE: ebnf-repeat0 group ;\r
 TUPLE: ebnf-repeat1 group ;\r
-TUPLE: ebnf-optional elements ;\r
+TUPLE: ebnf-optional group ;\r
 TUPLE: ebnf-rule symbol elements ;\r
 TUPLE: ebnf-action parser code ;\r
 TUPLE: ebnf rules ;\r
@@ -198,7 +198,7 @@ DEFER: 'choice'
  \r
 : 'rule' ( -- parser )\r
   [\r
-    'non-terminal' [ ebnf-non-terminal-symbol ] action  ,\r
+    'non-terminal' [ symbol>> ] action  ,\r
     "=" syntax  ,\r
     'choice'  ,\r
   ] seq* [ first2 <ebnf-rule> ] action ;\r
@@ -215,49 +215,53 @@ SYMBOL: main
   H{ } clone dup dup [ parser set swap (transform) main set ] bind ;\r
 \r
 M: ebnf (transform) ( ast -- parser )\r
-  ebnf-rules [ (transform) ] map peek ;\r
+  rules>> [ (transform) ] map peek ;\r
   \r
 M: ebnf-rule (transform) ( ast -- parser )\r
-  dup ebnf-rule-elements (transform) [\r
-    swap ebnf-rule-symbol set\r
+  dup elements>> (transform) [\r
+    swap symbol>> set\r
   ] keep ;\r
 \r
 M: ebnf-sequence (transform) ( ast -- parser )\r
-  ebnf-sequence-elements [ (transform) ] map seq ;\r
+  elements>> [ (transform) ] map seq ;\r
 \r
 M: ebnf-choice (transform) ( ast -- parser )\r
-  ebnf-choice-options [ (transform) ] map choice ;\r
+  options>> [ (transform) ] map choice ;\r
 \r
 M: ebnf-any-character (transform) ( ast -- parser )\r
   drop any-char ;\r
 \r
 M: ebnf-range (transform) ( ast -- parser )\r
-  ebnf-range-pattern range-pattern ;\r
+  pattern>> range-pattern ;\r
+\r
+: transform-group ( ast -- parser ) \r
+  #! convert a ast node with groups to a parser for that group\r
+  group>> (transform) ;\r
 \r
 M: ebnf-ensure (transform) ( ast -- parser )\r
-  ebnf-ensure-group (transform) ensure ;\r
+  transform-group ensure ;\r
 \r
 M: ebnf-ensure-not (transform) ( ast -- parser )\r
-  ebnf-ensure-not-group (transform) ensure-not ;\r
+  transform-group ensure-not ;\r
 \r
 M: ebnf-repeat0 (transform) ( ast -- parser )\r
-  ebnf-repeat0-group (transform) repeat0 ;\r
+  transform-group repeat0 ;\r
 \r
 M: ebnf-repeat1 (transform) ( ast -- parser )\r
-  ebnf-repeat1-group (transform) repeat1 ;\r
+  transform-group repeat1 ;\r
 \r
 M: ebnf-optional (transform) ( ast -- parser )\r
-  ebnf-optional-elements (transform) optional ;\r
+  transform-group optional ;\r
 \r
 M: ebnf-action (transform) ( ast -- parser )\r
-  [ ebnf-action-parser (transform) ] keep\r
-  ebnf-action-code string-lines [ parse-lines ] with-compilation-unit action ;\r
+  [ parser>> (transform) ] keep\r
+  code>> string-lines [ parse-lines ] with-compilation-unit action ;\r
 \r
 M: ebnf-terminal (transform) ( ast -- parser )\r
-  ebnf-terminal-symbol token sp ;\r
+  symbol>> token sp ;\r
 \r
 M: ebnf-non-terminal (transform) ( ast -- parser )\r
-  ebnf-non-terminal-symbol  [\r
+  symbol>>  [\r
     , parser get , \ at ,  \r
   ] [ ] make delay sp ;\r
 \r

diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor
index ae5ed2f8b2b43b619ea05b9aa1117843d51678d3..00271a9ad380b1ee4b2710049d2ec263c76d7c96 100755 (executable)
--- a/extra/peg/peg.factor
+++ b/extra/peg/peg.factor
@@ -3,7 +3,7 @@
 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 ;
+       words quotations effects memoize accessors combinators.cleave ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;
@@ -52,7 +52,7 @@ MATCH-VARS: ?token ;
   ] if ;
 
 M: token-parser (compile) ( parser -- quot )
-  token-parser-symbol [ parse-token ] curry ;
+  symbol>> [ parse-token ] curry ;
       
 TUPLE: satisfy-parser quot ;
 
@@ -72,7 +72,7 @@ MATCH-VARS: ?quot ;
   ] ;
 
 M: satisfy-parser (compile) ( parser -- quot )
-  satisfy-parser-quot \ ?quot satisfy-pattern match-replace ;
+  quot>> \ ?quot satisfy-pattern match-replace ;
 
 TUPLE: range-parser min max ;
 
@@ -100,12 +100,12 @@ TUPLE: seq-parser parsers ;
 : seq-pattern ( -- quot )
   [
     dup [
-      dup parse-result-remaining ?quot [
-        [ parse-result-remaining swap set-parse-result-remaining ] 2keep
-        parse-result-ast dup ignore = [ 
+      dup remaining>> ?quot [
+        [ remaining>> swap (>>remaining) ] 2keep
+        ast>> dup ignore = [ 
           drop  
         ] [ 
-          swap [ parse-result-ast push ] keep 
+          swap [ ast>> push ] keep 
         ] if
       ] [
         drop f 
@@ -118,7 +118,7 @@ TUPLE: seq-parser parsers ;
 M: seq-parser (compile) ( parser -- quot )
   [
     [ V{ } clone <parse-result> ] %
-    seq-parser-parsers [ compiled-parser \ ?quot seq-pattern match-replace % ] each 
+    parsers>> [ compiled-parser \ ?quot seq-pattern match-replace % ] each 
   ] [ ] make ;
 
 TUPLE: choice-parser parsers ;
@@ -135,16 +135,16 @@ TUPLE: choice-parser parsers ;
 M: choice-parser (compile) ( parser -- quot )
   [
     f ,
-    choice-parser-parsers [ compiled-parser \ ?quot choice-pattern match-replace % ] each
+    parsers>> [ compiled-parser \ ?quot choice-pattern match-replace % ] each
     \ nip ,
   ] [ ] make ;
 
 TUPLE: repeat0-parser p1 ;
 
 : (repeat0) ( quot result -- result )
-  2dup parse-result-remaining swap call [
-    [ parse-result-remaining swap set-parse-result-remaining ] 2keep 
-    parse-result-ast swap [ parse-result-ast push ] keep
+  2dup remaining>> swap call [
+    [ remaining>> swap (>>remaining) ] 2keep 
+    ast>> swap [ ast>> push ] keep
     (repeat0) 
  ] [
     nip
@@ -158,7 +158,7 @@ TUPLE: repeat0-parser p1 ;
 M: repeat0-parser (compile) ( parser -- quot )
   [
     [ V{ } clone <parse-result> ] %
-    repeat0-parser-p1 compiled-parser \ ?quot repeat0-pattern match-replace %        
+    p1>> compiled-parser \ ?quot repeat0-pattern match-replace %        
   ] [ ] make ;
 
 TUPLE: repeat1-parser p1 ;
@@ -166,7 +166,7 @@ TUPLE: repeat1-parser p1 ;
 : repeat1-pattern ( -- quot )
   [
     [ ?quot ] swap (repeat0) [
-      dup parse-result-ast empty? [
+      dup ast>> empty? [
         drop f
       ] when  
     ] [
@@ -177,7 +177,7 @@ TUPLE: repeat1-parser p1 ;
 M: repeat1-parser (compile) ( parser -- quot )
   [
     [ V{ } clone <parse-result> ] %
-    repeat1-parser-p1 compiled-parser \ ?quot repeat1-pattern match-replace % 
+    p1>> compiled-parser \ ?quot repeat1-pattern match-replace % 
   ] [ ] make ;
 
 TUPLE: optional-parser p1 ;
@@ -188,7 +188,7 @@ TUPLE: optional-parser p1 ;
   ] ;
 
 M: optional-parser (compile) ( parser -- quot )
-  optional-parser-p1 compiled-parser \ ?quot optional-pattern match-replace ;
+  p1>> compiled-parser \ ?quot optional-pattern match-replace ;
 
 TUPLE: ensure-parser p1 ;
 
@@ -202,7 +202,7 @@ TUPLE: ensure-parser p1 ;
   ] ;
 
 M: ensure-parser (compile) ( parser -- quot )
-  ensure-parser-p1 compiled-parser \ ?quot ensure-pattern match-replace ;
+  p1>> compiled-parser \ ?quot ensure-pattern match-replace ;
 
 TUPLE: ensure-not-parser p1 ;
 
@@ -216,7 +216,7 @@ TUPLE: ensure-not-parser p1 ;
   ] ;
 
 M: ensure-not-parser (compile) ( parser -- quot )
-  ensure-not-parser-p1 compiled-parser \ ?quot ensure-not-pattern match-replace ;
+  p1>> compiled-parser \ ?quot ensure-not-pattern match-replace ;
 
 TUPLE: action-parser p1 quot ;
 
@@ -225,13 +225,13 @@ MATCH-VARS: ?action ;
 : action-pattern ( -- quot )
   [
     ?quot dup [ 
-      dup parse-result-ast ?action call
-      swap [ set-parse-result-ast ] keep
+      dup ast>> ?action call
+      >>ast
     ] when 
   ] ;
 
 M: action-parser (compile) ( parser -- quot )
-  { action-parser-p1 action-parser-quot } get-slots [ compiled-parser ] dip 
+  { [ p1>> ] [ quot>> ] } cleave [ compiled-parser ] dip 
   2array { ?quot ?action } action-pattern match-replace ;
 
 : left-trim-slice ( string -- string )
@@ -245,7 +245,7 @@ TUPLE: sp-parser p1 ;
 
 M: sp-parser (compile) ( parser -- quot )
   [
-    \ left-trim-slice , sp-parser-p1 compiled-parser , 
+    \ left-trim-slice , p1>> compiled-parser , 
   ] [ ] make ;
 
 TUPLE: delay-parser quot ;
@@ -255,7 +255,7 @@ M: delay-parser (compile) ( parser -- quot )
   #! This way it is run only once and the 
   #! parser constructed once at run time.
   [
-    delay-parser-quot % \ compile ,
+    quot>> % \ compile ,
   ] [ ] make 
   { } { "word" } <effect> memoize-quot 
   [ % \ execute , ] [ ] make ;

diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor
index 172a80b612abdcec46e98abe3b9ba142f6887105..b019326ed5dbc1bac60fe60eed960a17768db18d 100755 (executable)
--- a/extra/tools/deploy/backend/backend.factor
+++ b/extra/tools/deploy/backend/backend.factor
@@ -21,6 +21,7 @@ IN: tools.deploy.backend
         swap >>command
         +stdout+ >>stderr
         +closed+ >>stdin
+        +low-priority+ >>priority
     utf8 <process-stream>
     dup copy-lines
     process>> wait-for-process zero? [

diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor
index e9527e6f9a7dfe8e4fc94990f95a3b02b6151f00..dc56009b870e9ab765a0f545c73caa3a654f031b 100755 (executable)
--- a/extra/ui/freetype/freetype.factor
+++ b/extra/ui/freetype/freetype.factor
@@ -62,7 +62,7 @@ M: freetype-renderer free-fonts ( world -- )
     } at ;
 
 : ttf-path ( name -- string )
-    "/fonts/" swap ".ttf" 3append resource-path ;
+    "resource:fonts/" swap ".ttf" 3append ?resource-path ;
 
 : (open-face) ( path length -- face )
     #! We use FT_New_Memory_Face, not FT_New_Face, since

diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor
index 22a86818cfc9719f890d9b7dc89f1e10f03c404c..ec70b14e684b1c83254d22d7a486925f2a4a3d31 100644 (file)
--- a/extra/windows/kernel32/kernel32.factor
+++ b/extra/windows/kernel32/kernel32.factor
@@ -125,7 +125,6 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
 : OF_REOPEN    32768 ;
 : OF_VERIFY    1024 ;
 
-
 : INFINITE HEX: FFFFFFFF ; inline
 
 ! From C:\cygwin\usr\include\w32api\winbase.h