steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix deploy tests

db4
Slava Pestov 2008-07-02 21:52:28 -05:00
parent 9d512b3313
commit 17b94261c5
25 changed files with 105714 additions and 299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
core/parser/parser-docs.factor
View File

@ -139,7 +139,6 @@ ARTICLE: "parser-files" "Parsing source files"
"The parser can run source files:"
{ $subsection run-file }
{ $subsection parse-file }
{ $subsection bootstrap-file }
"The parser cross-references source files and definitions. This allows it to keep track of removed definitions, and prevent forward references and accidental redefinitions."
$nl
"While the above words are useful for one-off experiments, real programs should be written to use the vocabulary system instead; see " { $link "vocabs.loader" } "."
@ -359,10 +358,6 @@ HELP: ?run-file
{ $values { "path" "a pathname string" } }
{ $description "If the file exists, runs it with " { $link run-file } ", otherwise does nothing." } ;
HELP: bootstrap-file
{ $values { "path" "a pathname string" } }
{ $description "If bootstrapping, parses the source file and adds its top level form to the quotation being constructed with " { $link make } "; the bootstrap code uses this to build up a boot quotation to be run on image startup. If not bootstrapping, just runs the file normally." } ;
HELP: eval>string
{ $values { "str" string } { "output" string } }
{ $description "Evaluates the Factor code in " { $snippet "str" } " with " { $link output-stream } " rebound to a string output stream, then outputs the resulting string." } ;

3
core/parser/parser.factor
View File

@ -293,9 +293,6 @@ SYMBOL: interactive-vocabs
: ?run-file ( path -- )
dup exists? [ run-file ] [ drop ] if ;
: bootstrap-file ( path -- )
[ parse-file % ] [ run-file ] if-bootstrapping ;
: eval ( str -- )
[ string-lines parse-fresh ] with-compilation-unit call ;

15
core/vocabs/loader/loader.factor
View File

@ -54,9 +54,11 @@ SYMBOL: load-help?
: source-wasn't-loaded ( vocab -- ) f swap set-vocab-source-loaded? ;
: load-source ( vocab -- )
[ source-wasn't-loaded ] keep
[ vocab-source-path [ bootstrap-file ] when* ] keep
source-was-loaded ;
[ source-wasn't-loaded ]
[ vocab-source-path [ parse-file ] [ [ ] ] if* ]
[ source-was-loaded ]
tri
[ % ] [ call ] if-bootstrapping ;
: docs-were-loaded ( vocab -- ) t swap set-vocab-docs-loaded? ;
@ -64,9 +66,10 @@ SYMBOL: load-help?
: load-docs ( vocab -- )
load-help? get [
[ docs-weren't-loaded ] keep
[ vocab-docs-path [ ?run-file ] when* ] keep
docs-were-loaded
[ docs-weren't-loaded ]
[ vocab-docs-path [ ?run-file ] when* ]
[ docs-were-loaded ]
tri
] [ drop ] if ;
: reload ( name -- )

105398
extra/bunny/bun_zipper.ply Normal file
View File

File diff suppressed because it is too large Load Diff

2
extra/bunny/bunny.factor
View File

@ -1,7 +1,7 @@
USING: alien alien.c-types arrays sequences math math.vectors
math.matrices math.parser io io.files kernel opengl opengl.gl
opengl.glu shuffle http.client vectors namespaces ui.gadgets
ui.gadgets.canvas ui.render ui splitting combinators tools.time
ui.gadgets.canvas ui.render ui splitting combinators
system combinators.lib float-arrays continuations
opengl.demo-support multiline ui.gestures bunny.fixed-pipeline
bunny.cel-shaded bunny.outlined bunny.model accessors destructors ;

14
extra/bunny/deploy.factor
View File

@ -1,15 +1,15 @@
USING: tools.deploy.config ;
H{
{ deploy-reflection 1 }
{ deploy-math? t }
{ deploy-reflection 2 }
{ deploy-io 3 }
{ deploy-c-types? f }
{ deploy-random? f }
{ deploy-ui? t }
{ deploy-name "Bunny" }
{ deploy-word-defs? f }
{ "stop-after-last-window?" t }
{ deploy-threads? t }
{ deploy-compiler? t }
{ deploy-threads? t }
{ deploy-word-defs? f }
{ deploy-c-types? f }
{ deploy-io 3 }
{ "stop-after-last-window?" t }
{ deploy-random? f }
{ deploy-word-props? f }
}

2
extra/bunny/model/model.factor
View File

@ -1,7 +1,7 @@
USING: alien alien.c-types arrays sequences math math.vectors
math.matrices math.parser io io.files kernel opengl opengl.gl
opengl.glu io.encodings.ascii opengl.capabilities shuffle
http.client vectors splitting tools.time system combinators
http.client vectors splitting system combinators
float-arrays continuations destructors namespaces sequences.lib
accessors ;
IN: bunny.model

2
extra/help/handbook/handbook.factor
View File

@ -172,7 +172,7 @@ ARTICLE: "collections" "Collections"
{ $subsection "buffers" }
"There are many other collections in " { $snippet "extra/" } ", such as " { $vocab-link "disjoint-set" } ", " { $vocab-link "persistent-vectors" } ", and " { $vocab-link "tuple-arrays" } "." ;
USING: io.sockets io.launcher io.mmap io.monitors
USING: io.sockets io.sockets.secure io.launcher io.mmap io.monitors
io.encodings.utf8 io.encodings.utf16 io.encodings.binary io.encodings.ascii io.files ;
ARTICLE: "encodings-introduction" "An introduction to encodings"

80
extra/http/client/client.factor
View File

@ -1,17 +1,85 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs http kernel math math.parser namespaces sequences
io io.sockets io.streams.string io.files io.timeouts strings
splitting calendar continuations accessors vectors math.order
USING: accessors assocs kernel math math.parser namespaces
sequences io io.sockets io.streams.string io.files io.timeouts
strings splitting calendar continuations accessors vectors
math.order hashtables byte-arrays prettyprint
io.encodings
io.encodings.string
io.encodings.ascii
io.encodings.8-bit
io.encodings.binary
io.streams.duplex
fry debugger summary ascii urls present ;
fry debugger summary ascii urls present
http http.parsers ;
IN: http.client
: write-request-line ( request -- request )
dup
[ method>> write bl ]
[ url>> relative-url present write bl ]
[ "HTTP/" write version>> write crlf ]
tri ;
: url-host ( url -- string )
[ host>> ] [ port>> ] bi dup "http" protocol-port =
[ drop ] [ ":" swap number>string 3append ] if ;
: write-request-header ( request -- request )
dup header>> >hashtable
over url>> host>> [ over url>> url-host "host" pick set-at ] when
over post-data>> [
[ raw>> length "content-length" pick set-at ]
[ content-type>> "content-type" pick set-at ]
bi
] when*
over cookies>> f like [ unparse-cookie "cookie" pick set-at ] when*
write-header ;
GENERIC: >post-data ( object -- post-data )
M: post-data >post-data ;
M: string >post-data "application/octet-stream" <post-data> ;
M: byte-array >post-data "application/octet-stream" <post-data> ;
M: assoc >post-data assoc>query "application/x-www-form-urlencoded" <post-data> ;
M: f >post-data ;
: unparse-post-data ( request -- request )
[ >post-data ] change-post-data ;
: write-post-data ( request -- request )
dup method>> "POST" = [ dup post-data>> raw>> write ] when ;
: write-request ( request -- )
unparse-post-data
write-request-line
write-request-header
write-post-data
flush
drop ;
: read-response-line ( response -- response )
read-crlf parse-response-line first3
[ >>version ] [ >>code ] [ >>message ] tri* ;
: read-response-header ( response -- response )
read-header >>header
dup "set-cookie" header parse-set-cookie >>cookies
dup "content-type" header [
parse-content-type
[ >>content-type ]
[ >>content-charset ] bi*
] when* ;
: read-response ( -- response )
<response>
read-response-line
read-response-header ;
: max-redirects 10 ;
ERROR: too-many-redirects ;
@ -79,9 +147,7 @@ ERROR: download-failed response body ;
M: download-failed error.
"HTTP download failed:" print nl
[ response>> write-response-line nl drop ]
[ body>> write ]
bi ;
[ response>> . nl ] [ body>> write ] bi ;
: check-response ( response data -- response data )
over code>> success? [ download-failed ] unless ;

198
extra/http/http.factor
View File

@ -10,7 +10,7 @@ io.encodings.8-bit
unicode.case unicode.categories qualified
urls html.templates xml xml.data xml.writer
urls
http.parsers ;
@ -147,13 +147,6 @@ header
post-data
cookies ;
: check-url ( string -- url )
>url dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
: read-request-line ( request -- request )
read-crlf parse-request-line first3
[ >>method ] [ check-url >>url ] [ >>version ] tri* ;
: set-header ( request/response value key -- request/response )
pick header>> set-at ;
@ -168,114 +161,9 @@ cookies ;
"close" "connection" set-header
"Factor http.client" "user-agent" set-header ;
: check-absolute ( url -- url )
dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
: read-request-header ( request -- request )
read-header >>header ;
: header ( request/response key -- value )
swap header>> at ;
TUPLE: post-data raw content content-type ;
: <post-data> ( raw content-type -- post-data )
post-data new
swap >>content-type
swap >>raw ;
: parse-post-data ( post-data -- post-data )
[ ] [ raw>> ] [ content-type>> ] tri {
{ "application/x-www-form-urlencoded" [ query>assoc ] }
{ "text/xml" [ string>xml ] }
[ drop ]
} case >>content ;
: read-post-data ( request -- request )
dup method>> "POST" = [
[ ]
[ "content-length" header string>number read ]
[ "content-type" header ] tri
<post-data> parse-post-data >>post-data
] when ;
: extract-host ( request -- request )
[ ] [ url>> ] [ "host" header parse-host ] tri
[ >>host ] [ >>port ] bi*
drop ;
: extract-cookies ( request -- request )
dup "cookie" header [ parse-cookie >>cookies ] when* ;
: parse-content-type-attributes ( string -- attributes )
" " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
: parse-content-type ( content-type -- type encoding )
";" split1 parse-content-type-attributes "charset" swap at
name>encoding over "text/" head? latin1 binary ? or ;
: read-request ( -- request )
<request>
read-request-line
read-request-header
read-post-data
extract-host
extract-cookies ;
: write-request-line ( request -- request )
dup
[ method>> write bl ]
[ url>> relative-url present write bl ]
[ "HTTP/" write version>> write crlf ]
tri ;
: url-host ( url -- string )
[ host>> ] [ port>> ] bi dup "http" protocol-port =
[ drop ] [ ":" swap number>string 3append ] if ;
: write-request-header ( request -- request )
dup header>> >hashtable
over url>> host>> [ over url>> url-host "host" pick set-at ] when
over post-data>> [
[ raw>> length "content-length" pick set-at ]
[ content-type>> "content-type" pick set-at ]
bi
] when*
over cookies>> f like [ unparse-cookie "cookie" pick set-at ] when*
write-header ;
GENERIC: >post-data ( object -- post-data )
M: post-data >post-data ;
M: string >post-data "application/octet-stream" <post-data> ;
M: byte-array >post-data "application/octet-stream" <post-data> ;
M: xml >post-data xml>string "text/xml" <post-data> ;
M: assoc >post-data assoc>query "application/x-www-form-urlencoded" <post-data> ;
M: f >post-data ;
: unparse-post-data ( request -- request )
[ >post-data ] change-post-data ;
: write-post-data ( request -- request )
dup method>> "POST" = [ dup post-data>> raw>> write ] when ;
: write-request ( request -- )
unparse-post-data
write-request-line
write-request-header
write-post-data
flush
drop ;
GENERIC: write-response ( response -- )
GENERIC: write-full-response ( request response -- )
TUPLE: response
version
code
@ -301,72 +189,6 @@ M: response clone
[ clone ] change-header
[ clone ] change-cookies ;
: read-response-line ( response -- response )
read-crlf parse-response-line first3
[ >>version ] [ >>code ] [ >>message ] tri* ;
: read-response-header ( response -- response )
read-header >>header
dup "set-cookie" header parse-set-cookie >>cookies
dup "content-type" header [
parse-content-type
[ >>content-type ]
[ >>content-charset ] bi*
] when* ;
: read-response ( -- response )
<response>
read-response-line
read-response-header ;
: write-response-line ( response -- response )
dup
[ "HTTP/" write version>> write bl ]
[ code>> present write bl ]
[ message>> write crlf ]
tri ;
: unparse-content-type ( request -- content-type )
[ content-type>> "application/octet-stream" or ]
[ content-charset>> encoding>name ]
bi
[ "; charset=" swap 3append ] when* ;
: ensure-domain ( cookie -- cookie )
[
request get url>>
host>> dup "localhost" =
[ drop ] [ or ] if
] change-domain ;
: write-response-header ( response -- response )
#! We send one set-cookie header per cookie, because that's
#! what Firefox expects.
dup header>> >alist >vector
over unparse-content-type "content-type" pick set-at
over cookies>> [
ensure-domain unparse-set-cookie
"set-cookie" swap 2array over push
] each
write-header ;
: write-response-body ( response -- response )
dup body>> call-template ;
M: response write-response ( respose -- )
write-response-line
write-response-header
flush
drop ;
M: response write-full-response ( request response -- )
dup write-response
swap method>> "HEAD" = [
[ content-charset>> encode-output ]
[ write-response-body ]
bi
] unless ;
: get-cookie ( request/response name -- cookie/f )
[ cookies>> ] dip '[ , _ name>> = ] find nip ;
@ -387,10 +209,16 @@ body ;
raw-response new
"1.1" >>version ;
M: raw-response write-response ( respose -- )
write-response-line
write-response-body
drop ;
TUPLE: post-data raw content content-type ;
M: raw-response write-full-response ( response -- )
write-response nip ;
: <post-data> ( raw content-type -- post-data )
post-data new
swap >>content-type
swap >>raw ;
: parse-content-type-attributes ( string -- attributes )
" " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
: parse-content-type ( content-type -- type encoding )
";" split1 parse-content-type-attributes "charset" swap at
name>encoding over "text/" head? latin1 binary ? or ;

106
extra/http/server/server.factor
View File

@ -2,11 +2,12 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors sequences arrays namespaces splitting
vocabs.loader destructors assocs debugger continuations
combinators tools.vocabs tools.time math
io
combinators tools.vocabs tools.time math math.parser present
io vectors
io.sockets
io.sockets.secure
io.encodings
io.encodings.iana
io.encodings.utf8
io.encodings.ascii
io.encodings.binary
@ -15,11 +16,112 @@ io.servers.connection
io.timeouts
fry logging logging.insomniac calendar urls
http
http.parsers
http.server.responses
html.templates
html.elements
html.streams ;
IN: http.server
: check-absolute ( url -- url )
dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
: read-request-line ( request -- request )
read-crlf parse-request-line first3
[ >>method ] [ >url check-absolute >>url ] [ >>version ] tri* ;
: read-request-header ( request -- request )
read-header >>header ;
: parse-post-data ( post-data -- post-data )
[ ] [ raw>> ] [ content-type>> ] tri
"application/x-www-form-urlencoded" = [ query>assoc ] when
>>content ;
: read-post-data ( request -- request )
dup method>> "POST" = [
[ ]
[ "content-length" header string>number read ]
[ "content-type" header ] tri
<post-data> parse-post-data >>post-data
] when ;
: extract-host ( request -- request )
[ ] [ url>> ] [ "host" header parse-host ] tri
[ >>host ] [ >>port ] bi*
drop ;
: extract-cookies ( request -- request )
dup "cookie" header [ parse-cookie >>cookies ] when* ;
: read-request ( -- request )
<request>
read-request-line
read-request-header
read-post-data
extract-host
extract-cookies ;
GENERIC: write-response ( response -- )
GENERIC: write-full-response ( request response -- )
: write-response-line ( response -- response )
dup
[ "HTTP/" write version>> write bl ]
[ code>> present write bl ]
[ message>> write crlf ]
tri ;
: unparse-content-type ( request -- content-type )
[ content-type>> "application/octet-stream" or ]
[ content-charset>> encoding>name ]
bi
[ "; charset=" swap 3append ] when* ;
: ensure-domain ( cookie -- cookie )
[
request get url>>
host>> dup "localhost" =
[ drop ] [ or ] if
] change-domain ;
: write-response-header ( response -- response )
#! We send one set-cookie header per cookie, because that's
#! what Firefox expects.
dup header>> >alist >vector
over unparse-content-type "content-type" pick set-at
over cookies>> [
ensure-domain unparse-set-cookie
"set-cookie" swap 2array over push
] each
write-header ;
: write-response-body ( response -- response )
dup body>> call-template ;
M: response write-response ( respose -- )
write-response-line
write-response-header
flush
drop ;
M: response write-full-response ( request response -- )
dup write-response
swap method>> "HEAD" = [
[ content-charset>> encode-output ]
[ write-response-body ]
bi
] unless ;
M: raw-response write-response ( respose -- )
write-response-line
write-response-body
drop ;
M: raw-response write-full-response ( response -- )
write-response ;
: post-request? ( -- ? ) request get method>> "POST" = ;
SYMBOL: responder-nesting

31
extra/interval-maps/interval-maps.factor
View File

@ -1,48 +1,43 @@
USING: kernel sequences arrays accessors tuple-arrays
USING: kernel sequences arrays accessors grouping
math.order sorting math assocs locals namespaces ;
IN: interval-maps
TUPLE: interval-map array ;
<PRIVATE
TUPLE: interval-node from to value ;
: fixup-value ( value ? -- value/f ? )
[ drop f f ] unless* ;
: find-interval ( key interval-map -- interval-node )
[ first <=> ] binsearch* ;
: find-interval ( key interval-map -- i )
[ from>> <=> ] binsearch ;
: interval-contains? ( object interval-node -- ? )
[ from>> ] [ to>> ] bi between? ;
: interval-contains? ( key interval-node -- ? )
first2 between? ;
: all-intervals ( sequence -- intervals )
[ >r dup number? [ dup 2array ] when r> ] assoc-map
{ } assoc-like ;
[ >r dup number? [ dup 2array ] when r> ] { } assoc-map-as ;
: disjoint? ( node1 node2 -- ? )
[ to>> ] [ from>> ] bi* < ;
[ second ] [ first ] bi* < ;
: ensure-disjoint ( intervals -- intervals )
dup [ disjoint? ] monotonic?
[ "Intervals are not disjoint" throw ] unless ;
: >intervals ( specification -- intervals )
[ >r first2 r> interval-node boa ] { } assoc>map ;
[ suffix ] { } assoc>map concat 3 <groups> ;
PRIVATE>
: interval-at* ( key map -- value ? )
array>> [ find-interval ] 2keep swapd nth
[ nip value>> ] [ interval-contains? ] 2bi
fixup-value ;
[ drop ] [ array>> find-interval ] 2bi
tuck interval-contains? [ third t ] [ drop f f ] if ;
: interval-at ( key map -- value ) interval-at* drop ;
: interval-key? ( key map -- ? ) interval-at* nip ;
: <interval-map> ( specification -- map )
all-intervals [ [ first second ] compare ] sort
>intervals ensure-disjoint >tuple-array
interval-map boa ;
>intervals ensure-disjoint interval-map boa ;
: <interval-set> ( specification -- map )
[ dup 2array ] map <interval-map> ;

7
extra/io/launcher/launcher.factor
View File

@ -232,3 +232,10 @@ M: encoder underlying-handle
M: decoder underlying-handle
stream>> underlying-handle ;
{
{ [ os unix? ] [ "io.unix.launcher" require ] }
{ [ os winnt? ] [ "io.windows.nt.launcher" require ] }
{ [ os wince? ] [ "io.windows.launcher" require ] }
[ ]
} cond

7
extra/io/mmap/mmap.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors io.backend kernel quotations
sequences system alien alien.accessors accessors
sequences.private ;
sequences.private system vocabs.loader combinators ;
IN: io.mmap
TUPLE: mapped-file address handle length disposed ;
@ -29,3 +29,8 @@ M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
: with-mapped-file ( path length quot -- )
>r <mapped-file> r> with-disposal ; inline
{
{ [ os unix? ] [ "io.unix.mmap" require ] }
{ [ os winnt? ] [ "io.windows.mmap" require ] }
} cond

10
extra/io/monitors/monitors.factor
View File

@ -2,7 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend kernel continuations destructors namespaces
sequences assocs hashtables sorting arrays threads boxes
io.timeouts accessors concurrency.mailboxes ;
io.timeouts accessors concurrency.mailboxes
system vocabs.loader combinators ;
IN: io.monitors
HOOK: init-monitors io-backend ( -- )
@ -53,3 +54,10 @@ SYMBOL: +rename-file+
: with-monitor ( path recursive? quot -- )
>r <monitor> r> with-disposal ; inline
{
{ [ os macosx? ] [ "io.unix.macosx.monitors" require ] }
{ [ os linux? ] [ "io.unix.linux.monitors" require ] }
{ [ os winnt? ] [ "io.windows.nt.monitors" require ] }
[ ]
} cond

8
extra/io/pipes/pipes.factor
View File

@ -3,7 +3,7 @@
USING: io.encodings io.backend io.ports io.streams.duplex
io splitting grouping sequences namespaces kernel
destructors math concurrency.combinators accessors
arrays continuations quotations ;
arrays continuations quotations system vocabs.loader combinators ;
IN: io.pipes
TUPLE: pipe in out ;
@ -51,3 +51,9 @@ PRIVATE>
>r [ first in>> ] [ second out>> ] bi
r> run-pipeline-element
] 2parallel-map ;
{
{ [ os unix? ] [ "io.unix.pipes" require ] }
{ [ os winnt? ] [ "io.windows.nt.pipes" require ] }
[ ]
} cond

8
extra/io/sockets/secure/secure.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel symbols namespaces continuations
destructors io.sockets sequences summary calendar delegate ;
destructors io.sockets sequences summary calendar delegate
system vocabs.loader combinators ;
IN: io.sockets.secure
SYMBOL: secure-socket-timeout
@ -75,3 +76,8 @@ ERROR: common-name-verify-error expected got ;
M: common-name-verify-error summary
drop "Common name verification failed" ;
{
{ [ os unix? ] [ "io.unix.sockets.secure" require ] }
{ [ os windows? ] [ ] }
} cond

8
extra/io/sockets/sockets.factor
View File

@ -6,7 +6,7 @@ sequences arrays io.encodings io.ports io.streams.duplex
io.encodings.ascii alien.strings io.binary accessors destructors
classes debugger byte-arrays system combinators parser
alien.c-types math.parser splitting grouping
math assocs summary ;
math assocs summary system vocabs.loader combinators ;
IN: io.sockets
<< {
@ -308,3 +308,9 @@ M: invalid-inet-server summary
M: inet (server)
invalid-inet-server ;
{
{ [ os unix? ] [ "io.unix.sockets" require ] }
{ [ os winnt? ] [ "io.windows.nt.sockets" require ] }
{ [ os wince? ] [ "io.windows.ce.sockets" require ] }
} cond

3
extra/io/unix/bsd/bsd.factor
View File

@ -2,8 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: io.unix.bsd
USING: namespaces system kernel accessors assocs continuations
unix
io.backend io.unix.backend io.unix.select io.monitors ;
unix io.backend io.unix.backend io.unix.select ;
M: bsd init-io ( -- )
<select-mx> mx set-global ;

21
extra/io/unix/macosx/macosx.factor
View File

@ -1,25 +1,6 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.unix.bsd io.backend io.monitors core-foundation.fsevents
continuations kernel sequences namespaces arrays system locals
accessors destructors ;
IN: io.unix.macosx
TUPLE: macosx-monitor < monitor handle ;
: enqueue-notifications ( triples monitor -- )
[
>r first { +modify-file+ } r> queue-change
] curry each ;
M:: macosx (monitor) ( path recursive? mailbox -- monitor )
[let | path [ path normalize-path ] |
path mailbox macosx-monitor new-monitor
dup [ enqueue-notifications ] curry
path 1array 0 0 <event-stream> >>handle
] ;
M: macosx-monitor dispose
handle>> dispose ;
USING: io.unix.bsd io.backend system ;
macosx set-io-backend

25
extra/io/unix/macosx/monitors/monitors.factor Normal file
View File

@ -0,0 +1,25 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io.backend io.monitors
core-foundation.fsevents continuations kernel sequences
namespaces arrays system locals accessors destructors ;
IN: io.unix.macosx.monitors
TUPLE: macosx-monitor < monitor handle ;
: enqueue-notifications ( triples monitor -- )
[
>r first { +modify-file+ } r> queue-change
] curry each ;
M:: macosx (monitor) ( path recursive? mailbox -- monitor )
[let | path [ path normalize-path ] |
path mailbox macosx-monitor new-monitor
dup [ enqueue-notifications ] curry
path 1array 0 0 <event-stream> >>handle
] ;
M: macosx-monitor dispose
handle>> dispose ;
macosx set-io-backend

13
extra/io/unix/unix.factor
View File

@ -1,13 +1,4 @@
USING: accessors system words sequences vocabs.loader ;
{
"io.unix.backend"
"io.unix.files"
"io.unix.sockets"
"io.unix.sockets.secure"
"io.unix.launcher"
"io.unix.mmap"
"io.unix.pipes"
} [ require ] each
USING: accessors system words sequences vocabs.loader
io.unix.backend io.unix.files ;
"io.unix." os name>> append require

15
extra/io/windows/nt/nt.factor
View File

@ -1,18 +1,7 @@
! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman,
! Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USE: vocabs.loader
USE: io.windows
USE: io.windows.nt.backend
USE: io.windows.nt.files
USE: io.windows.nt.launcher
USE: io.windows.nt.monitors
USE: io.windows.nt.privileges
USE: io.windows.nt.sockets
USE: io.windows.mmap
USE: io.windows.files
USE: io.backend
USE: openssl
USE: system
USING: vocabs.loader io.windows io.windows.nt.backend
io.windows.nt.files io.windows.files io.backend system ;
winnt set-io-backend

2
extra/sequences/lib/lib.factor
View File

@ -2,7 +2,7 @@
! Eduardo Cavazos, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel sequences math namespaces assocs
random sequences.private shuffle math.functions mirrors
random sequences.private shuffle math.functions
arrays math.parser math.private sorting strings ascii macros
assocs.lib quotations hashtables math.order locals ;
IN: sequences.lib

30
extra/urls/urls.factor
View File

@ -1,11 +1,10 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel unicode.categories combinators
combinators.short-circuit sequences splitting fry namespaces
assocs arrays strings io.sockets io.sockets.secure
io.encodings.string io.encodings.utf8 math math.parser accessors
mirrors parser strings.parser lexer prettyprint.backend
hashtables present ;
USING: kernel ascii combinators combinators.short-circuit
sequences splitting fry namespaces assocs arrays strings
io.sockets io.sockets.secure io.encodings.string
io.encodings.utf8 math math.parser accessors parser
strings.parser lexer prettyprint.backend hashtables present ;
IN: urls
: url-quotable? ( ch -- ? )
@ -188,13 +187,22 @@ M: url present
PRIVATE>
: derive-url ( base url -- url' )
[ clone dup ] dip
2dup [ path>> ] bi@ url-append-path
[ [ <mirror> ] bi@ [ nip ] assoc-filter update ] dip
>>path ;
[ clone ] dip over {
[ [ protocol>> ] either? >>protocol ]
[ [ username>> ] either? >>username ]
[ [ password>> ] either? >>password ]
[ [ host>> ] either? >>host ]
[ [ port>> ] either? >>port ]
[ [ path>> ] bi@ swap url-append-path >>path ]
[ [ query>> ] either? >>query ]
[ [ anchor>> ] either? >>anchor ]
} 2cleave ;
: relative-url ( url -- url' )
clone f >>protocol f >>host f >>port ;
clone
f >>protocol
f >>host
f >>port ;
! Half-baked stuff follows
: secure-protocol? ( protocol -- ? )