Merge branch 'master' of git://factorcode.org/git/factor
Daniel Ehrenberg
commit
950e376f95
|
|
@ -15,12 +15,12 @@ crossref off
|
|||
"resource:core/bootstrap/syntax.factor" parse-file
|
||||
|
||||
"resource:core/cpu/" architecture get {
|
||||
{ "x86.32" "x86/32" }
|
||||
{ "x86.64" "x86/64" }
|
||||
{ "linux-ppc" "ppc/linux" }
|
||||
{ "macosx-ppc" "ppc/macosx" }
|
||||
{ "arm" "arm" }
|
||||
} at "/bootstrap.factor" 3append parse-file
|
||||
{ "x86.32" "x86/32" }
|
||||
{ "x86.64" "x86/64" }
|
||||
{ "linux-ppc" "ppc/linux" }
|
||||
{ "macosx-ppc" "ppc/macosx" }
|
||||
{ "arm" "arm" }
|
||||
} at "/bootstrap.factor" 3append 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" }
|
||||
{ "curry" "kernel" }
|
||||
{ "<tuple-boa>" "tuples.private" }
|
||||
{ "class-hash" "kernel.private" }
|
||||
{ "class-hash" "kernel.private" }
|
||||
{ "callstack>array" "kernel" }
|
||||
{ "innermost-frame-quot" "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.
|
||||
USING: arrays definitions generic assocs kernel math
|
||||
namespaces prettyprint sequences strings vectors words
|
||||
quotations inspector io.styles io combinators sorting
|
||||
splitting math.parser effects continuations debugger
|
||||
io.files io.streams.string io.streams.lines vocabs
|
||||
source-files classes hashtables compiler.errors compiler.units
|
||||
ascii ;
|
||||
source-files classes hashtables compiler.errors compiler.units ;
|
||||
IN: parser
|
||||
|
||||
TUPLE: lexer text line column ;
|
||||
|
|
@ -55,8 +54,9 @@ t parser-notes set-global
|
|||
0 over set-lexer-column
|
||||
dup lexer-line 1+ swap set-lexer-line ;
|
||||
|
||||
: skip ( i seq quot -- n )
|
||||
over >r find* drop
|
||||
: skip ( i seq ? -- n )
|
||||
over >r
|
||||
[ swap CHAR: \s eq? xor ] curry find* drop
|
||||
[ r> drop ] [ r> length ] if* ; inline
|
||||
|
||||
: change-column ( lexer quot -- )
|
||||
|
|
@ -67,14 +67,13 @@ t parser-notes set-global
|
|||
GENERIC: skip-blank ( lexer -- )
|
||||
|
||||
M: lexer skip-blank ( lexer -- )
|
||||
[ [ blank? not ] skip ] change-column ;
|
||||
[ t skip ] change-column ;
|
||||
|
||||
GENERIC: skip-word ( lexer -- )
|
||||
|
||||
M: lexer skip-word ( lexer -- )
|
||||
[
|
||||
2dup nth CHAR: " =
|
||||
[ drop 1+ ] [ [ blank? ] skip ] if
|
||||
2dup nth CHAR: " = [ drop 1+ ] [ f skip ] if
|
||||
] change-column ;
|
||||
|
||||
: still-parsing? ( lexer -- ? )
|
||||
|
|
@ -348,45 +347,49 @@ SYMBOL: bootstrap-syntax
|
|||
call
|
||||
] 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 -- )
|
||||
[
|
||||
"scratchpad" in set
|
||||
{
|
||||
"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
|
||||
interactive-vocabs get set-use
|
||||
call
|
||||
] 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
|
||||
strings sbufs io.styles vectors words prettyprint.config
|
||||
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
|
||||
|
||||
GENERIC: pprint* ( obj -- )
|
||||
|
|
@ -58,24 +58,17 @@ M: f pprint* drop \ f pprint-word ;
|
|||
! Strings
|
||||
: ch>ascii-escape ( ch -- str )
|
||||
H{
|
||||
{ CHAR: \e "\\e" }
|
||||
{ CHAR: \n "\\n" }
|
||||
{ CHAR: \r "\\r" }
|
||||
{ CHAR: \t "\\t" }
|
||||
{ CHAR: \0 "\\0" }
|
||||
{ CHAR: \\ "\\\\" }
|
||||
{ CHAR: \" "\\\"" }
|
||||
{ CHAR: \e CHAR: e }
|
||||
{ CHAR: \n CHAR: n }
|
||||
{ CHAR: \r CHAR: r }
|
||||
{ CHAR: \t CHAR: t }
|
||||
{ CHAR: \0 CHAR: 0 }
|
||||
{ CHAR: \\ CHAR: \\ }
|
||||
{ CHAR: \" CHAR: \" }
|
||||
} at ;
|
||||
|
||||
: ch>unicode-escape ( ch -- str )
|
||||
>hex 6 CHAR: 0 pad-left "\\u" swap append ;
|
||||
|
||||
: unparse-ch ( ch -- )
|
||||
dup quotable? [
|
||||
,
|
||||
] [
|
||||
dup ch>ascii-escape [ ] [ ch>unicode-escape ] ?if %
|
||||
] if ;
|
||||
dup ch>ascii-escape [ "\\" % ] [ ] ?if , ;
|
||||
|
||||
: do-string-limit ( str -- trimmed )
|
||||
string-limit get [
|
||||
|
|
|
|||
|
|
@ -51,6 +51,9 @@ unit-test
|
|||
[ "ab" ] [ 2 "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
|
||||
[ { "kernel-error" 3 12 -7 } ]
|
||||
[ [ 2 -7 resize-string ] catch ] unit-test
|
||||
|
|
@ -88,3 +91,5 @@ unit-test
|
|||
"\udeadbe" clone
|
||||
CHAR: \u123456 over clone set-first
|
||||
] unit-test
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ M: string set-nth-unsafe
|
|||
>r >fixnum >r >fixnum r> r> set-string-nth ;
|
||||
|
||||
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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -24,5 +24,3 @@ IN: ascii
|
|||
|
||||
: alpha? ( ch -- ? )
|
||||
dup Letter? [ drop t ] [ digit? ] if ; inline
|
||||
|
||||
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
USING: kernel io io.files splitting strings
|
||||
hashtables sequences assocs math namespaces prettyprint
|
||||
math.parser combinators arrays sorting ;
|
||||
math.parser combinators arrays sorting unicode.case ;
|
||||
|
||||
IN: benchmark.knucleotide
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: io io.files io.streams.duplex kernel sequences
|
||||
sequences.private strings vectors words memoize splitting
|
||||
hints ;
|
||||
hints unicode.case ;
|
||||
IN: benchmark.reverse-complement
|
||||
|
||||
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
|
||||
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 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
|
@ -61,7 +59,7 @@ if
|
|||
|
||||
"factor" cd
|
||||
|
||||
{ "/usr/bin/git" "show" } <process-stream>
|
||||
{ "git" "show" } <process-stream>
|
||||
[ readln ] with-stream
|
||||
" " split second
|
||||
"../git-id" <file-writer> [ print ] with-stream
|
||||
|
|
@ -76,7 +74,7 @@ if
|
|||
"builder: vm compile" throw
|
||||
] if
|
||||
|
||||
"wget http://factorcode.org/images/latest/" boot-image append system
|
||||
"wget http://factorcode.org/images/latest/" boot-image-name append system
|
||||
0 =
|
||||
[ ]
|
||||
[
|
||||
|
|
@ -84,7 +82,11 @@ if
|
|||
"builder: image download" throw
|
||||
] 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
|
||||
"../boot-time" <file-writer> [ . ] with-stream
|
||||
0 =
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
! Adapted from cryptlib.h
|
||||
! Tested with cryptlib 3.3.1.0
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel peg strings promises sequences math math.parser
|
||||
namespaces words quotations arrays hashtables io
|
||||
io.streams.string assocs memoize ;
|
||||
io.streams.string assocs memoize ascii ;
|
||||
IN: fjsc
|
||||
|
||||
TUPLE: ast-number value ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: parser-combinators regexp lazy-lists sequences kernel
|
||||
promises strings ;
|
||||
promises strings unicode.case ;
|
||||
IN: globs
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: arrays combinators.lib io io.streams.string
|
||||
kernel math math.parser namespaces prettyprint
|
||||
sequences splitting strings ;
|
||||
kernel math math.parser namespaces prettyprint
|
||||
sequences splitting strings ascii ;
|
||||
IN: hexdump
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ M: template-lexer skip-word
|
|||
{
|
||||
{ [ 2dup nth CHAR: " = ] [ drop 1+ ] }
|
||||
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
|
||||
{ [ t ] [ [ blank? ] skip ] }
|
||||
{ [ t ] [ f skip ] }
|
||||
} cond
|
||||
] change-column ;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
USING: arrays combinators io io.binary io.files io.paths
|
||||
io.utf16 kernel math math.parser namespaces sequences
|
||||
splitting strings assocs ;
|
||||
splitting strings assocs unicode.categories ;
|
||||
|
||||
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." } ;
|
||||
|
||||
HELP: next-change
|
||||
{ $values { "monitor" "a monitor" } { "path" "a pathname string" } { "changes" "a sequence of change descriptors" } }
|
||||
{ $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" } "." } ;
|
||||
{ $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 aq sequence of symbols documented in " { $link "io.monitor.descriptors" } "." } ;
|
||||
|
||||
HELP: with-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." } ;
|
||||
|
||||
HELP: +change-file+
|
||||
{ $description "Indicates that the contents of the file have changed." } ;
|
||||
HELP: +add-file+
|
||||
{ $description "Indicates that the file has been added to the directory." } ;
|
||||
|
||||
HELP: +change-name+
|
||||
{ $description "Indicates that the file name has changed." } ;
|
||||
HELP: +remove-file+
|
||||
{ $description "Indicates that the file has been removed from the directory." } ;
|
||||
|
||||
HELP: +change-size+
|
||||
{ $description "Indicates that the file size has changed." } ;
|
||||
HELP: +modify-file+
|
||||
{ $description "Indicates that the file contents have changed." } ;
|
||||
|
||||
HELP: +change-attributes+
|
||||
{ $description "Indicates that file attributes has changed. Attributes are operating system-specific but may include the creation time and permissions." } ;
|
||||
|
||||
HELP: +change-modified+
|
||||
{ $description "Indicates that the last modification time of the file has changed." } ;
|
||||
HELP: +rename-file+
|
||||
{ $description "Indicates that file has been renamed." } ;
|
||||
|
||||
ARTICLE: "io.monitor.descriptors" "File system change descriptors"
|
||||
"Change descriptors output by " { $link next-change } ":"
|
||||
{ $subsection +change-file+ }
|
||||
{ $subsection +change-name+ }
|
||||
{ $subsection +change-size+ }
|
||||
{ $subsection +change-attributes+ }
|
||||
{ $subsection +change-modified+ } ;
|
||||
{ $subsection +add-file+ }
|
||||
{ $subsection +remove-file+ }
|
||||
{ $subsection +modify-file+ }
|
||||
{ $subsection +rename-file+ }
|
||||
{ $subsection +add-file+ } ;
|
||||
|
||||
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."
|
||||
|
|
|
|||
|
|
@ -7,11 +7,10 @@ HOOK: <monitor> io-backend ( path recursive? -- monitor )
|
|||
|
||||
HOOK: next-change io-backend ( monitor -- path changes )
|
||||
|
||||
SYMBOL: +change-file+
|
||||
SYMBOL: +change-name+
|
||||
SYMBOL: +change-size+
|
||||
SYMBOL: +change-attributes+
|
||||
SYMBOL: +change-modified+
|
||||
SYMBOL: +add-file+
|
||||
SYMBOL: +remove-file+
|
||||
SYMBOL: +modify-file+
|
||||
SYMBOL: +rename-file+
|
||||
|
||||
: with-monitor ( path recursive? quot -- )
|
||||
>r <monitor> r> with-disposal ; inline
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ SYMBOL: log-stream
|
|||
|
||||
: with-log-file ( file quot -- )
|
||||
>r <file-appender> r>
|
||||
[ with-log-stream ] with-disposal ; inline
|
||||
[ with-log-stream ] curry with-disposal ; inline
|
||||
|
||||
: with-log-stdio ( quot -- )
|
||||
stdio get swap with-log-stream ;
|
||||
|
|
@ -47,11 +47,11 @@ SYMBOL: log-stream
|
|||
dup log-client
|
||||
[ 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
|
||||
|
||||
: server-loop ( server quot -- )
|
||||
[ accept-loop ] compose with-disposal ; inline
|
||||
[ accept-loop ] curry with-disposal ; inline
|
||||
|
||||
: spawn-server ( addrspec quot -- )
|
||||
"Waiting for connections on " pick unparse append
|
||||
|
|
|
|||
|
|
@ -119,8 +119,15 @@ TUPLE: CreateProcess-args
|
|||
drop STD_ERROR_HANDLE GetStdHandle ;
|
||||
|
||||
: redirect-stderr ( args -- handle )
|
||||
+stderr+ get GENERIC_WRITE CREATE_ALWAYS redirect
|
||||
swap inherited-stderr ?closed ;
|
||||
+stderr+ get
|
||||
dup +stdout+ eq? [
|
||||
drop
|
||||
CreateProcess-args-lpStartupInfo
|
||||
STARTUPINFO-hStdOutput
|
||||
] [
|
||||
GENERIC_WRITE CREATE_ALWAYS redirect
|
||||
swap inherited-stderr ?closed
|
||||
] if ;
|
||||
|
||||
: inherited-stdin ( args -- handle )
|
||||
CreateProcess-args-stdin-pipe
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ USING: alien.c-types destructors io.windows
|
|||
io.windows.nt.backend kernel math windows windows.kernel32
|
||||
windows.types libc assocs alien namespaces continuations
|
||||
io.monitor io.nonblocking io.buffers io.files io sequences
|
||||
hashtables sorting arrays ;
|
||||
hashtables sorting arrays combinators ;
|
||||
IN: io.windows.nt.monitor
|
||||
|
||||
TUPLE: monitor path recursive? queue closed? ;
|
||||
|
|
@ -53,25 +53,17 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
] with-port-timeout
|
||||
] with-destructors ;
|
||||
|
||||
: parse-action-flag ( action mask symbol -- action )
|
||||
>r over bitand 0 > [ r> , ] [ r> drop ] if ;
|
||||
: parse-action ( action -- changed )
|
||||
{
|
||||
{ [ 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 )
|
||||
[
|
||||
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 )
|
||||
: changed-file ( directory buffer -- changed path )
|
||||
{
|
||||
FILE_NOTIFY_INFORMATION-FileName
|
||||
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 ;
|
||||
|
||||
: (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?
|
||||
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2007 Doug Coleman, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays calendar io io.sockets kernel match namespaces
|
||||
sequences splitting strings continuations threads ;
|
||||
sequences splitting strings continuations threads ascii ;
|
||||
IN: irc
|
||||
|
||||
! "setup" objects
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel parser-combinators namespaces sequences promises strings
|
||||
assocs math math.parser math.vectors math.functions
|
||||
lazy-lists hashtables ;
|
||||
lazy-lists hashtables ascii ;
|
||||
IN: json.reader
|
||||
|
||||
! Grammar for JSON from RFC 4627
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! 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
|
||||
vectors vocabs words ;
|
||||
USING: html.elements slots.private tar ;
|
||||
vectors vocabs words html.elements slots.private tar ;
|
||||
IN: lint
|
||||
|
||||
SYMBOL: def-hash
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel strings math sequences lazy-lists words
|
||||
math.parser promises parser-combinators ;
|
||||
math.parser promises parser-combinators unicode.categories ;
|
||||
IN: parser-combinators.simple
|
||||
|
||||
: 'digit' ( -- parser )
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
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
|
||||
|
||||
TUPLE: ebnf-non-terminal symbol ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2007 Chris Double.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
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
|
||||
|
||||
TUPLE: parse-result remaining ast ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! 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
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=17
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (c) 2007 Aaron Schaefer.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.files kernel math math.parser namespaces sequences sorting splitting
|
||||
strings system vocabs ;
|
||||
strings system vocabs ascii ;
|
||||
IN: project-euler.022
|
||||
|
||||
! http://projecteuler.net/index.php?section=problems&id=22
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: kernel sequences arrays vectors namespaces math strings
|
||||
combinators continuations quotations io assocs ;
|
||||
combinators continuations quotations io assocs ascii ;
|
||||
|
||||
IN: prolog
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
USING: arrays combinators kernel lazy-lists math math.parser
|
||||
namespaces parser parser-combinators parser-combinators.simple
|
||||
promises quotations sequences combinators.lib strings
|
||||
assocs prettyprint.backend memoize ;
|
||||
assocs prettyprint.backend memoize unicode.case unicode.categories ;
|
||||
USE: io
|
||||
IN: regexp
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
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
|
||||
|
||||
<PRIVATE
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2006 Daniel Ehrenberg
|
||||
! 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
|
||||
|
||||
: rotate ( ch base -- ch ) tuck - 13 + 26 mod + ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: combinators.lib kernel sequences math namespaces assocs
|
||||
random sequences.private shuffle math.functions mirrors ;
|
||||
USING: arrays math.parser sorting strings ;
|
||||
random sequences.private shuffle math.functions mirrors
|
||||
arrays math.parser sorting strings ascii ;
|
||||
IN: sequences.lib
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io io.streams.string kernel math namespaces sequences
|
||||
strings circular prettyprint debugger ;
|
||||
strings circular prettyprint debugger unicode.categories ;
|
||||
IN: state-parser
|
||||
|
||||
! * Basic underlying words
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
USING: math arrays sequences kernel splitting strings ;
|
||||
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 )
|
||||
dup empty? [
|
||||
unclip ch>upper 1string swap append
|
||||
] unless ;
|
||||
! : >Upper ( str -- str )
|
||||
! dup empty? [
|
||||
! unclip ch>upper 1string swap append
|
||||
! ] unless ;
|
||||
|
||||
: >Upper-dashes ( str -- str )
|
||||
"-" split [ >Upper ] map "-" join ;
|
||||
! : >Upper-dashes ( str -- str )
|
||||
! "-" split [ >Upper ] map "-" join ;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
USING: kernel unicode.data sequences sequences.next namespaces assocs.lib
|
||||
unicode.normalize math unicode.categories combinators assocs ;
|
||||
USING: kernel unicode.data sequences sequences.next namespaces
|
||||
assocs.lib unicode.normalize math unicode.categories combinators
|
||||
assocs ;
|
||||
IN: unicode.case
|
||||
|
||||
: 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 ;
|
||||
|
||||
: 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 -- ? )
|
||||
combining-class 230 = ;
|
||||
|
|
@ -32,14 +33,14 @@ SYMBOL: locale ! Just casing locale, or overall?
|
|||
dup , "IJ" member? swap mark-above? and [ dot-over , ] when ;
|
||||
|
||||
: lithuanian>lower ( string -- lower )
|
||||
[ [ lithuanian-ch>lower ] each-next ] "" make* ;
|
||||
[ [ lithuanian-ch>lower ] each-next ] "" make ;
|
||||
|
||||
: turk-ch>upper ( ch -- )
|
||||
dup CHAR: i =
|
||||
[ drop CHAR: I , dot-over , ] [ , ] if ;
|
||||
|
||||
: turk>upper ( string -- upper-i )
|
||||
[ [ turk-ch>upper ] each ] "" make* ;
|
||||
[ [ turk-ch>upper ] each ] "" make ;
|
||||
|
||||
: turk-ch>lower ( ? next ch -- ? )
|
||||
{
|
||||
|
|
@ -52,7 +53,7 @@ SYMBOL: locale ! Just casing locale, or overall?
|
|||
} cond ;
|
||||
|
||||
: 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 ? )
|
||||
dup non-starter? [ drop dup ] when
|
||||
|
|
@ -76,7 +77,7 @@ SYMBOL: locale ! Just casing locale, or overall?
|
|||
[ -rot nip call , ] ?if
|
||||
] 2keep
|
||||
] each 2drop
|
||||
] "" make* ; inline
|
||||
] "" make ; inline
|
||||
|
||||
: >lower ( string -- lower )
|
||||
i-dot? [ turk>lower ] when
|
||||
|
|
|
|||
|
|
@ -2,17 +2,6 @@ USING: sequences namespaces unicode.data kernel combinators.lib
|
|||
math arrays ;
|
||||
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
|
||||
|
||||
: 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.
|
||||
USING: namespaces kernel assocs io.files combinators
|
||||
arrays io.launcher io http.server.responders webapps.file
|
||||
sequences strings math.parser ;
|
||||
sequences strings math.parser unicode.case ;
|
||||
IN: webapps.cgi
|
||||
|
||||
SYMBOL: cgi-root
|
||||
|
|
@ -31,7 +31,7 @@ SYMBOL: cgi-root
|
|||
|
||||
"method" get >upper "REQUEST_METHOD" 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
|
||||
"Accept" header-param "HTTP_ACCEPT" set
|
||||
|
|
|
|||
|
|
@ -83,6 +83,12 @@ IN: windows.kernel32
|
|||
: FILE_NOTIFY_CHANGE_FILE_NAME HEX: 200 ; 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
|
||||
{ "DWORD" "NextEntryOffset" }
|
||||
{ "DWORD" "Action" }
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: xml.errors xml.data xml.utilities xml.char-classes
|
||||
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
|
||||
|
||||
! XML namespace processing: ns = namespace
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: io io.streams.string io.files kernel math namespaces
|
||||
prettyprint sequences arrays generic strings vectors
|
||||
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
|
||||
|
||||
! -- 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
|
||||
|
||||
! Based on org.gjt.sp.jedit.syntax.KeywordMap
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ IN: xmode.marker
|
|||
USING: kernel namespaces xmode.rules xmode.tokens
|
||||
xmode.marker.state xmode.marker.context xmode.utilities
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: xmode.tokens xmode.keyword-map kernel
|
||||
sequences vectors assocs strings memoize regexp ;
|
||||
sequences vectors assocs strings memoize regexp unicode.case ;
|
||||
IN: xmode.rules
|
||||
|
||||
TUPLE: string-matcher string ignore-case? ;
|
||||
|
|
|
|||
|
|
@ -505,7 +505,6 @@ CELL binary_payload_start(CELL pointer)
|
|||
switch(untag_header(get(pointer)))
|
||||
{
|
||||
/* these objects do not refer to other objects at all */
|
||||
case STRING_TYPE:
|
||||
case FLOAT_TYPE:
|
||||
case BYTE_ARRAY_TYPE:
|
||||
case BIT_ARRAY_TYPE:
|
||||
|
|
@ -522,6 +521,8 @@ CELL binary_payload_start(CELL pointer)
|
|||
return CELLS * 2;
|
||||
case QUOTATION_TYPE:
|
||||
return sizeof(F_QUOTATION) - CELLS * 2;
|
||||
case STRING_TYPE:
|
||||
return sizeof(F_STRING);
|
||||
/* everything else consists entirely of pointers */
|
||||
default:
|
||||
return unaligned_object_size(pointer);
|
||||
|
|
|
|||
|
|
@ -1,6 +1,11 @@
|
|||
#include "master.h"
|
||||
|
||||
extern int main();
|
||||
|
||||
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)
|
||||
{
|
||||
bput(SREF(string,index),value & 0xff);
|
||||
|
||||
F_BYTE_ARRAY *aux;
|
||||
|
||||
if(string->aux == F)
|
||||
{
|
||||
if(value <= 0xff)
|
||||
return;
|
||||
else
|
||||
{
|
||||
string->aux = tag_object(allot_byte_array(
|
||||
REGISTER_UNTAGGED(string);
|
||||
aux = allot_byte_array(
|
||||
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);
|
||||
}
|
||||
|
||||
|
|
@ -463,20 +470,36 @@ F_STRING* allot_string_internal(CELL capacity)
|
|||
string->length = tag_fixnum(capacity);
|
||||
string->hashcode = F;
|
||||
string->aux = F;
|
||||
|
||||
set_string_nth(string,capacity,0);
|
||||
|
||||
return string;
|
||||
}
|
||||
|
||||
/* allocates memory */
|
||||
void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
|
||||
{
|
||||
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
|
||||
{
|
||||
CELL i;
|
||||
|
||||
for(i = start; i < capacity; i++)
|
||||
{
|
||||
REGISTER_UNTAGGED(string);
|
||||
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* string = allot_string_internal(capacity);
|
||||
REGISTER_UNTAGGED(string);
|
||||
fill_string(string,0,capacity,fill);
|
||||
UNREGISTER_UNTAGGED(string);
|
||||
return string;
|
||||
}
|
||||
|
||||
|
|
@ -506,7 +531,23 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill)
|
|||
UNREGISTER_UNTAGGED(string);
|
||||
|
||||
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);
|
||||
UNREGISTER_UNTAGGED(string);
|
||||
|
||||
return new_string;
|
||||
}
|
||||
|
|
@ -529,7 +570,9 @@ DEFINE_PRIMITIVE(resize_string)
|
|||
CELL i; \
|
||||
for(i = 0; i < length; i++) \
|
||||
{ \
|
||||
REGISTER_UNTAGGED(s); \
|
||||
set_string_nth(s,i,(utype)*string); \
|
||||
UNREGISTER_UNTAGGED(s); \
|
||||
string++; \
|
||||
} \
|
||||
return s; \
|
||||
|
|
@ -552,6 +595,7 @@ DEFINE_PRIMITIVE(resize_string)
|
|||
|
||||
MEMORY_TO_STRING(char,u8)
|
||||
MEMORY_TO_STRING(u16,u16)
|
||||
MEMORY_TO_STRING(u32,u32)
|
||||
|
||||
bool check_string(F_STRING *s, CELL max)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -83,8 +83,8 @@ INLINE CELL array_capacity(F_ARRAY* array)
|
|||
return array->capacity >> TAG_BITS;
|
||||
}
|
||||
|
||||
#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + index)
|
||||
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index)
|
||||
#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index))
|
||||
#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index))
|
||||
|
||||
INLINE F_STRING* untag_string(CELL tagged)
|
||||
{
|
||||
|
|
|
|||
Loading…
Reference in New Issue