Merge branch 'master' of git://factorcode.org/git/factor
commit
950e376f95
|
@ -15,12 +15,12 @@ crossref off
|
||||||
"resource:core/bootstrap/syntax.factor" parse-file
|
"resource:core/bootstrap/syntax.factor" parse-file
|
||||||
|
|
||||||
"resource:core/cpu/" architecture get {
|
"resource:core/cpu/" architecture get {
|
||||||
{ "x86.32" "x86/32" }
|
{ "x86.32" "x86/32" }
|
||||||
{ "x86.64" "x86/64" }
|
{ "x86.64" "x86/64" }
|
||||||
{ "linux-ppc" "ppc/linux" }
|
{ "linux-ppc" "ppc/linux" }
|
||||||
{ "macosx-ppc" "ppc/macosx" }
|
{ "macosx-ppc" "ppc/macosx" }
|
||||||
{ "arm" "arm" }
|
{ "arm" "arm" }
|
||||||
} at "/bootstrap.factor" 3append parse-file
|
} at "/bootstrap.factor" 3append parse-file
|
||||||
|
|
||||||
"resource:core/bootstrap/layouts/layouts.factor" parse-file
|
"resource:core/bootstrap/layouts/layouts.factor" parse-file
|
||||||
|
|
||||||
|
@ -626,7 +626,7 @@ builtins get num-tags get tail f union-class define-class
|
||||||
{ "<float-array>" "float-arrays" }
|
{ "<float-array>" "float-arrays" }
|
||||||
{ "curry" "kernel" }
|
{ "curry" "kernel" }
|
||||||
{ "<tuple-boa>" "tuples.private" }
|
{ "<tuple-boa>" "tuples.private" }
|
||||||
{ "class-hash" "kernel.private" }
|
{ "class-hash" "kernel.private" }
|
||||||
{ "callstack>array" "kernel" }
|
{ "callstack>array" "kernel" }
|
||||||
{ "innermost-frame-quot" "kernel.private" }
|
{ "innermost-frame-quot" "kernel.private" }
|
||||||
{ "innermost-frame-scan" "kernel.private" }
|
{ "innermost-frame-scan" "kernel.private" }
|
||||||
|
|
|
@ -1,12 +1,11 @@
|
||||||
! Copyright (C) 2005, 2007 Slava Pestov.
|
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays definitions generic assocs kernel math
|
USING: arrays definitions generic assocs kernel math
|
||||||
namespaces prettyprint sequences strings vectors words
|
namespaces prettyprint sequences strings vectors words
|
||||||
quotations inspector io.styles io combinators sorting
|
quotations inspector io.styles io combinators sorting
|
||||||
splitting math.parser effects continuations debugger
|
splitting math.parser effects continuations debugger
|
||||||
io.files io.streams.string io.streams.lines vocabs
|
io.files io.streams.string io.streams.lines vocabs
|
||||||
source-files classes hashtables compiler.errors compiler.units
|
source-files classes hashtables compiler.errors compiler.units ;
|
||||||
ascii ;
|
|
||||||
IN: parser
|
IN: parser
|
||||||
|
|
||||||
TUPLE: lexer text line column ;
|
TUPLE: lexer text line column ;
|
||||||
|
@ -55,8 +54,9 @@ t parser-notes set-global
|
||||||
0 over set-lexer-column
|
0 over set-lexer-column
|
||||||
dup lexer-line 1+ swap set-lexer-line ;
|
dup lexer-line 1+ swap set-lexer-line ;
|
||||||
|
|
||||||
: skip ( i seq quot -- n )
|
: skip ( i seq ? -- n )
|
||||||
over >r find* drop
|
over >r
|
||||||
|
[ swap CHAR: \s eq? xor ] curry find* drop
|
||||||
[ r> drop ] [ r> length ] if* ; inline
|
[ r> drop ] [ r> length ] if* ; inline
|
||||||
|
|
||||||
: change-column ( lexer quot -- )
|
: change-column ( lexer quot -- )
|
||||||
|
@ -67,14 +67,13 @@ t parser-notes set-global
|
||||||
GENERIC: skip-blank ( lexer -- )
|
GENERIC: skip-blank ( lexer -- )
|
||||||
|
|
||||||
M: lexer skip-blank ( lexer -- )
|
M: lexer skip-blank ( lexer -- )
|
||||||
[ [ blank? not ] skip ] change-column ;
|
[ t skip ] change-column ;
|
||||||
|
|
||||||
GENERIC: skip-word ( lexer -- )
|
GENERIC: skip-word ( lexer -- )
|
||||||
|
|
||||||
M: lexer skip-word ( lexer -- )
|
M: lexer skip-word ( lexer -- )
|
||||||
[
|
[
|
||||||
2dup nth CHAR: " =
|
2dup nth CHAR: " = [ drop 1+ ] [ f skip ] if
|
||||||
[ drop 1+ ] [ [ blank? ] skip ] if
|
|
||||||
] change-column ;
|
] change-column ;
|
||||||
|
|
||||||
: still-parsing? ( lexer -- ? )
|
: still-parsing? ( lexer -- ? )
|
||||||
|
@ -348,45 +347,49 @@ SYMBOL: bootstrap-syntax
|
||||||
call
|
call
|
||||||
] with-scope ; inline
|
] with-scope ; inline
|
||||||
|
|
||||||
|
SYMBOL: interactive-vocabs
|
||||||
|
|
||||||
|
{
|
||||||
|
"arrays"
|
||||||
|
"assocs"
|
||||||
|
"combinators"
|
||||||
|
"compiler.errors"
|
||||||
|
"continuations"
|
||||||
|
"debugger"
|
||||||
|
"definitions"
|
||||||
|
"editors"
|
||||||
|
"generic"
|
||||||
|
"help"
|
||||||
|
"inspector"
|
||||||
|
"io"
|
||||||
|
"io.files"
|
||||||
|
"kernel"
|
||||||
|
"listener"
|
||||||
|
"math"
|
||||||
|
"memory"
|
||||||
|
"namespaces"
|
||||||
|
"prettyprint"
|
||||||
|
"sequences"
|
||||||
|
"slicing"
|
||||||
|
"sorting"
|
||||||
|
"strings"
|
||||||
|
"syntax"
|
||||||
|
"tools.annotations"
|
||||||
|
"tools.crossref"
|
||||||
|
"tools.memory"
|
||||||
|
"tools.profiler"
|
||||||
|
"tools.test"
|
||||||
|
"tools.time"
|
||||||
|
"vocabs"
|
||||||
|
"vocabs.loader"
|
||||||
|
"words"
|
||||||
|
"scratchpad"
|
||||||
|
} interactive-vocabs set-global
|
||||||
|
|
||||||
: with-interactive-vocabs ( quot -- )
|
: with-interactive-vocabs ( quot -- )
|
||||||
[
|
[
|
||||||
"scratchpad" in set
|
"scratchpad" in set
|
||||||
{
|
interactive-vocabs get set-use
|
||||||
"arrays"
|
|
||||||
"assocs"
|
|
||||||
"combinators"
|
|
||||||
"compiler.errors"
|
|
||||||
"continuations"
|
|
||||||
"debugger"
|
|
||||||
"definitions"
|
|
||||||
"editors"
|
|
||||||
"generic"
|
|
||||||
"help"
|
|
||||||
"inspector"
|
|
||||||
"io"
|
|
||||||
"io.files"
|
|
||||||
"kernel"
|
|
||||||
"listener"
|
|
||||||
"math"
|
|
||||||
"memory"
|
|
||||||
"namespaces"
|
|
||||||
"prettyprint"
|
|
||||||
"sequences"
|
|
||||||
"slicing"
|
|
||||||
"sorting"
|
|
||||||
"strings"
|
|
||||||
"syntax"
|
|
||||||
"tools.annotations"
|
|
||||||
"tools.crossref"
|
|
||||||
"tools.memory"
|
|
||||||
"tools.profiler"
|
|
||||||
"tools.test"
|
|
||||||
"tools.time"
|
|
||||||
"vocabs"
|
|
||||||
"vocabs.loader"
|
|
||||||
"words"
|
|
||||||
"scratchpad"
|
|
||||||
} set-use
|
|
||||||
call
|
call
|
||||||
] with-scope ; inline
|
] with-scope ; inline
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: arrays byte-arrays byte-vectors bit-arrays bit-vectors
|
||||||
generic hashtables io assocs kernel math namespaces sequences
|
generic hashtables io assocs kernel math namespaces sequences
|
||||||
strings sbufs io.styles vectors words prettyprint.config
|
strings sbufs io.styles vectors words prettyprint.config
|
||||||
prettyprint.sections quotations io io.files math.parser effects
|
prettyprint.sections quotations io io.files math.parser effects
|
||||||
tuples classes float-arrays float-vectors ascii ;
|
tuples classes float-arrays float-vectors ;
|
||||||
IN: prettyprint.backend
|
IN: prettyprint.backend
|
||||||
|
|
||||||
GENERIC: pprint* ( obj -- )
|
GENERIC: pprint* ( obj -- )
|
||||||
|
@ -58,24 +58,17 @@ M: f pprint* drop \ f pprint-word ;
|
||||||
! Strings
|
! Strings
|
||||||
: ch>ascii-escape ( ch -- str )
|
: ch>ascii-escape ( ch -- str )
|
||||||
H{
|
H{
|
||||||
{ CHAR: \e "\\e" }
|
{ CHAR: \e CHAR: e }
|
||||||
{ CHAR: \n "\\n" }
|
{ CHAR: \n CHAR: n }
|
||||||
{ CHAR: \r "\\r" }
|
{ CHAR: \r CHAR: r }
|
||||||
{ CHAR: \t "\\t" }
|
{ CHAR: \t CHAR: t }
|
||||||
{ CHAR: \0 "\\0" }
|
{ CHAR: \0 CHAR: 0 }
|
||||||
{ CHAR: \\ "\\\\" }
|
{ CHAR: \\ CHAR: \\ }
|
||||||
{ CHAR: \" "\\\"" }
|
{ CHAR: \" CHAR: \" }
|
||||||
} at ;
|
} at ;
|
||||||
|
|
||||||
: ch>unicode-escape ( ch -- str )
|
|
||||||
>hex 6 CHAR: 0 pad-left "\\u" swap append ;
|
|
||||||
|
|
||||||
: unparse-ch ( ch -- )
|
: unparse-ch ( ch -- )
|
||||||
dup quotable? [
|
dup ch>ascii-escape [ "\\" % ] [ ] ?if , ;
|
||||||
,
|
|
||||||
] [
|
|
||||||
dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?if %
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: do-string-limit ( str -- trimmed )
|
: do-string-limit ( str -- trimmed )
|
||||||
string-limit get [
|
string-limit get [
|
||||||
|
|
|
@ -51,6 +51,9 @@ unit-test
|
||||||
[ "ab" ] [ 2 "abc" resize-string ] unit-test
|
[ "ab" ] [ 2 "abc" resize-string ] unit-test
|
||||||
[ "abc\0\0\0" ] [ 6 "abc" resize-string ] unit-test
|
[ "abc\0\0\0" ] [ 6 "abc" resize-string ] unit-test
|
||||||
|
|
||||||
|
[ "\u001234b" ] [ 2 "\u001234bc" resize-string ] unit-test
|
||||||
|
[ "\u001234bc\0\0\0" ] [ 6 "\u001234bc" resize-string ] unit-test
|
||||||
|
|
||||||
! Random tester found this
|
! Random tester found this
|
||||||
[ { "kernel-error" 3 12 -7 } ]
|
[ { "kernel-error" 3 12 -7 } ]
|
||||||
[ [ 2 -7 resize-string ] catch ] unit-test
|
[ [ 2 -7 resize-string ] catch ] unit-test
|
||||||
|
@ -88,3 +91,5 @@ unit-test
|
||||||
"\udeadbe" clone
|
"\udeadbe" clone
|
||||||
CHAR: \u123456 over clone set-first
|
CHAR: \u123456 over clone set-first
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -38,7 +38,7 @@ M: string set-nth-unsafe
|
||||||
>r >fixnum >r >fixnum r> r> set-string-nth ;
|
>r >fixnum >r >fixnum r> r> set-string-nth ;
|
||||||
|
|
||||||
M: string clone
|
M: string clone
|
||||||
(clone) dup string-aux clone over set-string-aux ;
|
(clone) dup string-aux clone over set-string-aux ;
|
||||||
|
|
||||||
M: string resize resize-string ;
|
M: string resize resize-string ;
|
||||||
|
|
||||||
|
|
|
@ -24,5 +24,3 @@ IN: ascii
|
||||||
|
|
||||||
: alpha? ( ch -- ? )
|
: alpha? ( ch -- ? )
|
||||||
dup Letter? [ drop t ] [ digit? ] if ; inline
|
dup Letter? [ drop t ] [ digit? ] if ; inline
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: kernel io io.files splitting strings
|
USING: kernel io io.files splitting strings
|
||||||
hashtables sequences assocs math namespaces prettyprint
|
hashtables sequences assocs math namespaces prettyprint
|
||||||
math.parser combinators arrays sorting ;
|
math.parser combinators arrays sorting unicode.case ;
|
||||||
|
|
||||||
IN: benchmark.knucleotide
|
IN: benchmark.knucleotide
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: io io.files io.streams.duplex kernel sequences
|
USING: io io.files io.streams.duplex kernel sequences
|
||||||
sequences.private strings vectors words memoize splitting
|
sequences.private strings vectors words memoize splitting
|
||||||
hints ;
|
hints unicode.case ;
|
||||||
IN: benchmark.reverse-complement
|
IN: benchmark.reverse-complement
|
||||||
|
|
||||||
MEMO: trans-map ( -- str )
|
MEMO: trans-map ( -- str )
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
USING: kernel io io.files io.launcher
|
USING: kernel io io.files io.launcher tools.deploy.backend
|
||||||
system namespaces sequences splitting math.parser
|
system namespaces sequences splitting math.parser
|
||||||
unix prettyprint tools.time calendar bake vars ;
|
unix prettyprint tools.time calendar bake vars ;
|
||||||
|
|
||||||
|
@ -31,8 +31,6 @@ SYMBOL: builder-recipients
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: boot-image ( -- filename ) `{ "boot" ,[ cpu ] "image" } "." join ;
|
|
||||||
|
|
||||||
: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
|
: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
@ -61,7 +59,7 @@ if
|
||||||
|
|
||||||
"factor" cd
|
"factor" cd
|
||||||
|
|
||||||
{ "/usr/bin/git" "show" } <process-stream>
|
{ "git" "show" } <process-stream>
|
||||||
[ readln ] with-stream
|
[ readln ] with-stream
|
||||||
" " split second
|
" " split second
|
||||||
"../git-id" <file-writer> [ print ] with-stream
|
"../git-id" <file-writer> [ print ] with-stream
|
||||||
|
@ -76,7 +74,7 @@ if
|
||||||
"builder: vm compile" throw
|
"builder: vm compile" throw
|
||||||
] if
|
] if
|
||||||
|
|
||||||
"wget http://factorcode.org/images/latest/" boot-image append system
|
"wget http://factorcode.org/images/latest/" boot-image-name append system
|
||||||
0 =
|
0 =
|
||||||
[ ]
|
[ ]
|
||||||
[
|
[
|
||||||
|
@ -84,7 +82,11 @@ if
|
||||||
"builder: image download" throw
|
"builder: image download" throw
|
||||||
] if
|
] if
|
||||||
|
|
||||||
[ "./factor -i=" boot-image " -no-user-init > ../boot-log" 3append system ]
|
[
|
||||||
|
"./factor -i=" boot-image-name " -no-user-init > ../boot-log"
|
||||||
|
3append
|
||||||
|
system
|
||||||
|
]
|
||||||
benchmark nip
|
benchmark nip
|
||||||
"../boot-time" <file-writer> [ . ] with-stream
|
"../boot-time" <file-writer> [ . ] with-stream
|
||||||
0 =
|
0 =
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
! Adapted from cryptlib.h
|
! Adapted from cryptlib.h
|
||||||
! Tested with cryptlib 3.3.1.0
|
! Tested with cryptlib 3.3.1.0
|
||||||
USING: cryptlib.libcl kernel hashtables alien math
|
USING: cryptlib.libcl kernel hashtables alien math
|
||||||
namespaces sequences assocs libc alien.c-types continuations ;
|
namespaces sequences assocs libc alien.c-types alien.accessors continuations ;
|
||||||
|
|
||||||
IN: cryptlib
|
IN: cryptlib
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel peg strings promises sequences math math.parser
|
USING: kernel peg strings promises sequences math math.parser
|
||||||
namespaces words quotations arrays hashtables io
|
namespaces words quotations arrays hashtables io
|
||||||
io.streams.string assocs memoize ;
|
io.streams.string assocs memoize ascii ;
|
||||||
IN: fjsc
|
IN: fjsc
|
||||||
|
|
||||||
TUPLE: ast-number value ;
|
TUPLE: ast-number value ;
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2007 Slava Pestov.
|
! Copyright (C) 2007 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: parser-combinators regexp lazy-lists sequences kernel
|
USING: parser-combinators regexp lazy-lists sequences kernel
|
||||||
promises strings ;
|
promises strings unicode.case ;
|
||||||
IN: globs
|
IN: globs
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: arrays combinators.lib io io.streams.string
|
USING: arrays combinators.lib io io.streams.string
|
||||||
kernel math math.parser namespaces prettyprint
|
kernel math math.parser namespaces prettyprint
|
||||||
sequences splitting strings ;
|
sequences splitting strings ascii ;
|
||||||
IN: hexdump
|
IN: hexdump
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -25,7 +25,7 @@ M: template-lexer skip-word
|
||||||
{
|
{
|
||||||
{ [ 2dup nth CHAR: " = ] [ drop 1+ ] }
|
{ [ 2dup nth CHAR: " = ] [ drop 1+ ] }
|
||||||
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
|
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
|
||||||
{ [ t ] [ [ blank? ] skip ] }
|
{ [ t ] [ f skip ] }
|
||||||
} cond
|
} cond
|
||||||
] change-column ;
|
] change-column ;
|
||||||
|
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
USING: arrays combinators io io.binary io.files io.paths
|
USING: arrays combinators io io.binary io.files io.paths
|
||||||
io.utf16 kernel math math.parser namespaces sequences
|
io.utf16 kernel math math.parser namespaces sequences
|
||||||
splitting strings assocs ;
|
splitting strings assocs unicode.categories ;
|
||||||
|
|
||||||
IN: id3
|
IN: id3
|
||||||
|
|
||||||
|
|
|
@ -8,35 +8,32 @@ $nl
|
||||||
"Not all operating systems support recursive monitors; if recursive monitoring is not available, an error is thrown and the caller must implement alternative logic for monitoring subdirectories." } ;
|
"Not all operating systems support recursive monitors; if recursive monitoring is not available, an error is thrown and the caller must implement alternative logic for monitoring subdirectories." } ;
|
||||||
|
|
||||||
HELP: next-change
|
HELP: next-change
|
||||||
{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a sequence of change descriptors" } }
|
{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a change descriptor" } }
|
||||||
{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is a sequence containing at least one change descriptor; see " { $link "io.monitor.descriptors" } "." } ;
|
{ $description "Waits for file system changes and outputs the pathname of the first changed file. The change descriptor is aq sequence of symbols documented in " { $link "io.monitor.descriptors" } "." } ;
|
||||||
|
|
||||||
HELP: with-monitor
|
HELP: with-monitor
|
||||||
{ $values { "path" "a pathname string" } { "recursive?" "a boolean" } { "quot" "a quotation with stack effect " { $snippet "( monitor -- )" } } }
|
{ $values { "path" "a pathname string" } { "recursive?" "a boolean" } { "quot" "a quotation with stack effect " { $snippet "( monitor -- )" } } }
|
||||||
{ $description "Opens a file system change monitor and passes it to the quotation. Closes the monitor after the quotation returns or throws an error." } ;
|
{ $description "Opens a file system change monitor and passes it to the quotation. Closes the monitor after the quotation returns or throws an error." } ;
|
||||||
|
|
||||||
HELP: +change-file+
|
HELP: +add-file+
|
||||||
{ $description "Indicates that the contents of the file have changed." } ;
|
{ $description "Indicates that the file has been added to the directory." } ;
|
||||||
|
|
||||||
HELP: +change-name+
|
HELP: +remove-file+
|
||||||
{ $description "Indicates that the file name has changed." } ;
|
{ $description "Indicates that the file has been removed from the directory." } ;
|
||||||
|
|
||||||
HELP: +change-size+
|
HELP: +modify-file+
|
||||||
{ $description "Indicates that the file size has changed." } ;
|
{ $description "Indicates that the file contents have changed." } ;
|
||||||
|
|
||||||
HELP: +change-attributes+
|
HELP: +rename-file+
|
||||||
{ $description "Indicates that file attributes has changed. Attributes are operating system-specific but may include the creation time and permissions." } ;
|
{ $description "Indicates that file has been renamed." } ;
|
||||||
|
|
||||||
HELP: +change-modified+
|
|
||||||
{ $description "Indicates that the last modification time of the file has changed." } ;
|
|
||||||
|
|
||||||
ARTICLE: "io.monitor.descriptors" "File system change descriptors"
|
ARTICLE: "io.monitor.descriptors" "File system change descriptors"
|
||||||
"Change descriptors output by " { $link next-change } ":"
|
"Change descriptors output by " { $link next-change } ":"
|
||||||
{ $subsection +change-file+ }
|
{ $subsection +add-file+ }
|
||||||
{ $subsection +change-name+ }
|
{ $subsection +remove-file+ }
|
||||||
{ $subsection +change-size+ }
|
{ $subsection +modify-file+ }
|
||||||
{ $subsection +change-attributes+ }
|
{ $subsection +rename-file+ }
|
||||||
{ $subsection +change-modified+ } ;
|
{ $subsection +add-file+ } ;
|
||||||
|
|
||||||
ARTICLE: "io.monitor" "File system change monitors"
|
ARTICLE: "io.monitor" "File system change monitors"
|
||||||
"File system change monitors listen for changes to file names, attributes and contents under a specified directory. They can optionally be recursive, in which case subdirectories are also monitored."
|
"File system change monitors listen for changes to file names, attributes and contents under a specified directory. They can optionally be recursive, in which case subdirectories are also monitored."
|
||||||
|
|
|
@ -7,11 +7,10 @@ HOOK: <monitor> io-backend ( path recursive? -- monitor )
|
||||||
|
|
||||||
HOOK: next-change io-backend ( monitor -- path changes )
|
HOOK: next-change io-backend ( monitor -- path changes )
|
||||||
|
|
||||||
SYMBOL: +change-file+
|
SYMBOL: +add-file+
|
||||||
SYMBOL: +change-name+
|
SYMBOL: +remove-file+
|
||||||
SYMBOL: +change-size+
|
SYMBOL: +modify-file+
|
||||||
SYMBOL: +change-attributes+
|
SYMBOL: +rename-file+
|
||||||
SYMBOL: +change-modified+
|
|
||||||
|
|
||||||
: with-monitor ( path recursive? quot -- )
|
: with-monitor ( path recursive? quot -- )
|
||||||
>r <monitor> r> with-disposal ; inline
|
>r <monitor> r> with-disposal ; inline
|
||||||
|
|
|
@ -29,7 +29,7 @@ SYMBOL: log-stream
|
||||||
|
|
||||||
: with-log-file ( file quot -- )
|
: with-log-file ( file quot -- )
|
||||||
>r <file-appender> r>
|
>r <file-appender> r>
|
||||||
[ with-log-stream ] with-disposal ; inline
|
[ with-log-stream ] curry with-disposal ; inline
|
||||||
|
|
||||||
: with-log-stdio ( quot -- )
|
: with-log-stdio ( quot -- )
|
||||||
stdio get swap with-log-stream ;
|
stdio get swap with-log-stream ;
|
||||||
|
@ -47,11 +47,11 @@ SYMBOL: log-stream
|
||||||
dup log-client
|
dup log-client
|
||||||
[ swap with-stream ] 2curry concurrency:spawn drop ; inline
|
[ swap with-stream ] 2curry concurrency:spawn drop ; inline
|
||||||
|
|
||||||
: accept-loop ( server quot -- server quot )
|
: accept-loop ( server quot -- )
|
||||||
[ swap accept with-client ] 2keep accept-loop ; inline
|
[ swap accept with-client ] 2keep accept-loop ; inline
|
||||||
|
|
||||||
: server-loop ( server quot -- )
|
: server-loop ( server quot -- )
|
||||||
[ accept-loop ] compose with-disposal ; inline
|
[ accept-loop ] curry with-disposal ; inline
|
||||||
|
|
||||||
: spawn-server ( addrspec quot -- )
|
: spawn-server ( addrspec quot -- )
|
||||||
"Waiting for connections on " pick unparse append
|
"Waiting for connections on " pick unparse append
|
||||||
|
|
|
@ -119,8 +119,15 @@ TUPLE: CreateProcess-args
|
||||||
drop STD_ERROR_HANDLE GetStdHandle ;
|
drop STD_ERROR_HANDLE GetStdHandle ;
|
||||||
|
|
||||||
: redirect-stderr ( args -- handle )
|
: redirect-stderr ( args -- handle )
|
||||||
+stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
|
+stderr+ get
|
||||||
swap inherited-stderr ?closed ;
|
dup +stdout+ eq? [
|
||||||
|
drop
|
||||||
|
CreateProcess-args-lpStartupInfo
|
||||||
|
STARTUPINFO-hStdOutput
|
||||||
|
] [
|
||||||
|
GENERIC_WRITE CREATE_ALWAYS redirect
|
||||||
|
swap inherited-stderr ?closed
|
||||||
|
] if ;
|
||||||
|
|
||||||
: inherited-stdin ( args -- handle )
|
: inherited-stdin ( args -- handle )
|
||||||
CreateProcess-args-stdin-pipe
|
CreateProcess-args-stdin-pipe
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: alien.c-types destructors io.windows
|
||||||
io.windows.nt.backend kernel math windows windows.kernel32
|
io.windows.nt.backend kernel math windows windows.kernel32
|
||||||
windows.types libc assocs alien namespaces continuations
|
windows.types libc assocs alien namespaces continuations
|
||||||
io.monitor io.nonblocking io.buffers io.files io sequences
|
io.monitor io.nonblocking io.buffers io.files io sequences
|
||||||
hashtables sorting arrays ;
|
hashtables sorting arrays combinators ;
|
||||||
IN: io.windows.nt.monitor
|
IN: io.windows.nt.monitor
|
||||||
|
|
||||||
TUPLE: monitor path recursive? queue closed? ;
|
TUPLE: monitor path recursive? queue closed? ;
|
||||||
|
@ -53,25 +53,17 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
||||||
] with-port-timeout
|
] with-port-timeout
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
||||||
: parse-action-flag ( action mask symbol -- action )
|
: parse-action ( action -- changed )
|
||||||
>r over bitand 0 > [ r> , ] [ r> drop ] if ;
|
{
|
||||||
|
{ [ dup FILE_ACTION_ADDED = ] [ +add-file+ ] }
|
||||||
|
{ [ dup FILE_ACTION_REMOVED = ] [ +remove-file+ ] }
|
||||||
|
{ [ dup FILE_ACTION_MODIFIED = ] [ +modify-file+ ] }
|
||||||
|
{ [ dup FILE_ACTION_RENAMED_OLD_NAME = ] [ +rename-file+ ] }
|
||||||
|
{ [ dup FILE_ACTION_RENAMED_NEW_NAME = ] [ +rename-file+ ] }
|
||||||
|
{ [ t ] [ +modify-file+ ] }
|
||||||
|
} cond nip ;
|
||||||
|
|
||||||
: parse-action ( action -- changes )
|
: changed-file ( directory buffer -- changed path )
|
||||||
[
|
|
||||||
FILE_NOTIFY_CHANGE_FILE +change-file+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_DIR_NAME +change-name+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_ATTRIBUTES +change-attributes+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_SIZE +change-size+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_LAST_WRITE +change-modified+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_LAST_ACCESS +change-attributes+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_EA +change-attributes+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_CREATION +change-attributes+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_SECURITY +change-attributes+ parse-action-flag
|
|
||||||
FILE_NOTIFY_CHANGE_FILE_NAME +change-name+ parse-action-flag
|
|
||||||
drop
|
|
||||||
] { } make ;
|
|
||||||
|
|
||||||
: changed-file ( directory buffer -- changes path )
|
|
||||||
{
|
{
|
||||||
FILE_NOTIFY_INFORMATION-FileName
|
FILE_NOTIFY_INFORMATION-FileName
|
||||||
FILE_NOTIFY_INFORMATION-FileNameLength
|
FILE_NOTIFY_INFORMATION-FileNameLength
|
||||||
|
@ -79,7 +71,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
||||||
} get-slots >r memory>u16-string path+ r> parse-action swap ;
|
} get-slots >r memory>u16-string path+ r> parse-action swap ;
|
||||||
|
|
||||||
: (changed-files) ( directory buffer -- )
|
: (changed-files) ( directory buffer -- )
|
||||||
2dup changed-file namespace [ append ] change-at
|
2dup changed-file namespace [ swap add ] change-at
|
||||||
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
|
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
|
||||||
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
|
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays calendar io io.sockets kernel match namespaces
|
USING: arrays calendar io io.sockets kernel match namespaces
|
||||||
sequences splitting strings continuations threads ;
|
sequences splitting strings continuations threads ascii ;
|
||||||
IN: irc
|
IN: irc
|
||||||
|
|
||||||
! "setup" objects
|
! "setup" objects
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel parser-combinators namespaces sequences promises strings
|
USING: kernel parser-combinators namespaces sequences promises strings
|
||||||
assocs math math.parser math.vectors math.functions
|
assocs math math.parser math.vectors math.functions
|
||||||
lazy-lists hashtables ;
|
lazy-lists hashtables ascii ;
|
||||||
IN: json.reader
|
IN: json.reader
|
||||||
|
|
||||||
! Grammar for JSON from RFC 4627
|
! Grammar for JSON from RFC 4627
|
||||||
|
|
|
@ -1,9 +1,8 @@
|
||||||
! Copyright (C) 2007 Doug Coleman.
|
! Copyright (C) 2007 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien arrays assocs combinators.lib io kernel
|
USING: alien alien.accessors arrays assocs combinators.lib io kernel
|
||||||
macros math namespaces prettyprint quotations sequences
|
macros math namespaces prettyprint quotations sequences
|
||||||
vectors vocabs words ;
|
vectors vocabs words html.elements slots.private tar ;
|
||||||
USING: html.elements slots.private tar ;
|
|
||||||
IN: lint
|
IN: lint
|
||||||
|
|
||||||
SYMBOL: def-hash
|
SYMBOL: def-hash
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2006 Chris Double.
|
! Copyright (C) 2006 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel strings math sequences lazy-lists words
|
USING: kernel strings math sequences lazy-lists words
|
||||||
math.parser promises parser-combinators ;
|
math.parser promises parser-combinators unicode.categories ;
|
||||||
IN: parser-combinators.simple
|
IN: parser-combinators.simple
|
||||||
|
|
||||||
: 'digit' ( -- parser )
|
: 'digit' ( -- parser )
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2007 Chris Double.
|
! Copyright (C) 2007 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel parser words arrays strings math.parser sequences
|
USING: kernel parser words arrays strings math.parser sequences
|
||||||
quotations vectors namespaces math assocs continuations peg ;
|
quotations vectors namespaces math assocs continuations peg
|
||||||
|
unicode.categories ;
|
||||||
IN: peg.ebnf
|
IN: peg.ebnf
|
||||||
|
|
||||||
TUPLE: ebnf-non-terminal symbol ;
|
TUPLE: ebnf-non-terminal symbol ;
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2007 Chris Double.
|
! Copyright (C) 2007 Chris Double.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel sequences strings namespaces math assocs shuffle
|
USING: kernel sequences strings namespaces math assocs shuffle
|
||||||
vectors arrays combinators.lib memoize math.parser match ;
|
vectors arrays combinators.lib memoize math.parser match
|
||||||
|
unicode.categories ;
|
||||||
IN: peg
|
IN: peg
|
||||||
|
|
||||||
TUPLE: parse-result remaining ast ;
|
TUPLE: parse-result remaining ast ;
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
! Copyright (c) 2007 Aaron Schaefer.
|
! Copyright (c) 2007 Aaron Schaefer.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: combinators.lib kernel math.ranges math.text.english sequences strings ;
|
USING: combinators.lib kernel math.ranges math.text.english sequences strings
|
||||||
|
ascii ;
|
||||||
IN: project-euler.017
|
IN: project-euler.017
|
||||||
|
|
||||||
! http://projecteuler.net/index.php?section=problems&id=17
|
! http://projecteuler.net/index.php?section=problems&id=17
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (c) 2007 Aaron Schaefer.
|
! Copyright (c) 2007 Aaron Schaefer.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io.files kernel math math.parser namespaces sequences sorting splitting
|
USING: io.files kernel math math.parser namespaces sequences sorting splitting
|
||||||
strings system vocabs ;
|
strings system vocabs ascii ;
|
||||||
IN: project-euler.022
|
IN: project-euler.022
|
||||||
|
|
||||||
! http://projecteuler.net/index.php?section=problems&id=22
|
! http://projecteuler.net/index.php?section=problems&id=22
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
USING: kernel sequences arrays vectors namespaces math strings
|
USING: kernel sequences arrays vectors namespaces math strings
|
||||||
combinators continuations quotations io assocs ;
|
combinators continuations quotations io assocs ascii ;
|
||||||
|
|
||||||
IN: prolog
|
IN: prolog
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: arrays combinators kernel lazy-lists math math.parser
|
USING: arrays combinators kernel lazy-lists math math.parser
|
||||||
namespaces parser parser-combinators parser-combinators.simple
|
namespaces parser parser-combinators parser-combinators.simple
|
||||||
promises quotations sequences combinators.lib strings
|
promises quotations sequences combinators.lib strings
|
||||||
assocs prettyprint.backend memoize ;
|
assocs prettyprint.backend memoize unicode.case unicode.categories ;
|
||||||
USE: io
|
USE: io
|
||||||
IN: regexp
|
IN: regexp
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
|
||||||
USING: arrays assocs kernel math math.vectors namespaces
|
USING: arrays assocs kernel math math.vectors namespaces
|
||||||
quotations sequences sequences.lib sequences.private strings ;
|
quotations sequences sequences.lib sequences.private strings unicode.case ;
|
||||||
IN: roman
|
IN: roman
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2006 Daniel Ehrenberg
|
! Copyright (C) 2006 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel math sequences strings io combinators ;
|
USING: kernel math sequences strings io combinators ascii ;
|
||||||
IN: rot13
|
IN: rot13
|
||||||
|
|
||||||
: rotate ( ch base -- ch ) tuck - 13 + 26 mod + ;
|
: rotate ( ch base -- ch ) tuck - 13 + 26 mod + ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: combinators.lib kernel sequences math namespaces assocs
|
USING: combinators.lib kernel sequences math namespaces assocs
|
||||||
random sequences.private shuffle math.functions mirrors ;
|
random sequences.private shuffle math.functions mirrors
|
||||||
USING: arrays math.parser sorting strings ;
|
arrays math.parser sorting strings ascii ;
|
||||||
IN: sequences.lib
|
IN: sequences.lib
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: io io.streams.string kernel math namespaces sequences
|
USING: io io.streams.string kernel math namespaces sequences
|
||||||
strings circular prettyprint debugger ;
|
strings circular prettyprint debugger unicode.categories ;
|
||||||
IN: state-parser
|
IN: state-parser
|
||||||
|
|
||||||
! * Basic underlying words
|
! * Basic underlying words
|
||||||
|
|
|
@ -1,14 +1,14 @@
|
||||||
USING: math arrays sequences kernel splitting strings ;
|
USING: math arrays sequences kernel splitting strings ;
|
||||||
IN: strings.lib
|
IN: strings.lib
|
||||||
|
|
||||||
: char>digit ( c -- i ) 48 - ;
|
! : char>digit ( c -- i ) 48 - ;
|
||||||
|
|
||||||
: string>digits ( s -- seq ) [ char>digit ] { } map-as ;
|
! : string>digits ( s -- seq ) [ char>digit ] { } map-as ;
|
||||||
|
|
||||||
: >Upper ( str -- str )
|
! : >Upper ( str -- str )
|
||||||
dup empty? [
|
! dup empty? [
|
||||||
unclip ch>upper 1string swap append
|
! unclip ch>upper 1string swap append
|
||||||
] unless ;
|
! ] unless ;
|
||||||
|
|
||||||
: >Upper-dashes ( str -- str )
|
! : >Upper-dashes ( str -- str )
|
||||||
"-" split [ >Upper ] map "-" join ;
|
! "-" split [ >Upper ] map "-" join ;
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
USING: kernel unicode.data sequences sequences.next namespaces assocs.lib
|
USING: kernel unicode.data sequences sequences.next namespaces
|
||||||
unicode.normalize math unicode.categories combinators assocs ;
|
assocs.lib unicode.normalize math unicode.categories combinators
|
||||||
|
assocs ;
|
||||||
IN: unicode.case
|
IN: unicode.case
|
||||||
|
|
||||||
: ch>lower ( ch -- lower ) simple-lower at-default ;
|
: ch>lower ( ch -- lower ) simple-lower at-default ;
|
||||||
|
@ -20,7 +21,7 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
[ swap dot-over = over "ij" member? and swap , ] if ;
|
[ swap dot-over = over "ij" member? and swap , ] if ;
|
||||||
|
|
||||||
: lithuanian>upper ( string -- lower )
|
: lithuanian>upper ( string -- lower )
|
||||||
[ f swap [ lithuanian-ch>upper ] each-next drop ] "" make* ;
|
[ f swap [ lithuanian-ch>upper ] each-next drop ] "" make ;
|
||||||
|
|
||||||
: mark-above? ( ch -- ? )
|
: mark-above? ( ch -- ? )
|
||||||
combining-class 230 = ;
|
combining-class 230 = ;
|
||||||
|
@ -32,14 +33,14 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
dup , "IJ" member? swap mark-above? and [ dot-over , ] when ;
|
dup , "IJ" member? swap mark-above? and [ dot-over , ] when ;
|
||||||
|
|
||||||
: lithuanian>lower ( string -- lower )
|
: lithuanian>lower ( string -- lower )
|
||||||
[ [ lithuanian-ch>lower ] each-next ] "" make* ;
|
[ [ lithuanian-ch>lower ] each-next ] "" make ;
|
||||||
|
|
||||||
: turk-ch>upper ( ch -- )
|
: turk-ch>upper ( ch -- )
|
||||||
dup CHAR: i =
|
dup CHAR: i =
|
||||||
[ drop CHAR: I , dot-over , ] [ , ] if ;
|
[ drop CHAR: I , dot-over , ] [ , ] if ;
|
||||||
|
|
||||||
: turk>upper ( string -- upper-i )
|
: turk>upper ( string -- upper-i )
|
||||||
[ [ turk-ch>upper ] each ] "" make* ;
|
[ [ turk-ch>upper ] each ] "" make ;
|
||||||
|
|
||||||
: turk-ch>lower ( ? next ch -- ? )
|
: turk-ch>lower ( ? next ch -- ? )
|
||||||
{
|
{
|
||||||
|
@ -52,7 +53,7 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
: turk>lower ( string -- lower-i )
|
: turk>lower ( string -- lower-i )
|
||||||
[ f swap [ turk-ch>lower ] each-next drop ] "" make* ;
|
[ f swap [ turk-ch>lower ] each-next drop ] "" make ;
|
||||||
|
|
||||||
: word-boundary ( prev char -- new ? )
|
: word-boundary ( prev char -- new ? )
|
||||||
dup non-starter? [ drop dup ] when
|
dup non-starter? [ drop dup ] when
|
||||||
|
@ -76,7 +77,7 @@ SYMBOL: locale ! Just casing locale, or overall?
|
||||||
[ -rot nip call , ] ?if
|
[ -rot nip call , ] ?if
|
||||||
] 2keep
|
] 2keep
|
||||||
] each 2drop
|
] each 2drop
|
||||||
] "" make* ; inline
|
] "" make ; inline
|
||||||
|
|
||||||
: >lower ( string -- lower )
|
: >lower ( string -- lower )
|
||||||
i-dot? [ turk>lower ] when
|
i-dot? [ turk>lower ] when
|
||||||
|
|
|
@ -2,17 +2,6 @@ USING: sequences namespaces unicode.data kernel combinators.lib
|
||||||
math arrays ;
|
math arrays ;
|
||||||
IN: unicode.normalize
|
IN: unicode.normalize
|
||||||
|
|
||||||
! Utility word--probably unnecessary
|
|
||||||
: make* ( seq quot exemplar -- newseq )
|
|
||||||
! quot has access to original seq on stack
|
|
||||||
! this just makes the new-resizable the same length as seq
|
|
||||||
[
|
|
||||||
[
|
|
||||||
pick length swap new-resizable
|
|
||||||
[ building set call ] keep
|
|
||||||
] keep like
|
|
||||||
] with-scope ; inline
|
|
||||||
|
|
||||||
! Conjoining Jamo behavior
|
! Conjoining Jamo behavior
|
||||||
|
|
||||||
: hangul-base HEX: ac00 ; inline
|
: hangul-base HEX: ac00 ; inline
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
! Copyright (C) 2007 Slava Pestov.
|
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: namespaces kernel assocs io.files combinators
|
USING: namespaces kernel assocs io.files combinators
|
||||||
arrays io.launcher io http.server.responders webapps.file
|
arrays io.launcher io http.server.responders webapps.file
|
||||||
sequences strings math.parser ;
|
sequences strings math.parser unicode.case ;
|
||||||
IN: webapps.cgi
|
IN: webapps.cgi
|
||||||
|
|
||||||
SYMBOL: cgi-root
|
SYMBOL: cgi-root
|
||||||
|
@ -31,7 +31,7 @@ SYMBOL: cgi-root
|
||||||
|
|
||||||
"method" get >upper "REQUEST_METHOD" set
|
"method" get >upper "REQUEST_METHOD" set
|
||||||
"raw-query" get "QUERY_STRING" set
|
"raw-query" get "QUERY_STRING" set
|
||||||
"Cookie" header-param "HTTP_COOKIE" set
|
"Cookie" header-param "HTTP_COOKIE" set
|
||||||
|
|
||||||
"User-Agent" header-param "HTTP_USER_AGENT" set
|
"User-Agent" header-param "HTTP_USER_AGENT" set
|
||||||
"Accept" header-param "HTTP_ACCEPT" set
|
"Accept" header-param "HTTP_ACCEPT" set
|
||||||
|
|
|
@ -83,6 +83,12 @@ IN: windows.kernel32
|
||||||
: FILE_NOTIFY_CHANGE_FILE_NAME HEX: 200 ; inline
|
: FILE_NOTIFY_CHANGE_FILE_NAME HEX: 200 ; inline
|
||||||
: FILE_NOTIFY_CHANGE_ALL HEX: 3ff ; inline
|
: FILE_NOTIFY_CHANGE_ALL HEX: 3ff ; inline
|
||||||
|
|
||||||
|
: FILE_ACTION_ADDED 1 ; inline
|
||||||
|
: FILE_ACTION_REMOVED 2 ; inline
|
||||||
|
: FILE_ACTION_MODIFIED 3 ; inline
|
||||||
|
: FILE_ACTION_RENAMED_OLD_NAME 4 ; inline
|
||||||
|
: FILE_ACTION_RENAMED_NEW_NAME 5 ; inline
|
||||||
|
|
||||||
C-STRUCT: FILE_NOTIFY_INFORMATION
|
C-STRUCT: FILE_NOTIFY_INFORMATION
|
||||||
{ "DWORD" "NextEntryOffset" }
|
{ "DWORD" "NextEntryOffset" }
|
||||||
{ "DWORD" "Action" }
|
{ "DWORD" "Action" }
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: xml.errors xml.data xml.utilities xml.char-classes
|
USING: xml.errors xml.data xml.utilities xml.char-classes
|
||||||
xml.entities kernel state-parser kernel namespaces strings math
|
xml.entities kernel state-parser kernel namespaces strings math
|
||||||
math.parser sequences assocs arrays splitting combinators ;
|
math.parser sequences assocs arrays splitting combinators unicode.case ;
|
||||||
IN: xml.tokenize
|
IN: xml.tokenize
|
||||||
|
|
||||||
! XML namespace processing: ns = namespace
|
! XML namespace processing: ns = namespace
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: io io.streams.string io.files kernel math namespaces
|
USING: io io.streams.string io.files kernel math namespaces
|
||||||
prettyprint sequences arrays generic strings vectors
|
prettyprint sequences arrays generic strings vectors
|
||||||
xml.char-classes xml.data xml.errors xml.tokenize xml.writer
|
xml.char-classes xml.data xml.errors xml.tokenize xml.writer
|
||||||
xml.utilities state-parser assocs ;
|
xml.utilities state-parser assocs unicode.categories ;
|
||||||
IN: xml
|
IN: xml
|
||||||
|
|
||||||
! -- Overall parser with data tree
|
! -- Overall parser with data tree
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
USING: kernel strings assocs sequences hashtables sorting ;
|
USING: kernel strings assocs sequences hashtables sorting
|
||||||
|
unicode.case unicode.categories ;
|
||||||
IN: xmode.keyword-map
|
IN: xmode.keyword-map
|
||||||
|
|
||||||
! Based on org.gjt.sp.jedit.syntax.KeywordMap
|
! Based on org.gjt.sp.jedit.syntax.KeywordMap
|
||||||
|
|
|
@ -2,7 +2,7 @@ IN: xmode.marker
|
||||||
USING: kernel namespaces xmode.rules xmode.tokens
|
USING: kernel namespaces xmode.rules xmode.tokens
|
||||||
xmode.marker.state xmode.marker.context xmode.utilities
|
xmode.marker.state xmode.marker.context xmode.utilities
|
||||||
xmode.catalog sequences math assocs combinators combinators.lib
|
xmode.catalog sequences math assocs combinators combinators.lib
|
||||||
strings regexp splitting parser-combinators ;
|
strings regexp splitting parser-combinators ascii unicode.case ;
|
||||||
|
|
||||||
! Based on org.gjt.sp.jedit.syntax.TokenMarker
|
! Based on org.gjt.sp.jedit.syntax.TokenMarker
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: xmode.tokens xmode.keyword-map kernel
|
USING: xmode.tokens xmode.keyword-map kernel
|
||||||
sequences vectors assocs strings memoize regexp ;
|
sequences vectors assocs strings memoize regexp unicode.case ;
|
||||||
IN: xmode.rules
|
IN: xmode.rules
|
||||||
|
|
||||||
TUPLE: string-matcher string ignore-case? ;
|
TUPLE: string-matcher string ignore-case? ;
|
||||||
|
|
|
@ -505,7 +505,6 @@ CELL binary_payload_start(CELL pointer)
|
||||||
switch(untag_header(get(pointer)))
|
switch(untag_header(get(pointer)))
|
||||||
{
|
{
|
||||||
/* these objects do not refer to other objects at all */
|
/* these objects do not refer to other objects at all */
|
||||||
case STRING_TYPE:
|
|
||||||
case FLOAT_TYPE:
|
case FLOAT_TYPE:
|
||||||
case BYTE_ARRAY_TYPE:
|
case BYTE_ARRAY_TYPE:
|
||||||
case BIT_ARRAY_TYPE:
|
case BIT_ARRAY_TYPE:
|
||||||
|
@ -522,6 +521,8 @@ CELL binary_payload_start(CELL pointer)
|
||||||
return CELLS * 2;
|
return CELLS * 2;
|
||||||
case QUOTATION_TYPE:
|
case QUOTATION_TYPE:
|
||||||
return sizeof(F_QUOTATION) - CELLS * 2;
|
return sizeof(F_QUOTATION) - CELLS * 2;
|
||||||
|
case STRING_TYPE:
|
||||||
|
return sizeof(F_STRING);
|
||||||
/* everything else consists entirely of pointers */
|
/* everything else consists entirely of pointers */
|
||||||
default:
|
default:
|
||||||
return unaligned_object_size(pointer);
|
return unaligned_object_size(pointer);
|
||||||
|
|
|
@ -1,6 +1,11 @@
|
||||||
#include "master.h"
|
#include "master.h"
|
||||||
|
|
||||||
|
extern int main();
|
||||||
|
|
||||||
const char *vm_executable_path(void)
|
const char *vm_executable_path(void)
|
||||||
{
|
{
|
||||||
return NULL;
|
static Dl_info info = {0};
|
||||||
|
if (!info.dli_fname)
|
||||||
|
dladdr(main, &info);
|
||||||
|
return info.dli_fname;
|
||||||
}
|
}
|
||||||
|
|
52
vm/types.c
52
vm/types.c
|
@ -431,23 +431,30 @@ CELL string_nth(F_STRING* string, CELL index)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* allocates memory */
|
||||||
void set_string_nth(F_STRING* string, CELL index, CELL value)
|
void set_string_nth(F_STRING* string, CELL index, CELL value)
|
||||||
{
|
{
|
||||||
bput(SREF(string,index),value & 0xff);
|
bput(SREF(string,index),value & 0xff);
|
||||||
|
|
||||||
|
F_BYTE_ARRAY *aux;
|
||||||
|
|
||||||
if(string->aux == F)
|
if(string->aux == F)
|
||||||
{
|
{
|
||||||
if(value <= 0xff)
|
if(value <= 0xff)
|
||||||
return;
|
return;
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
string->aux = tag_object(allot_byte_array(
|
REGISTER_UNTAGGED(string);
|
||||||
|
aux = allot_byte_array(
|
||||||
untag_fixnum_fast(string->length)
|
untag_fixnum_fast(string->length)
|
||||||
* sizeof(u16)));
|
* sizeof(u16));
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
string->aux = tag_object(aux);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
else
|
||||||
|
aux = untag_object(string->aux);
|
||||||
|
|
||||||
F_BYTE_ARRAY *aux = untag_object(string->aux);
|
|
||||||
cput(BREF(aux,index * sizeof(u16)),value >> 8);
|
cput(BREF(aux,index * sizeof(u16)),value >> 8);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -463,20 +470,36 @@ F_STRING* allot_string_internal(CELL capacity)
|
||||||
string->length = tag_fixnum(capacity);
|
string->length = tag_fixnum(capacity);
|
||||||
string->hashcode = F;
|
string->hashcode = F;
|
||||||
string->aux = F;
|
string->aux = F;
|
||||||
|
|
||||||
set_string_nth(string,capacity,0);
|
set_string_nth(string,capacity,0);
|
||||||
|
|
||||||
return string;
|
return string;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* allocates memory */
|
||||||
void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
|
void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
|
||||||
{
|
{
|
||||||
if(fill == 0)
|
if(fill == 0)
|
||||||
memset((void*)SREF(string,start),'\0',capacity - start);
|
{
|
||||||
|
memset((void *)SREF(string,start),'\0',capacity - start);
|
||||||
|
|
||||||
|
if(string->aux != F)
|
||||||
|
{
|
||||||
|
F_BYTE_ARRAY *aux = untag_object(string->aux);
|
||||||
|
memset((void *)BREF(aux,start * sizeof(u16)),'\0',
|
||||||
|
(capacity - start) * sizeof(u16));
|
||||||
|
}
|
||||||
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
CELL i;
|
CELL i;
|
||||||
|
|
||||||
for(i = start; i < capacity; i++)
|
for(i = start; i < capacity; i++)
|
||||||
|
{
|
||||||
|
REGISTER_UNTAGGED(string);
|
||||||
set_string_nth(string,i,fill);
|
set_string_nth(string,i,fill);
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -484,7 +507,9 @@ void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
|
||||||
F_STRING *allot_string(CELL capacity, CELL fill)
|
F_STRING *allot_string(CELL capacity, CELL fill)
|
||||||
{
|
{
|
||||||
F_STRING* string = allot_string_internal(capacity);
|
F_STRING* string = allot_string_internal(capacity);
|
||||||
|
REGISTER_UNTAGGED(string);
|
||||||
fill_string(string,0,capacity,fill);
|
fill_string(string,0,capacity,fill);
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
return string;
|
return string;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -506,7 +531,23 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
|
||||||
UNREGISTER_UNTAGGED(string);
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
|
||||||
memcpy(new_string + 1,string + 1,to_copy);
|
memcpy(new_string + 1,string + 1,to_copy);
|
||||||
|
|
||||||
|
if(string->aux != F)
|
||||||
|
{
|
||||||
|
REGISTER_UNTAGGED(string);
|
||||||
|
REGISTER_UNTAGGED(new_string);
|
||||||
|
F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16));
|
||||||
|
new_string->aux = tag_object(new_aux);
|
||||||
|
UNREGISTER_UNTAGGED(new_string);
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
|
||||||
|
F_BYTE_ARRAY *aux = untag_object(string->aux);
|
||||||
|
memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16));
|
||||||
|
}
|
||||||
|
|
||||||
|
REGISTER_UNTAGGED(string);
|
||||||
fill_string(new_string,to_copy,capacity,fill);
|
fill_string(new_string,to_copy,capacity,fill);
|
||||||
|
UNREGISTER_UNTAGGED(string);
|
||||||
|
|
||||||
return new_string;
|
return new_string;
|
||||||
}
|
}
|
||||||
|
@ -529,7 +570,9 @@ DEFINE_PRIMITIVE(resize_string)
|
||||||
CELL i; \
|
CELL i; \
|
||||||
for(i = 0; i < length; i++) \
|
for(i = 0; i < length; i++) \
|
||||||
{ \
|
{ \
|
||||||
|
REGISTER_UNTAGGED(s); \
|
||||||
set_string_nth(s,i,(utype)*string); \
|
set_string_nth(s,i,(utype)*string); \
|
||||||
|
UNREGISTER_UNTAGGED(s); \
|
||||||
string++; \
|
string++; \
|
||||||
} \
|
} \
|
||||||
return s; \
|
return s; \
|
||||||
|
@ -552,6 +595,7 @@ DEFINE_PRIMITIVE(resize_string)
|
||||||
|
|
||||||
MEMORY_TO_STRING(char,u8)
|
MEMORY_TO_STRING(char,u8)
|
||||||
MEMORY_TO_STRING(u16,u16)
|
MEMORY_TO_STRING(u16,u16)
|
||||||
|
MEMORY_TO_STRING(u32,u32)
|
||||||
|
|
||||||
bool check_string(F_STRING *s, CELL max)
|
bool check_string(F_STRING *s, CELL max)
|
||||||
{
|
{
|
||||||
|
|
|
@ -83,8 +83,8 @@ INLINE CELL array_capacity(F_ARRAY* array)
|
||||||
return array->capacity >> TAG_BITS;
|
return array->capacity >> TAG_BITS;
|
||||||
}
|
}
|
||||||
|
|
||||||
#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + index)
|
#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index))
|
||||||
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index)
|
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index))
|
||||||
|
|
||||||
INLINE F_STRING* untag_string(CELL tagged)
|
INLINE F_STRING* untag_string(CELL tagged)
|
||||||
{
|
{
|
||||||
|
|
Loading…
Reference in New Issue