diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index e3765fead0..7af1b602d0 100755 --- 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 8595f227bf..6500bdb387 100755 --- 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 ; ( -- process ) process construct-empty diff --git a/extra/io/unix/files/files-tests.factor b/extra/io/unix/files/files-tests.factor index 98de09e8f1..22b29b7a51 100755 --- 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 e16ecde6fa..11c608c68f 100755 --- 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 ca8f5f3e59..2d281d0fe8 100755 --- 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 9a74cc65e8..42ade34186 100755 --- 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 index 0000000000..dd31bfd001 --- /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 db478e571f..11e1e2ea64 100644 --- 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 quotations vectors namespaces math assocs continuations peg peg.parsers unicode.categories multiline combinators.lib - splitting ; + splitting accessors ; IN: peg.ebnf TUPLE: ebnf-non-terminal symbol ; @@ -16,7 +16,7 @@ TUPLE: ebnf-choice options ; TUPLE: ebnf-sequence elements ; TUPLE: ebnf-repeat0 group ; TUPLE: ebnf-repeat1 group ; -TUPLE: ebnf-optional elements ; +TUPLE: ebnf-optional group ; TUPLE: ebnf-rule symbol elements ; TUPLE: ebnf-action parser code ; TUPLE: ebnf rules ; @@ -198,7 +198,7 @@ DEFER: 'choice' : 'rule' ( -- parser ) [ - 'non-terminal' [ ebnf-non-terminal-symbol ] action , + 'non-terminal' [ symbol>> ] action , "=" syntax , 'choice' , ] seq* [ first2 ] action ; @@ -215,49 +215,53 @@ SYMBOL: main H{ } clone dup dup [ parser set swap (transform) main set ] bind ; M: ebnf (transform) ( ast -- parser ) - ebnf-rules [ (transform) ] map peek ; + rules>> [ (transform) ] map peek ; M: ebnf-rule (transform) ( ast -- parser ) - dup ebnf-rule-elements (transform) [ - swap ebnf-rule-symbol set + dup elements>> (transform) [ + swap symbol>> set ] keep ; M: ebnf-sequence (transform) ( ast -- parser ) - ebnf-sequence-elements [ (transform) ] map seq ; + elements>> [ (transform) ] map seq ; M: ebnf-choice (transform) ( ast -- parser ) - ebnf-choice-options [ (transform) ] map choice ; + options>> [ (transform) ] map choice ; M: ebnf-any-character (transform) ( ast -- parser ) drop any-char ; M: ebnf-range (transform) ( ast -- parser ) - ebnf-range-pattern range-pattern ; + pattern>> range-pattern ; + +: transform-group ( ast -- parser ) + #! convert a ast node with groups to a parser for that group + group>> (transform) ; M: ebnf-ensure (transform) ( ast -- parser ) - ebnf-ensure-group (transform) ensure ; + transform-group ensure ; M: ebnf-ensure-not (transform) ( ast -- parser ) - ebnf-ensure-not-group (transform) ensure-not ; + transform-group ensure-not ; M: ebnf-repeat0 (transform) ( ast -- parser ) - ebnf-repeat0-group (transform) repeat0 ; + transform-group repeat0 ; M: ebnf-repeat1 (transform) ( ast -- parser ) - ebnf-repeat1-group (transform) repeat1 ; + transform-group repeat1 ; M: ebnf-optional (transform) ( ast -- parser ) - ebnf-optional-elements (transform) optional ; + transform-group optional ; M: ebnf-action (transform) ( ast -- parser ) - [ ebnf-action-parser (transform) ] keep - ebnf-action-code string-lines [ parse-lines ] with-compilation-unit action ; + [ parser>> (transform) ] keep + code>> string-lines [ parse-lines ] with-compilation-unit action ; M: ebnf-terminal (transform) ( ast -- parser ) - ebnf-terminal-symbol token sp ; + symbol>> token sp ; M: ebnf-non-terminal (transform) ( ast -- parser ) - ebnf-non-terminal-symbol [ + symbol>> [ , parser get , \ at , ] [ ] make delay sp ; diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index ae5ed2f8b2..00271a9ad3 100755 --- 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 ] % - 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 ] % - 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 ] % - 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" } memoize-quot [ % \ execute , ] [ ] make ; diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor index 172a80b612..b019326ed5 100755 --- 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 dup copy-lines process>> wait-for-process zero? [ diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor index e9527e6f9a..dc56009b87 100755 --- 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 22a86818cf..ec70b14e68 100644 --- 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