Merge branch 'master' of git://factorcode.org/git/factor
commit
f368f4636b
|
@ -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
|
||||||
[ "/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/bar/." parent-directory ] must-fail
|
||||||
[ "foo/" ] [ "foo/bar/./" parent-directory ] unit-test
|
[ "foo/bar/./" parent-directory ] must-fail
|
||||||
[ "foo/" ] [ "foo/bar/baz/.." parent-directory ] unit-test
|
[ "foo/bar/baz/.." parent-directory ] must-fail
|
||||||
[ "foo/" ] [ "foo/bar/baz/../" parent-directory ] unit-test
|
[ "foo/bar/baz/../" parent-directory ] must-fail
|
||||||
|
|
||||||
[ "." parent-directory ] must-fail
|
[ "." 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
|
[ "../../" parent-directory ] must-fail
|
||||||
[ "foo/.." parent-directory ] must-fail
|
[ "foo/.." 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/foo" ] [ "bar/baz" "..///foo" append-path ] unit-test
|
||||||
[ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test
|
[ "bar/baz/foo" ] [ "bar/baz" ".///foo" append-path ] unit-test
|
||||||
|
|
|
@ -66,14 +66,12 @@ ERROR: no-parent-directory path ;
|
||||||
right-trim-separators
|
right-trim-separators
|
||||||
dup last-path-separator [
|
dup last-path-separator [
|
||||||
1+ cut
|
1+ cut
|
||||||
{
|
] [
|
||||||
{ "." [ 1 head* parent-directory ] }
|
drop "." swap
|
||||||
{ ".." [
|
] if
|
||||||
2 head* parent-directory parent-directory
|
{ "" "." ".." } member? [
|
||||||
] }
|
no-parent-directory
|
||||||
[ drop ]
|
] when
|
||||||
} case
|
|
||||||
] [ no-parent-directory ] if
|
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -157,6 +155,8 @@ HOOK: cwd io-backend ( -- path )
|
||||||
|
|
||||||
SYMBOL: current-directory
|
SYMBOL: current-directory
|
||||||
|
|
||||||
|
M: object cwd ( -- path ) "." ;
|
||||||
|
|
||||||
[ cwd current-directory set-global ] "current-directory" add-init-hook
|
[ cwd current-directory set-global ] "current-directory" add-init-hook
|
||||||
|
|
||||||
: with-directory ( path quot -- )
|
: with-directory ( path quot -- )
|
||||||
|
@ -259,7 +259,7 @@ DEFER: copy-tree-into
|
||||||
prepend-path ;
|
prepend-path ;
|
||||||
|
|
||||||
: ?resource-path ( path -- newpath )
|
: ?resource-path ( path -- newpath )
|
||||||
"resource:" ?head [ resource-path ] when ;
|
"resource:" ?head [ left-trim-separators resource-path ] when ;
|
||||||
|
|
||||||
: resource-exists? ( path -- ? )
|
: resource-exists? ( path -- ? )
|
||||||
?resource-path exists? ;
|
?resource-path exists? ;
|
||||||
|
|
|
@ -38,6 +38,7 @@ SYMBOL: +low-priority+
|
||||||
SYMBOL: +normal-priority+
|
SYMBOL: +normal-priority+
|
||||||
SYMBOL: +high-priority+
|
SYMBOL: +high-priority+
|
||||||
SYMBOL: +highest-priority+
|
SYMBOL: +highest-priority+
|
||||||
|
SYMBOL: +realtime-priority+
|
||||||
|
|
||||||
: <process> ( -- process )
|
: <process> ( -- process )
|
||||||
process construct-empty
|
process construct-empty
|
||||||
|
|
|
@ -6,7 +6,6 @@ IN: io.unix.files.tests
|
||||||
[ "/" ] [ "/etc/" parent-directory ] unit-test
|
[ "/" ] [ "/etc/" parent-directory ] unit-test
|
||||||
[ "/" ] [ "/etc" parent-directory ] unit-test
|
[ "/" ] [ "/etc" parent-directory ] unit-test
|
||||||
[ "/" ] [ "/" parent-directory ] unit-test
|
[ "/" ] [ "/" parent-directory ] unit-test
|
||||||
[ "asdf" parent-directory ] must-fail
|
|
||||||
|
|
||||||
[ f ] [ "" root-directory? ] unit-test
|
[ f ] [ "" root-directory? ] unit-test
|
||||||
[ t ] [ "/" root-directory? ] unit-test
|
[ t ] [ "/" root-directory? ] unit-test
|
||||||
|
|
|
@ -24,6 +24,7 @@ USE: unix
|
||||||
{ +normal-priority+ 0 }
|
{ +normal-priority+ 0 }
|
||||||
{ +high-priority+ -10 }
|
{ +high-priority+ -10 }
|
||||||
{ +highest-priority+ -20 }
|
{ +highest-priority+ -20 }
|
||||||
|
{ +realtime-priority+ -20 }
|
||||||
} at set-priority
|
} at set-priority
|
||||||
] when* ;
|
] when* ;
|
||||||
|
|
||||||
|
|
|
@ -49,6 +49,17 @@ TUPLE: CreateProcess-args
|
||||||
: join-arguments ( args -- cmd-line )
|
: join-arguments ( args -- cmd-line )
|
||||||
[ escape-argument ] map " " join ;
|
[ 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 )
|
: app-name/cmd-line ( process -- app-name cmd-line )
|
||||||
command>> dup string? [
|
command>> dup string? [
|
||||||
" " split1
|
" " split1
|
||||||
|
@ -71,6 +82,7 @@ TUPLE: CreateProcess-args
|
||||||
0
|
0
|
||||||
pick pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
|
pick pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when
|
||||||
pick detached>> winnt? and [ DETACHED_PROCESS bitor ] when
|
pick detached>> winnt? and [ DETACHED_PROCESS bitor ] when
|
||||||
|
pick lookup-priority [ bitor ] when*
|
||||||
>>dwCreateFlags ;
|
>>dwCreateFlags ;
|
||||||
|
|
||||||
: fill-lpEnvironment ( process args -- process args )
|
: fill-lpEnvironment ( process args -- process args )
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel math sequences vectors classes combinators
|
USING: kernel math sequences vectors classes classes.algebra
|
||||||
arrays words assocs parser namespaces definitions
|
combinators arrays words assocs parser namespaces definitions
|
||||||
prettyprint prettyprint.backend quotations arrays.lib
|
prettyprint prettyprint.backend quotations arrays.lib
|
||||||
debugger io compiler.units kernel.private effects ;
|
debugger io compiler.units kernel.private effects ;
|
||||||
IN: multi-methods
|
IN: multi-methods
|
||||||
|
|
|
@ -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" } ;
|
|
@ -3,7 +3,7 @@
|
||||||
USING: kernel compiler.units parser words arrays strings math.parser sequences
|
USING: kernel compiler.units parser words arrays strings math.parser sequences
|
||||||
quotations vectors namespaces math assocs continuations peg
|
quotations vectors namespaces math assocs continuations peg
|
||||||
peg.parsers unicode.categories multiline combinators.lib
|
peg.parsers unicode.categories multiline combinators.lib
|
||||||
splitting ;
|
splitting accessors ;
|
||||||
IN: peg.ebnf
|
IN: peg.ebnf
|
||||||
|
|
||||||
TUPLE: ebnf-non-terminal symbol ;
|
TUPLE: ebnf-non-terminal symbol ;
|
||||||
|
@ -16,7 +16,7 @@ TUPLE: ebnf-choice options ;
|
||||||
TUPLE: ebnf-sequence elements ;
|
TUPLE: ebnf-sequence elements ;
|
||||||
TUPLE: ebnf-repeat0 group ;
|
TUPLE: ebnf-repeat0 group ;
|
||||||
TUPLE: ebnf-repeat1 group ;
|
TUPLE: ebnf-repeat1 group ;
|
||||||
TUPLE: ebnf-optional elements ;
|
TUPLE: ebnf-optional group ;
|
||||||
TUPLE: ebnf-rule symbol elements ;
|
TUPLE: ebnf-rule symbol elements ;
|
||||||
TUPLE: ebnf-action parser code ;
|
TUPLE: ebnf-action parser code ;
|
||||||
TUPLE: ebnf rules ;
|
TUPLE: ebnf rules ;
|
||||||
|
@ -198,7 +198,7 @@ DEFER: 'choice'
|
||||||
|
|
||||||
: 'rule' ( -- parser )
|
: 'rule' ( -- parser )
|
||||||
[
|
[
|
||||||
'non-terminal' [ ebnf-non-terminal-symbol ] action ,
|
'non-terminal' [ symbol>> ] action ,
|
||||||
"=" syntax ,
|
"=" syntax ,
|
||||||
'choice' ,
|
'choice' ,
|
||||||
] seq* [ first2 <ebnf-rule> ] action ;
|
] seq* [ first2 <ebnf-rule> ] action ;
|
||||||
|
@ -215,49 +215,53 @@ SYMBOL: main
|
||||||
H{ } clone dup dup [ parser set swap (transform) main set ] bind ;
|
H{ } clone dup dup [ parser set swap (transform) main set ] bind ;
|
||||||
|
|
||||||
M: ebnf (transform) ( ast -- parser )
|
M: ebnf (transform) ( ast -- parser )
|
||||||
ebnf-rules [ (transform) ] map peek ;
|
rules>> [ (transform) ] map peek ;
|
||||||
|
|
||||||
M: ebnf-rule (transform) ( ast -- parser )
|
M: ebnf-rule (transform) ( ast -- parser )
|
||||||
dup ebnf-rule-elements (transform) [
|
dup elements>> (transform) [
|
||||||
swap ebnf-rule-symbol set
|
swap symbol>> set
|
||||||
] keep ;
|
] keep ;
|
||||||
|
|
||||||
M: ebnf-sequence (transform) ( ast -- parser )
|
M: ebnf-sequence (transform) ( ast -- parser )
|
||||||
ebnf-sequence-elements [ (transform) ] map seq ;
|
elements>> [ (transform) ] map seq ;
|
||||||
|
|
||||||
M: ebnf-choice (transform) ( ast -- parser )
|
M: ebnf-choice (transform) ( ast -- parser )
|
||||||
ebnf-choice-options [ (transform) ] map choice ;
|
options>> [ (transform) ] map choice ;
|
||||||
|
|
||||||
M: ebnf-any-character (transform) ( ast -- parser )
|
M: ebnf-any-character (transform) ( ast -- parser )
|
||||||
drop any-char ;
|
drop any-char ;
|
||||||
|
|
||||||
M: ebnf-range (transform) ( ast -- parser )
|
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 )
|
M: ebnf-ensure (transform) ( ast -- parser )
|
||||||
ebnf-ensure-group (transform) ensure ;
|
transform-group ensure ;
|
||||||
|
|
||||||
M: ebnf-ensure-not (transform) ( ast -- parser )
|
M: ebnf-ensure-not (transform) ( ast -- parser )
|
||||||
ebnf-ensure-not-group (transform) ensure-not ;
|
transform-group ensure-not ;
|
||||||
|
|
||||||
M: ebnf-repeat0 (transform) ( ast -- parser )
|
M: ebnf-repeat0 (transform) ( ast -- parser )
|
||||||
ebnf-repeat0-group (transform) repeat0 ;
|
transform-group repeat0 ;
|
||||||
|
|
||||||
M: ebnf-repeat1 (transform) ( ast -- parser )
|
M: ebnf-repeat1 (transform) ( ast -- parser )
|
||||||
ebnf-repeat1-group (transform) repeat1 ;
|
transform-group repeat1 ;
|
||||||
|
|
||||||
M: ebnf-optional (transform) ( ast -- parser )
|
M: ebnf-optional (transform) ( ast -- parser )
|
||||||
ebnf-optional-elements (transform) optional ;
|
transform-group optional ;
|
||||||
|
|
||||||
M: ebnf-action (transform) ( ast -- parser )
|
M: ebnf-action (transform) ( ast -- parser )
|
||||||
[ ebnf-action-parser (transform) ] keep
|
[ parser>> (transform) ] keep
|
||||||
ebnf-action-code string-lines [ parse-lines ] with-compilation-unit action ;
|
code>> string-lines [ parse-lines ] with-compilation-unit action ;
|
||||||
|
|
||||||
M: ebnf-terminal (transform) ( ast -- parser )
|
M: ebnf-terminal (transform) ( ast -- parser )
|
||||||
ebnf-terminal-symbol token sp ;
|
symbol>> token sp ;
|
||||||
|
|
||||||
M: ebnf-non-terminal (transform) ( ast -- parser )
|
M: ebnf-non-terminal (transform) ( ast -- parser )
|
||||||
ebnf-non-terminal-symbol [
|
symbol>> [
|
||||||
, parser get , \ at ,
|
, parser get , \ at ,
|
||||||
] [ ] make delay sp ;
|
] [ ] make delay sp ;
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: kernel sequences strings namespaces math assocs shuffle
|
USING: kernel sequences strings namespaces math assocs shuffle
|
||||||
vectors arrays combinators.lib math.parser match
|
vectors arrays combinators.lib math.parser match
|
||||||
unicode.categories sequences.lib compiler.units parser
|
unicode.categories sequences.lib compiler.units parser
|
||||||
words quotations effects memoize ;
|
words quotations effects memoize accessors combinators.cleave ;
|
||||||
IN: peg
|
IN: peg
|
||||||
|
|
||||||
TUPLE: parse-result remaining ast ;
|
TUPLE: parse-result remaining ast ;
|
||||||
|
@ -52,7 +52,7 @@ MATCH-VARS: ?token ;
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: token-parser (compile) ( parser -- quot )
|
M: token-parser (compile) ( parser -- quot )
|
||||||
token-parser-symbol [ parse-token ] curry ;
|
symbol>> [ parse-token ] curry ;
|
||||||
|
|
||||||
TUPLE: satisfy-parser quot ;
|
TUPLE: satisfy-parser quot ;
|
||||||
|
|
||||||
|
@ -72,7 +72,7 @@ MATCH-VARS: ?quot ;
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: satisfy-parser (compile) ( parser -- 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 ;
|
TUPLE: range-parser min max ;
|
||||||
|
|
||||||
|
@ -100,12 +100,12 @@ TUPLE: seq-parser parsers ;
|
||||||
: seq-pattern ( -- quot )
|
: seq-pattern ( -- quot )
|
||||||
[
|
[
|
||||||
dup [
|
dup [
|
||||||
dup parse-result-remaining ?quot [
|
dup remaining>> ?quot [
|
||||||
[ parse-result-remaining swap set-parse-result-remaining ] 2keep
|
[ remaining>> swap (>>remaining) ] 2keep
|
||||||
parse-result-ast dup ignore = [
|
ast>> dup ignore = [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
swap [ parse-result-ast push ] keep
|
swap [ ast>> push ] keep
|
||||||
] if
|
] if
|
||||||
] [
|
] [
|
||||||
drop f
|
drop f
|
||||||
|
@ -118,7 +118,7 @@ TUPLE: seq-parser parsers ;
|
||||||
M: seq-parser (compile) ( parser -- quot )
|
M: seq-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
[ V{ } clone <parse-result> ] %
|
[ 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 ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: choice-parser parsers ;
|
TUPLE: choice-parser parsers ;
|
||||||
|
@ -135,16 +135,16 @@ TUPLE: choice-parser parsers ;
|
||||||
M: choice-parser (compile) ( parser -- quot )
|
M: choice-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
f ,
|
f ,
|
||||||
choice-parser-parsers [ compiled-parser \ ?quot choice-pattern match-replace % ] each
|
parsers>> [ compiled-parser \ ?quot choice-pattern match-replace % ] each
|
||||||
\ nip ,
|
\ nip ,
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: repeat0-parser p1 ;
|
TUPLE: repeat0-parser p1 ;
|
||||||
|
|
||||||
: (repeat0) ( quot result -- result )
|
: (repeat0) ( quot result -- result )
|
||||||
2dup parse-result-remaining swap call [
|
2dup remaining>> swap call [
|
||||||
[ parse-result-remaining swap set-parse-result-remaining ] 2keep
|
[ remaining>> swap (>>remaining) ] 2keep
|
||||||
parse-result-ast swap [ parse-result-ast push ] keep
|
ast>> swap [ ast>> push ] keep
|
||||||
(repeat0)
|
(repeat0)
|
||||||
] [
|
] [
|
||||||
nip
|
nip
|
||||||
|
@ -158,7 +158,7 @@ TUPLE: repeat0-parser p1 ;
|
||||||
M: repeat0-parser (compile) ( parser -- quot )
|
M: repeat0-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
[ V{ } clone <parse-result> ] %
|
[ V{ } clone <parse-result> ] %
|
||||||
repeat0-parser-p1 compiled-parser \ ?quot repeat0-pattern match-replace %
|
p1>> compiled-parser \ ?quot repeat0-pattern match-replace %
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: repeat1-parser p1 ;
|
TUPLE: repeat1-parser p1 ;
|
||||||
|
@ -166,7 +166,7 @@ TUPLE: repeat1-parser p1 ;
|
||||||
: repeat1-pattern ( -- quot )
|
: repeat1-pattern ( -- quot )
|
||||||
[
|
[
|
||||||
[ ?quot ] swap (repeat0) [
|
[ ?quot ] swap (repeat0) [
|
||||||
dup parse-result-ast empty? [
|
dup ast>> empty? [
|
||||||
drop f
|
drop f
|
||||||
] when
|
] when
|
||||||
] [
|
] [
|
||||||
|
@ -177,7 +177,7 @@ TUPLE: repeat1-parser p1 ;
|
||||||
M: repeat1-parser (compile) ( parser -- quot )
|
M: repeat1-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
[ V{ } clone <parse-result> ] %
|
[ V{ } clone <parse-result> ] %
|
||||||
repeat1-parser-p1 compiled-parser \ ?quot repeat1-pattern match-replace %
|
p1>> compiled-parser \ ?quot repeat1-pattern match-replace %
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: optional-parser p1 ;
|
TUPLE: optional-parser p1 ;
|
||||||
|
@ -188,7 +188,7 @@ TUPLE: optional-parser p1 ;
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: optional-parser (compile) ( parser -- quot )
|
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 ;
|
TUPLE: ensure-parser p1 ;
|
||||||
|
|
||||||
|
@ -202,7 +202,7 @@ TUPLE: ensure-parser p1 ;
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: ensure-parser (compile) ( parser -- quot )
|
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 ;
|
TUPLE: ensure-not-parser p1 ;
|
||||||
|
|
||||||
|
@ -216,7 +216,7 @@ TUPLE: ensure-not-parser p1 ;
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: ensure-not-parser (compile) ( parser -- quot )
|
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 ;
|
TUPLE: action-parser p1 quot ;
|
||||||
|
|
||||||
|
@ -225,13 +225,13 @@ MATCH-VARS: ?action ;
|
||||||
: action-pattern ( -- quot )
|
: action-pattern ( -- quot )
|
||||||
[
|
[
|
||||||
?quot dup [
|
?quot dup [
|
||||||
dup parse-result-ast ?action call
|
dup ast>> ?action call
|
||||||
swap [ set-parse-result-ast ] keep
|
>>ast
|
||||||
] when
|
] when
|
||||||
] ;
|
] ;
|
||||||
|
|
||||||
M: action-parser (compile) ( parser -- quot )
|
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 ;
|
2array { ?quot ?action } action-pattern match-replace ;
|
||||||
|
|
||||||
: left-trim-slice ( string -- string )
|
: left-trim-slice ( string -- string )
|
||||||
|
@ -245,7 +245,7 @@ TUPLE: sp-parser p1 ;
|
||||||
|
|
||||||
M: sp-parser (compile) ( parser -- quot )
|
M: sp-parser (compile) ( parser -- quot )
|
||||||
[
|
[
|
||||||
\ left-trim-slice , sp-parser-p1 compiled-parser ,
|
\ left-trim-slice , p1>> compiled-parser ,
|
||||||
] [ ] make ;
|
] [ ] make ;
|
||||||
|
|
||||||
TUPLE: delay-parser quot ;
|
TUPLE: delay-parser quot ;
|
||||||
|
@ -255,7 +255,7 @@ M: delay-parser (compile) ( parser -- quot )
|
||||||
#! This way it is run only once and the
|
#! This way it is run only once and the
|
||||||
#! parser constructed once at run time.
|
#! parser constructed once at run time.
|
||||||
[
|
[
|
||||||
delay-parser-quot % \ compile ,
|
quot>> % \ compile ,
|
||||||
] [ ] make
|
] [ ] make
|
||||||
{ } { "word" } <effect> memoize-quot
|
{ } { "word" } <effect> memoize-quot
|
||||||
[ % \ execute , ] [ ] make ;
|
[ % \ execute , ] [ ] make ;
|
||||||
|
|
|
@ -21,6 +21,7 @@ IN: tools.deploy.backend
|
||||||
swap >>command
|
swap >>command
|
||||||
+stdout+ >>stderr
|
+stdout+ >>stderr
|
||||||
+closed+ >>stdin
|
+closed+ >>stdin
|
||||||
|
+low-priority+ >>priority
|
||||||
utf8 <process-stream>
|
utf8 <process-stream>
|
||||||
dup copy-lines
|
dup copy-lines
|
||||||
process>> wait-for-process zero? [
|
process>> wait-for-process zero? [
|
||||||
|
|
|
@ -62,7 +62,7 @@ M: freetype-renderer free-fonts ( world -- )
|
||||||
} at ;
|
} at ;
|
||||||
|
|
||||||
: ttf-path ( name -- string )
|
: ttf-path ( name -- string )
|
||||||
"/fonts/" swap ".ttf" 3append resource-path ;
|
"resource:fonts/" swap ".ttf" 3append ?resource-path ;
|
||||||
|
|
||||||
: (open-face) ( path length -- face )
|
: (open-face) ( path length -- face )
|
||||||
#! We use FT_New_Memory_Face, not FT_New_Face, since
|
#! We use FT_New_Memory_Face, not FT_New_Face, since
|
||||||
|
|
|
@ -125,7 +125,6 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
|
||||||
: OF_REOPEN 32768 ;
|
: OF_REOPEN 32768 ;
|
||||||
: OF_VERIFY 1024 ;
|
: OF_VERIFY 1024 ;
|
||||||
|
|
||||||
|
|
||||||
: INFINITE HEX: FFFFFFFF ; inline
|
: INFINITE HEX: FFFFFFFF ; inline
|
||||||
|
|
||||||
! From C:\cygwin\usr\include\w32api\winbase.h
|
! From C:\cygwin\usr\include\w32api\winbase.h
|
||||||
|
|
Loading…
Reference in New Issue