Merge commit 'origin/master' into emacs
Jose A. Ortega Ruiz
commit
4e53f2512a
basis
bootstrap
cpu
ppc
linux
macosx
x86
debugger
help/html
html/templates
images/bitmap
io
directories/unix
encodings
sockets/secure
mime/types
openssl
porter-stemmer
syndication
tools
unicode
data
normalize
script
xmode
core
bootstrap
io
parser
vocabs
extra
benchmark
usa-cities
webapps/todo
websites/concatenative
|
|
@ -10,7 +10,7 @@ IN: bootstrap.help
|
|||
|
||||
t load-help? set-global
|
||||
|
||||
[ drop ] load-vocab-hook [
|
||||
[ vocab ] load-vocab-hook [
|
||||
dictionary get values
|
||||
[ docs-loaded?>> not ] filter
|
||||
[ load-docs ] each
|
||||
|
|
|
|||
|
|
@ -93,9 +93,9 @@ SYMBOL: bootstrap-time
|
|||
"tools.deploy.shaker" run
|
||||
] [
|
||||
"staging" get [
|
||||
"resource:basis/bootstrap/finish-staging.factor" run-file
|
||||
"vocab:bootstrap/finish-staging.factor" run-file
|
||||
] [
|
||||
"resource:basis/bootstrap/finish-bootstrap.factor" run-file
|
||||
"vocab:bootstrap/finish-bootstrap.factor" run-file
|
||||
] if
|
||||
|
||||
"output-image" get save-image-and-exit
|
||||
|
|
@ -104,6 +104,6 @@ SYMBOL: bootstrap-time
|
|||
drop
|
||||
[
|
||||
load-help? off
|
||||
"resource:basis/bootstrap/bootstrap-error.factor" run-file
|
||||
"vocab:bootstrap/bootstrap-error.factor" run-file
|
||||
] with-scope
|
||||
] recover
|
||||
|
|
|
|||
|
|
@ -6,5 +6,5 @@ IN: bootstrap.ppc
|
|||
: c-area-size ( -- n ) 10 bootstrap-cells ;
|
||||
: lr-save ( -- n ) bootstrap-cell ;
|
||||
|
||||
<< "resource:basis/cpu/ppc/bootstrap.factor" parse-file parsed >>
|
||||
<< "vocab:cpu/ppc/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -6,5 +6,5 @@ IN: bootstrap.ppc
|
|||
: c-area-size ( -- n ) 14 bootstrap-cells ;
|
||||
: lr-save ( -- n ) 2 bootstrap-cells ;
|
||||
|
||||
<< "resource:basis/cpu/ppc/bootstrap.factor" parse-file parsed >>
|
||||
<< "vocab:cpu/ppc/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -30,5 +30,5 @@ IN: bootstrap.x86
|
|||
(JMP) drop
|
||||
] rc-relative rt-primitive 1 jit-primitive jit-define
|
||||
|
||||
<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >>
|
||||
<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -30,5 +30,5 @@ IN: bootstrap.x86
|
|||
temp1 JMP ! go
|
||||
] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
|
||||
|
||||
<< "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >>
|
||||
<< "vocab:cpu/x86/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -7,5 +7,5 @@ IN: bootstrap.x86
|
|||
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
|
||||
: arg ( -- reg ) RDI ;
|
||||
|
||||
<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
||||
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -7,5 +7,5 @@ IN: bootstrap.x86
|
|||
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
|
||||
: arg ( -- reg ) RCX ;
|
||||
|
||||
<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
||||
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
|
||||
call
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: slots arrays definitions generic hashtables summary io
|
||||
kernel math namespaces make prettyprint prettyprint.config
|
||||
|
|
@ -9,7 +9,7 @@ combinators generic.math classes.builtin classes compiler.units
|
|||
generic.standard vocabs init kernel.private io.encodings
|
||||
accessors math.order destructors source-files parser
|
||||
classes.tuple.parser effects.parser lexer compiler.errors
|
||||
generic.parser strings.parser vocabs.parser ;
|
||||
generic.parser strings.parser vocabs.loader vocabs.parser ;
|
||||
IN: debugger
|
||||
|
||||
GENERIC: error. ( error -- )
|
||||
|
|
@ -323,3 +323,5 @@ M: bad-escape summary drop "Bad escape code" ;
|
|||
M: bad-literal-tuple summary drop "Bad literal tuple" ;
|
||||
|
||||
M: check-mixin-class summary drop "Not a mixin class" ;
|
||||
|
||||
M: not-found-in-roots summary drop "Cannot resolve vocab: path" ;
|
||||
|
|
|
|||
|
|
@ -54,7 +54,7 @@ M: f topic>filename* drop \ f topic>filename* ;
|
|||
M: topic url-of topic>filename ;
|
||||
|
||||
: help-stylesheet ( -- string )
|
||||
"resource:basis/help/html/stylesheet.css" ascii file-contents
|
||||
"vocab:help/html/stylesheet.css" ascii file-contents
|
||||
[XML <style><-></style> XML] ;
|
||||
|
||||
: help>html ( topic -- xml )
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ IN: html.templates.chloe.tests
|
|||
"?>" split1 nip ; inline
|
||||
|
||||
: test-template ( name -- template )
|
||||
"resource:basis/html/templates/chloe/test/"
|
||||
"vocab:html/templates/chloe/test/"
|
||||
prepend <chloe> ;
|
||||
|
||||
[ "Hello world" ] [
|
||||
|
|
|
|||
|
|
@ -107,7 +107,7 @@ TUPLE: cached-template path last-modified quot ;
|
|||
path>> ".xml" append
|
||||
[ ]
|
||||
[ file-info modified>> ]
|
||||
[ utf8 <file-reader> read-xml compile-template ] tri
|
||||
[ file>xml compile-template ] tri
|
||||
\ cached-template boa ;
|
||||
|
||||
\ load-template DEBUG add-input-logging
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ tools.test sequences parser splitting prettyprint ;
|
|||
IN: html.templates.fhtml.tests
|
||||
|
||||
: test-template ( path -- ? )
|
||||
"resource:basis/html/templates/fhtml/test/"
|
||||
"vocab:html/templates/fhtml/test/"
|
||||
prepend
|
||||
[ ".fhtml" append <fhtml> [ call-template ] with-string-writer ]
|
||||
[ ".html" append utf8 file-contents ] bi
|
||||
|
|
|
|||
|
|
@ -213,7 +213,7 @@ test-db [
|
|||
<dispatcher>
|
||||
add-quit-action
|
||||
<dispatcher>
|
||||
"resource:basis/http/test" <static> >>default
|
||||
"vocab:http/test" <static> >>default
|
||||
"nested" add-responder
|
||||
<action>
|
||||
[ URL" redirect-loop" <temporary-redirect> ] >>display
|
||||
|
|
@ -226,7 +226,7 @@ test-db [
|
|||
>url clone "port" get >>port ;
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/http/test/foo.html" ascii file-contents
|
||||
"vocab:http/test/foo.html" ascii file-contents
|
||||
"http://localhost/nested/foo.html" add-port http-get nip =
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -3,16 +3,16 @@ io.files io.files.unique kernel tools.test ;
|
|||
IN: images.bitmap.tests
|
||||
|
||||
: test-bitmap24 ( -- path )
|
||||
"resource:basis/images/test-images/thiswayup24.bmp" ;
|
||||
"vocab:images/test-images/thiswayup24.bmp" ;
|
||||
|
||||
: test-bitmap8 ( -- path )
|
||||
"resource:basis/images/test-images/rgb8bit.bmp" ;
|
||||
"vocab:images/test-images/rgb8bit.bmp" ;
|
||||
|
||||
: test-bitmap4 ( -- path )
|
||||
"resource:basis/images/test-images/rgb4bit.bmp" ;
|
||||
"vocab:images/test-images/rgb4bit.bmp" ;
|
||||
|
||||
: test-bitmap1 ( -- path )
|
||||
"resource:basis/images/test-images/1bit.bmp" ;
|
||||
"vocab:images/test-images/1bit.bmp" ;
|
||||
|
||||
[ t ]
|
||||
[
|
||||
|
|
|
|||
|
|
@ -27,16 +27,8 @@ M: unix make-directory ( path -- )
|
|||
M: unix delete-directory ( path -- )
|
||||
normalize-path rmdir io-error ;
|
||||
|
||||
: (copy-file) ( from to -- )
|
||||
dup parent-directory make-directories
|
||||
binary <file-writer> [
|
||||
swap binary <file-reader> [
|
||||
swap stream-copy
|
||||
] with-disposal
|
||||
] with-disposal ;
|
||||
|
||||
M: unix copy-file ( from to -- )
|
||||
[ normalize-path ] bi@ (copy-file) ;
|
||||
[ normalize-path ] bi@ call-next-method ;
|
||||
|
||||
: with-unix-directory ( path quot -- )
|
||||
[ opendir dup [ (io-error) ] unless ] dip
|
||||
|
|
|
|||
|
|
@ -33,8 +33,8 @@ IN: io.encodings.8-bit
|
|||
} ;
|
||||
|
||||
: encoding-file ( file-name -- stream )
|
||||
"resource:basis/io/encodings/8-bit/" swap ".TXT"
|
||||
3append ascii <file-reader> ;
|
||||
"vocab:io/encodings/8-bit/" swap ".TXT"
|
||||
3append ;
|
||||
|
||||
: process-contents ( lines -- assoc )
|
||||
[ "#" split1 drop ] map harvest
|
||||
|
|
@ -47,8 +47,8 @@ IN: io.encodings.8-bit
|
|||
: ch>byte ( assoc -- newassoc )
|
||||
[ swap ] assoc-map >hashtable ;
|
||||
|
||||
: parse-file ( stream -- byte>ch ch>byte )
|
||||
lines process-contents
|
||||
: parse-file ( path -- byte>ch ch>byte )
|
||||
ascii file-lines process-contents
|
||||
[ byte>ch ] [ ch>byte ] bi ;
|
||||
|
||||
SYMBOL: 8-bit-encodings
|
||||
|
|
|
|||
|
|
@ -80,7 +80,7 @@ VALUE: gb>u
|
|||
VALUE: u>gb
|
||||
VALUE: mapping
|
||||
|
||||
"resource:basis/io/encodings/chinese/gb-18030-2000.xml"
|
||||
"vocab:io/encodings/chinese/gb-18030-2000.xml"
|
||||
ascii <file-reader> xml>gb-data
|
||||
[ ranges-u>gb to: u>gb ] [ ranges-gb>u to: gb>u ] bi
|
||||
>biassoc to: mapping
|
||||
|
|
|
|||
|
|
@ -21,14 +21,14 @@ ERROR: missing-name encoding ;
|
|||
dup e>n-table get-global at [ ] [ missing-name ] ?if ;
|
||||
|
||||
<PRIVATE
|
||||
: parse-iana ( stream -- synonym-set )
|
||||
lines { "" } split [
|
||||
: parse-iana ( file -- synonym-set )
|
||||
utf8 file-lines { "" } split [
|
||||
[ " " split ] map
|
||||
[ first { "Name:" "Alias:" } member? ] filter
|
||||
[ second ] map { "None" } diff
|
||||
] map harvest ;
|
||||
|
||||
: make-aliases ( stream -- n>e )
|
||||
: make-aliases ( file -- n>e )
|
||||
parse-iana [ [ first ] [ ] bi ] H{ } map>assoc ;
|
||||
|
||||
: initial-n>e ( -- assoc )
|
||||
|
|
@ -44,8 +44,8 @@ ERROR: missing-name encoding ;
|
|||
|
||||
PRIVATE>
|
||||
|
||||
"resource:basis/io/encodings/iana/character-sets"
|
||||
utf8 <file-reader> make-aliases aliases set-global
|
||||
"vocab:io/encodings/iana/character-sets"
|
||||
make-aliases aliases set-global
|
||||
|
||||
n>e-table [ initial-n>e ] initialize
|
||||
e>n-table [ initial-e>n ] initialize
|
||||
|
|
|
|||
|
|
@ -44,10 +44,10 @@ TUPLE: jis assoc ;
|
|||
: make-jis ( filename -- jis )
|
||||
ascii file-lines process-jis <jis> ;
|
||||
|
||||
"resource:basis/io/encodings/japanese/CP932.txt"
|
||||
"vocab:io/encodings/japanese/CP932.txt"
|
||||
make-jis to: windows-31j-table
|
||||
|
||||
"resource:basis/io/encodings/japanese/sjis-0208-1997-std.txt"
|
||||
"vocab:io/encodings/japanese/sjis-0208-1997-std.txt"
|
||||
make-jis to: shift-jis-table
|
||||
|
||||
: small? ( char -- ? )
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Yun, Jonghyouk
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,46 @@
|
|||
! Copyright (C) 2009 Yun, Jonghyouk.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays byte-arrays io io.encodings io.encodings.korean
|
||||
io.encodings.korean.private io.encodings.string io.streams.string
|
||||
kernel locals multiline namespaces sequences strings tools.test ;
|
||||
IN: io.encodings.korean.tests
|
||||
|
||||
! convert cp949 <> unicode
|
||||
|
||||
[ f ] [ HEX: 80 cp949>unicode ] unit-test
|
||||
[ f ] [ HEX: ff cp949>unicode ] unit-test
|
||||
[ HEX: ac02 ] [ HEX: 8141 cp949>unicode ] unit-test
|
||||
[ HEX: 7f ] [ HEX: 7f cp949>unicode ] unit-test
|
||||
[ HEX: c724 ] [ HEX: c0b1 cp949>unicode ] unit-test
|
||||
|
||||
[ HEX: 8141 ] [ HEX: ac02 unicode>cp949 ] unit-test
|
||||
[ HEX: 7f ] [ HEX: 7f unicode>cp949 ] unit-test
|
||||
[ HEX: c0b1 ] [ HEX: c724 unicode>cp949 ] unit-test
|
||||
|
||||
: phrase-unicode ( -- s )
|
||||
"\u00b3d9\u00d574\u00bb3c\u00acfc \u00bc31\u00b450\u00c0b0\u00c774!" ;
|
||||
|
||||
: phrase-cp949 ( -- s )
|
||||
{
|
||||
HEX: b5 HEX: bf HEX: c7 HEX: d8
|
||||
HEX: b9 HEX: b0 HEX: b0 HEX: fa
|
||||
HEX: 20 HEX: b9 HEX: e9 HEX: b5
|
||||
HEX: ce HEX: bb HEX: ea HEX: c0
|
||||
HEX: cc HEX: 21
|
||||
} ;
|
||||
|
||||
: phrase-unicode>cp949 ( -- s )
|
||||
phrase-unicode cp949 encode ;
|
||||
|
||||
: phrase-cp949>unicode ( -- s )
|
||||
phrase-cp949 cp949 decode ;
|
||||
|
||||
[ t ] [ phrase-unicode>cp949 >array phrase-cp949 = ] unit-test
|
||||
|
||||
[ t ] [ phrase-cp949>unicode phrase-unicode = ] unit-test
|
||||
|
||||
[ t ] [ phrase-cp949 1 head* cp949 decode phrase-unicode 1 head* = ] unit-test
|
||||
|
||||
[ t ] [ phrase-cp949 3 head* cp949 decode phrase-unicode 2 head* = ] unit-test
|
||||
|
||||
[ t ] [ phrase-cp949 2 head* cp949 decode phrase-unicode 2 head* CHAR: replacement-character suffix = ] unit-test
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
! Copyright (C) 2009 Yun, Jonghyouk.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: assocs byte-arrays combinators io io.encodings
|
||||
io.encodings.ascii io.encodings.iana io.files kernel locals math
|
||||
math.order math.parser memoize multiline sequences splitting
|
||||
values hashtables io.binary ;
|
||||
IN: io.encodings.korean
|
||||
|
||||
SINGLETON: cp949
|
||||
|
||||
cp949 "EUC-KR" register-encoding
|
||||
|
||||
<PRIVATE
|
||||
|
||||
! parse cp949.txt > table
|
||||
|
||||
: cp949.txt-lines ( -- seq )
|
||||
! "cp949.txt" from ...
|
||||
! <http://unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP949.TXT>
|
||||
"vocab:io/encodings/korean/data/cp949.txt"
|
||||
ascii file-lines ;
|
||||
|
||||
: drop-comments ( seq -- newseq )
|
||||
[ "#" split1 drop ] map harvest ;
|
||||
|
||||
: split-column ( line -- columns )
|
||||
"\t" split 2 head ;
|
||||
|
||||
: parse-hex ( s -- n )
|
||||
2 short tail hex> ;
|
||||
|
||||
: parse-line ( line -- code-unicode )
|
||||
split-column [ parse-hex ] map ;
|
||||
|
||||
: process-codetable-lines ( lines -- assoc )
|
||||
drop-comments [ parse-line ] map ;
|
||||
|
||||
! convert cp949 <> unicode
|
||||
|
||||
MEMO: cp949>unicode-table ( -- hashtable )
|
||||
cp949.txt-lines process-codetable-lines >hashtable ;
|
||||
|
||||
MEMO: unicode>cp949-table ( -- hashtable )
|
||||
cp949>unicode-table [ swap ] assoc-map ;
|
||||
|
||||
unicode>cp949-table drop
|
||||
|
||||
: cp949>unicode ( b -- u )
|
||||
cp949>unicode-table at ;
|
||||
|
||||
: unicode>cp949 ( u -- b )
|
||||
unicode>cp949-table at ;
|
||||
|
||||
: cp949-1st? ( n -- ? )
|
||||
dup [ HEX: 81 HEX: fe between? ] when ;
|
||||
|
||||
: byte? ( n -- ? )
|
||||
0 HEX: ff between? ;
|
||||
|
||||
M:: cp949 encode-char ( char stream encoding -- )
|
||||
char unicode>cp949 byte?
|
||||
[ char 1byte-array stream stream-write ] [
|
||||
char unicode>cp949
|
||||
h>b/b swap 2byte-array
|
||||
stream stream-write
|
||||
] if ;
|
||||
|
||||
: decode-char-step2 ( c stream -- char )
|
||||
stream-read1
|
||||
[ 2byte-array be> cp949>unicode ]
|
||||
[ drop replacement-char ] if* ;
|
||||
|
||||
M:: cp949 decode-char ( stream encoding -- char/f )
|
||||
stream stream-read1
|
||||
{
|
||||
{ [ dup not ] [ drop f ] }
|
||||
{ [ dup cp949-1st? ] [ stream decode-char-step2 ] }
|
||||
[ ]
|
||||
} cond ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Korean text encodings
|
||||
|
|
@ -0,0 +1 @@
|
|||
text
|
||||
|
|
@ -5,8 +5,8 @@ USING: accessors kernel io.sockets io.sockets.secure tools.test ;
|
|||
|
||||
[ ] [
|
||||
<secure-config>
|
||||
"resource:basis/openssl/test/server.pem" >>key-file
|
||||
"resource:basis/openssl/test/dh1024.pem" >>dh-file
|
||||
"vocab:openssl/test/server.pem" >>key-file
|
||||
"vocab:openssl/test/dh1024.pem" >>dh-file
|
||||
"password" >>password
|
||||
[ ] with-secure-context
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ ephemeral-key-bits ;
|
|||
secure-config new
|
||||
SSLv23 >>method
|
||||
1024 >>ephemeral-key-bits
|
||||
"resource:basis/openssl/cacert.pem" >>ca-file
|
||||
"vocab:openssl/cacert.pem" >>ca-file
|
||||
t >>verify ;
|
||||
|
||||
TUPLE: secure-context config handle disposed ;
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ IN: io.sockets.secure.unix.debug
|
|||
|
||||
: with-test-context ( quot -- )
|
||||
<secure-config>
|
||||
"resource:basis/openssl/test/server.pem" >>key-file
|
||||
"resource:basis/openssl/test/dh1024.pem" >>dh-file
|
||||
"vocab:openssl/test/server.pem" >>key-file
|
||||
"vocab:openssl/test/dh1024.pem" >>dh-file
|
||||
"password" >>password
|
||||
swap with-secure-context ; inline
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ splitting kernel namespaces fry memoize ;
|
|||
IN: mime.types
|
||||
|
||||
MEMO: mime-db ( -- seq )
|
||||
"resource:basis/mime/types/mime.types" ascii file-lines
|
||||
"vocab:mime/types/mime.types" ascii file-lines
|
||||
[ "#" head? not ] filter [ " \t" split harvest ] map harvest ;
|
||||
|
||||
: nonstandard-mime-types ( -- assoc )
|
||||
|
|
|
|||
|
|
@ -4,17 +4,17 @@ openssl namespaces accessors tools.test continuations kernel ;
|
|||
openssl secure-socket-backend [
|
||||
[ ] [
|
||||
<secure-config>
|
||||
"resource:basis/openssl/test/server.pem" >>key-file
|
||||
"resource:basis/openssl/test/root.pem" >>ca-file
|
||||
"resource:basis/openssl/test/dh1024.pem" >>dh-file
|
||||
"vocab:openssl/test/server.pem" >>key-file
|
||||
"vocab:openssl/test/root.pem" >>ca-file
|
||||
"vocab:openssl/test/dh1024.pem" >>dh-file
|
||||
"password" >>password
|
||||
[ ] with-secure-context
|
||||
] unit-test
|
||||
|
||||
[
|
||||
<secure-config>
|
||||
"resource:basis/openssl/test/server.pem" >>key-file
|
||||
"resource:basis/openssl/test/root.pem" >>ca-file
|
||||
"vocab:openssl/test/server.pem" >>key-file
|
||||
"vocab:openssl/test/root.pem" >>ca-file
|
||||
"wrong password" >>password
|
||||
[ ] with-secure-context
|
||||
] must-fail
|
||||
|
|
|
|||
|
|
@ -57,8 +57,8 @@ io.files io.encodings.utf8 ;
|
|||
[ "mate" ] [ "mate" step5 "" like ] unit-test
|
||||
|
||||
[ { } ] [
|
||||
"resource:basis/porter-stemmer/test/voc.txt" utf8 file-lines
|
||||
"vocab:porter-stemmer/test/voc.txt" utf8 file-lines
|
||||
[ stem ] map
|
||||
"resource:basis/porter-stemmer/test/output.txt" utf8 file-lines
|
||||
"vocab:porter-stemmer/test/output.txt" utf8 file-lines
|
||||
[ 2array ] 2map [ first2 = not ] filter
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ IN: syndication.tests
|
|||
f
|
||||
}
|
||||
}
|
||||
} ] [ "resource:basis/syndication/test/rss1.xml" load-news-file ] unit-test
|
||||
} ] [ "vocab:syndication/test/rss1.xml" load-news-file ] unit-test
|
||||
[ T{
|
||||
feed
|
||||
f
|
||||
|
|
@ -42,5 +42,5 @@ IN: syndication.tests
|
|||
T{ timestamp f 2003 12 13 8 29 29 T{ duration f 0 0 0 -4 0 0 } }
|
||||
}
|
||||
}
|
||||
} ] [ "resource:basis/syndication/test/atom.xml" load-news-file ] unit-test
|
||||
[ ] [ "resource:basis/syndication/test/atom.xml" load-news-file feed>xml xml>string drop ] unit-test
|
||||
} ] [ "vocab:syndication/test/atom.xml" load-news-file ] unit-test
|
||||
[ ] [ "vocab:syndication/test/atom.xml" load-news-file feed>xml xml>string drop ] unit-test
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ GENERIC: foo
|
|||
|
||||
M: integer foo + ;
|
||||
|
||||
"resource:basis/tools/crossref/test/foo.factor" run-file
|
||||
"vocab:tools/crossref/test/foo.factor" run-file
|
||||
|
||||
[ t ] [ integer \ foo method \ + usage member? ] unit-test
|
||||
[ t ] [ \ foo usage [ pathname? ] any? ] unit-test
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@ M: quit-responder call-responder*
|
|||
[ ] [
|
||||
<dispatcher>
|
||||
add-quot-responder
|
||||
"resource:basis/http/test" <static> >>default
|
||||
"vocab:http/test" <static> >>default
|
||||
|
||||
test-httpd
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -42,21 +42,21 @@ IN: tools.deploy.shaker
|
|||
: strip-debugger ( -- )
|
||||
strip-debugger? "debugger" vocab and [
|
||||
"Stripping debugger" show
|
||||
"resource:basis/tools/deploy/shaker/strip-debugger.factor"
|
||||
"vocab:tools/deploy/shaker/strip-debugger.factor"
|
||||
run-file
|
||||
] when ;
|
||||
|
||||
: strip-libc ( -- )
|
||||
"libc" vocab [
|
||||
"Stripping manual memory management debug code" show
|
||||
"resource:basis/tools/deploy/shaker/strip-libc.factor"
|
||||
"vocab:tools/deploy/shaker/strip-libc.factor"
|
||||
run-file
|
||||
] when ;
|
||||
|
||||
: strip-cocoa ( -- )
|
||||
"cocoa" vocab [
|
||||
"Stripping unused Cocoa methods" show
|
||||
"resource:basis/tools/deploy/shaker/strip-cocoa.factor"
|
||||
"vocab:tools/deploy/shaker/strip-cocoa.factor"
|
||||
run-file
|
||||
] when ;
|
||||
|
||||
|
|
@ -380,7 +380,7 @@ SYMBOL: deploy-vocab
|
|||
dup next-method-quot "next-method-quot" set-word-prop
|
||||
] assoc-each
|
||||
] each
|
||||
"resource:basis/tools/deploy/shaker/next-methods.factor" run-file ;
|
||||
"vocab:tools/deploy/shaker/next-methods.factor" run-file ;
|
||||
|
||||
: strip ( -- )
|
||||
init-stripper
|
||||
|
|
|
|||
|
|
@ -241,6 +241,12 @@ M: vocab-link summary vocab-summary ;
|
|||
swap [ "." glue ] with map
|
||||
] unless-empty ;
|
||||
|
||||
: vocab-dir? ( root name -- ? )
|
||||
over
|
||||
[ ".factor" vocab-dir+ append-path exists? ]
|
||||
[ 2drop f ]
|
||||
if ;
|
||||
|
||||
: vocabs-in-dir ( root name -- )
|
||||
dupd (all-child-vocabs) [
|
||||
2dup vocab-dir? [ dup >vocab-link , ] when
|
||||
|
|
|
|||
|
|
@ -10,10 +10,10 @@ IN: unicode.breaks.tests
|
|||
dup last-grapheme head last-grapheme ] unit-test
|
||||
|
||||
: grapheme-break-test ( -- filename )
|
||||
"resource:basis/unicode/breaks/GraphemeBreakTest.txt" ;
|
||||
"vocab:unicode/breaks/GraphemeBreakTest.txt" ;
|
||||
|
||||
: word-break-test ( -- filename )
|
||||
"resource:basis/unicode/breaks/WordBreakTest.txt" ;
|
||||
"vocab:unicode/breaks/WordBreakTest.txt" ;
|
||||
|
||||
: parse-test-file ( file-name -- tests )
|
||||
utf8 file-lines
|
||||
|
|
|
|||
|
|
@ -127,7 +127,7 @@ to: grapheme-table
|
|||
|
||||
VALUE: word-break-table
|
||||
|
||||
"resource:basis/unicode/data/WordBreakProperty.txt" load-script
|
||||
"vocab:unicode/data/WordBreakProperty.txt" load-script
|
||||
to: word-break-table
|
||||
|
||||
C-ENUM: wOther wCR wLF wNewline wExtend wFormat wKatakana wALetter wMidLetter
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ tools.test assocs words ;
|
|||
IN: unicode.collation.tests
|
||||
|
||||
: parse-test ( -- strings )
|
||||
"resource:basis/unicode/collation/CollationTest_SHIFTED.txt"
|
||||
"vocab:unicode/collation/CollationTest_SHIFTED.txt"
|
||||
utf8 file-lines 5 tail
|
||||
[ ";" split1 drop " " split [ hex> ] "" map-as ] map ;
|
||||
|
||||
|
|
|
|||
|
|
@ -24,12 +24,11 @@ TUPLE: weight primary secondary tertiary ignorable? ;
|
|||
";" split1 [ [ blank? ] trim ] bi@
|
||||
[ " " split [ hex> ] "" map-as ] [ parse-weight ] bi* ;
|
||||
|
||||
: parse-ducet ( stream -- ducet )
|
||||
lines filter-comments
|
||||
: parse-ducet ( file -- ducet )
|
||||
ascii file-lines filter-comments
|
||||
[ parse-line ] H{ } map>assoc ;
|
||||
|
||||
"resource:basis/unicode/collation/allkeys.txt"
|
||||
ascii <file-reader> parse-ducet to: ducet
|
||||
"vocab:unicode/collation/allkeys.txt" parse-ducet to: ducet
|
||||
|
||||
! Fix up table for long contractions
|
||||
: help-one ( assoc key -- )
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ VALUE: properties
|
|||
ascii file-lines [ split-; ] map ;
|
||||
|
||||
: load-data ( -- data )
|
||||
"resource:basis/unicode/data/UnicodeData.txt" data ;
|
||||
"vocab:unicode/data/UnicodeData.txt" data ;
|
||||
|
||||
: filter-comments ( lines -- lines )
|
||||
[ "#@" split first ] map harvest ;
|
||||
|
|
@ -68,7 +68,7 @@ VALUE: properties
|
|||
[ " " split [ hex> ] map ] assoc-map ;
|
||||
|
||||
: exclusions-file ( -- filename )
|
||||
"resource:basis/unicode/data/CompositionExclusions.txt" ;
|
||||
"vocab:unicode/data/CompositionExclusions.txt" ;
|
||||
|
||||
: exclusions ( -- set )
|
||||
exclusions-file utf8 file-lines
|
||||
|
|
@ -147,7 +147,7 @@ C: <code-point> code-point
|
|||
|
||||
! Extra properties
|
||||
: properties-lines ( -- lines )
|
||||
"resource:basis/unicode/data/PropList.txt"
|
||||
"vocab:unicode/data/PropList.txt"
|
||||
ascii file-lines ;
|
||||
|
||||
: parse-properties ( -- {{[a,b],prop}} )
|
||||
|
|
@ -166,7 +166,7 @@ C: <code-point> code-point
|
|||
|
||||
! Special casing data
|
||||
: load-special-casing ( -- special-casing )
|
||||
"resource:basis/unicode/data/SpecialCasing.txt" data
|
||||
"vocab:unicode/data/SpecialCasing.txt" data
|
||||
[ length 5 = ] filter
|
||||
[ [ set-code-point ] each ] H{ } make-assoc ;
|
||||
|
||||
|
|
@ -196,9 +196,9 @@ load-properties to: properties
|
|||
|
||||
SYMBOL: interned
|
||||
|
||||
: parse-script ( stream -- assoc )
|
||||
: parse-script ( filename -- assoc )
|
||||
! assoc is code point/range => name
|
||||
lines filter-comments [ split-; ] map ;
|
||||
ascii file-lines filter-comments [ split-; ] map ;
|
||||
|
||||
: range, ( value key -- )
|
||||
swap interned get
|
||||
|
|
@ -218,7 +218,7 @@ SYMBOL: interned
|
|||
[ expand-ranges ] with-variable ;
|
||||
|
||||
: load-script ( filename -- table )
|
||||
ascii <file-reader> parse-script process-script ;
|
||||
parse-script process-script ;
|
||||
|
||||
[ name>char [ "Invalid character" throw ] unless* ]
|
||||
name>char-hook set-global
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ IN: unicode.normalize.tests
|
|||
[ "\u00d55c" ] [ "\u001112\u001161\u0011ab" nfc ] unit-test
|
||||
|
||||
: parse-test ( -- tests )
|
||||
"resource:basis/unicode/normalize/NormalizationTest.txt"
|
||||
"vocab:unicode/normalize/NormalizationTest.txt"
|
||||
utf8 file-lines filter-comments
|
||||
[ ";" split 5 head [ " " split [ hex> ] "" map-as ] map ] map ;
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ IN: unicode.script
|
|||
|
||||
VALUE: script-table
|
||||
|
||||
"resource:basis/unicode/script/Scripts.txt" load-script
|
||||
"vocab:unicode/script/Scripts.txt" load-script
|
||||
to: script-table
|
||||
|
||||
: script-of ( char -- script )
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ VALUE: html-entities
|
|||
|
||||
: get-html ( -- table )
|
||||
{ "lat1" "special" "symbol" } [
|
||||
"resource:basis/xml/entities/html/xhtml-"
|
||||
"vocab:xml/entities/html/xhtml-"
|
||||
swap ".ent" 3append read-entities-file
|
||||
] map first3 assoc-union assoc-union ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,15 +1,15 @@
|
|||
USING: xml xml.data xml.traversal tools.test accessors kernel
|
||||
io.encodings.8-bit ;
|
||||
|
||||
[ "\u000131" ] [ "resource:basis/xml/tests/latin5.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/latin1.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/spaces.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf8.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16be.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16le.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16be-bom.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/utf16le-bom.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "resource:basis/xml/tests/prologless.xml" file>xml children>string ] unit-test
|
||||
[ "e" ] [ "resource:basis/xml/tests/ascii.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" "x" ] [ "resource:basis/xml/tests/unitag.xml" file>xml [ name>> main>> ] [ children>string ] bi ] unit-test
|
||||
[ "\u000131" ] [ "vocab:xml/tests/latin5.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/latin1.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/spaces.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/utf8.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/utf16.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/utf16be.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/utf16le.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/utf16be-bom.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/utf16le-bom.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" ] [ "vocab:xml/tests/prologless.xml" file>xml children>string ] unit-test
|
||||
[ "e" ] [ "vocab:xml/tests/ascii.xml" file>xml children>string ] unit-test
|
||||
[ "\u0000e9" "x" ] [ "vocab:xml/tests/unitag.xml" file>xml [ name>> main>> ] [ children>string ] bi ] unit-test
|
||||
|
|
|
|||
|
|
@ -4,6 +4,6 @@ IN: xml.tests
|
|||
USING: xml xml.writer io.files io.encodings.utf8 tools.test kernel ;
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/xml/tests/funny-dtd.xml" utf8 file-contents string>xml
|
||||
"vocab:xml/tests/funny-dtd.xml" utf8 file-contents string>xml
|
||||
dup xml>string string>xml =
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -10,6 +10,6 @@ IN: xml.tests
|
|||
[ assemble-data ] map ;
|
||||
|
||||
[ "http://www.foxnews.com/oreilly/" ] [
|
||||
"resource:basis/xml/tests/soap.xml" file>xml
|
||||
"vocab:xml/tests/soap.xml" file>xml
|
||||
parse-result first first
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -13,11 +13,11 @@ sequences.deep accessors io.streams.string ;
|
|||
|
||||
SYMBOL: xml-file
|
||||
[ ] [
|
||||
"resource:basis/xml/tests/test.xml"
|
||||
"vocab:xml/tests/test.xml"
|
||||
[ file>xml ] with-html-entities xml-file set
|
||||
] unit-test
|
||||
[ t ] [
|
||||
"resource:basis/xml/tests/test.xml" binary file-contents
|
||||
"vocab:xml/tests/test.xml" binary file-contents
|
||||
[ bytes>xml ] with-html-entities xml-file get =
|
||||
] unit-test
|
||||
[ "1.0" ] [ xml-file get prolog>> version>> ] unit-test
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ TUPLE: xml-test id uri sections description type ;
|
|||
: parse-tests ( xml -- tests )
|
||||
"TEST" tags-named [ >xml-test ] map ;
|
||||
|
||||
: base "resource:basis/xml/tests/xmltest/" ;
|
||||
: base "vocab:xml/tests/xmltest/" ;
|
||||
|
||||
MACRO: drop-output ( quot -- newquot )
|
||||
dup infer out>> '[ @ _ ndrop ] ;
|
||||
|
|
|
|||
|
|
@ -4,5 +4,5 @@ USING: xml xml.data kernel tools.test ;
|
|||
IN: xml.tests
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/xmode/xmode.dtd" file>dtd dtd?
|
||||
"vocab:xmode/xmode.dtd" file>dtd dtd?
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ TAGS>
|
|||
] keep ;
|
||||
|
||||
MEMO: modes ( -- modes )
|
||||
"resource:basis/xmode/modes/catalog"
|
||||
"vocab:xmode/modes/catalog"
|
||||
file>xml parse-modes-tag ;
|
||||
|
||||
MEMO: mode-names ( -- modes )
|
||||
|
|
@ -37,8 +37,7 @@ MEMO: mode-names ( -- modes )
|
|||
MEMO: (load-mode) ( name -- rule-sets )
|
||||
modes at [
|
||||
file>>
|
||||
"resource:basis/xmode/modes/" prepend
|
||||
utf8 <file-reader> parse-mode
|
||||
"vocab:xmode/modes/" prepend parse-mode
|
||||
] [
|
||||
"text" (load-mode)
|
||||
] if* ;
|
||||
|
|
|
|||
|
|
@ -84,5 +84,5 @@ TAGS>
|
|||
[ merge-rule-set-props ] with each
|
||||
] when* ;
|
||||
|
||||
: parse-mode ( stream -- rule-sets )
|
||||
read-xml parse-mode-tag ;
|
||||
: parse-mode ( filename -- rule-sets )
|
||||
file>xml parse-mode-tag ;
|
||||
|
|
|
|||
|
|
@ -47,6 +47,6 @@ TAGS>
|
|||
"PUBLIC"
|
||||
}
|
||||
] [
|
||||
"resource:basis/xmode/utilities/test.xml"
|
||||
"vocab:xmode/utilities/test.xml"
|
||||
file>xml parse-company-tag
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -16,9 +16,9 @@ crossref off
|
|||
|
||||
H{ } clone sub-primitives set
|
||||
|
||||
"resource:core/bootstrap/syntax.factor" parse-file
|
||||
"vocab:bootstrap/syntax.factor" parse-file
|
||||
|
||||
"resource:basis/cpu/" architecture get {
|
||||
"vocab:cpu/" architecture get {
|
||||
{ "x86.32" "x86/32" }
|
||||
{ "winnt-x86.64" "x86/64/winnt" }
|
||||
{ "unix-x86.64" "x86/64/unix" }
|
||||
|
|
@ -27,7 +27,7 @@ H{ } clone sub-primitives set
|
|||
{ "arm" "arm" }
|
||||
} at "/bootstrap.factor" 3append parse-file
|
||||
|
||||
"resource:core/bootstrap/layouts/layouts.factor" parse-file
|
||||
"vocab:bootstrap/layouts/layouts.factor" parse-file
|
||||
|
||||
! Now we have ( syntax-quot arch-quot layouts-quot ) on the stack
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ IN: bootstrap.stage1
|
|||
|
||||
"Bootstrap stage 1..." print flush
|
||||
|
||||
"resource:core/bootstrap/primitives.factor" run-file
|
||||
"vocab:bootstrap/primitives.factor" run-file
|
||||
|
||||
load-help? off
|
||||
{ "resource:core" } vocab-roots set
|
||||
|
|
@ -40,7 +40,7 @@ load-help? off
|
|||
"bootstrap.layouts" require
|
||||
|
||||
[
|
||||
"resource:basis/bootstrap/stage2.factor"
|
||||
"vocab:bootstrap/stage2.factor"
|
||||
dup exists? [
|
||||
run-file
|
||||
] [
|
||||
|
|
|
|||
|
|
@ -4,34 +4,34 @@ namespaces accessors io.encodings ;
|
|||
IN: io.streams.encodings.tests
|
||||
|
||||
[ { } ]
|
||||
[ "resource:core/io/test/empty-file.txt" ascii <file-reader> lines ]
|
||||
[ "vocab:io/test/empty-file.txt" ascii file-lines ]
|
||||
unit-test
|
||||
|
||||
: lines-test ( stream -- line1 line2 )
|
||||
[ readln readln ] with-input-stream ;
|
||||
: lines-test ( file encoding -- line1 line2 )
|
||||
[ readln readln ] with-file-reader ;
|
||||
|
||||
[
|
||||
"This is a line."
|
||||
"This is another line."
|
||||
] [
|
||||
"resource:core/io/test/windows-eol.txt"
|
||||
ascii <file-reader> lines-test
|
||||
"vocab:io/test/windows-eol.txt"
|
||||
ascii lines-test
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"This is a line."
|
||||
"This is another line."
|
||||
] [
|
||||
"resource:core/io/test/mac-os-eol.txt"
|
||||
ascii <file-reader> lines-test
|
||||
"vocab:io/test/mac-os-eol.txt"
|
||||
ascii lines-test
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"This is a line."
|
||||
"This is another line."
|
||||
] [
|
||||
"resource:core/io/test/unix-eol.txt"
|
||||
ascii <file-reader> lines-test
|
||||
"vocab:io/test/unix-eol.txt"
|
||||
ascii lines-test
|
||||
] unit-test
|
||||
|
||||
[
|
||||
|
|
|
|||
|
|
@ -14,15 +14,15 @@ IN: io.files.tests
|
|||
[
|
||||
"This is a line.\rThis is another line.\r"
|
||||
] [
|
||||
"resource:core/io/test/mac-os-eol.txt" latin1 <file-reader>
|
||||
[ 500 read ] with-input-stream
|
||||
"vocab:io/test/mac-os-eol.txt" latin1
|
||||
[ 500 read ] with-file-reader
|
||||
] unit-test
|
||||
|
||||
[
|
||||
255
|
||||
] [
|
||||
"resource:core/io/test/binary.txt" latin1 <file-reader>
|
||||
[ read1 ] with-input-stream >fixnum
|
||||
"vocab:io/test/binary.txt" latin1
|
||||
[ read1 ] with-file-reader >fixnum
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
|
|
@ -39,11 +39,11 @@ IN: io.files.tests
|
|||
] [
|
||||
[
|
||||
"separator-test.txt" temp-file
|
||||
latin1 <file-reader> [
|
||||
latin1 [
|
||||
"J" read-until 2array ,
|
||||
"i" read-until 2array ,
|
||||
"X" read-until 2array ,
|
||||
] with-input-stream
|
||||
] with-file-reader
|
||||
] { } make
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: io parser tools.test words ;
|
|||
IN: io.tests
|
||||
|
||||
[ f ] [
|
||||
"resource:core/io/test/no-trailing-eol.factor" run-file
|
||||
"vocab:io/test/no-trailing-eol.factor" run-file
|
||||
"foo" "io.tests" lookup
|
||||
] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov, Doug Coleman.
|
||||
! Copyright (C) 2004, 2009 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators io.backend kernel math math.order
|
||||
namespaces sequences splitting strings system ;
|
||||
|
|
@ -71,10 +71,17 @@ PRIVATE>
|
|||
[ f ]
|
||||
} cond ;
|
||||
|
||||
: special-path? ( path -- rest ? )
|
||||
{
|
||||
{ [ "resource:" ?head ] [ t ] }
|
||||
{ [ "vocab:" ?head ] [ t ] }
|
||||
[ f ]
|
||||
} cond ;
|
||||
|
||||
: absolute-path? ( path -- ? )
|
||||
{
|
||||
{ [ dup empty? ] [ f ] }
|
||||
{ [ dup "resource:" head? ] [ t ] }
|
||||
{ [ dup special-path? nip ] [ t ] }
|
||||
{ [ os windows? ] [ windows-absolute-path? ] }
|
||||
{ [ dup first path-separator? ] [ t ] }
|
||||
[ f ]
|
||||
|
|
@ -107,7 +114,7 @@ PRIVATE>
|
|||
dup root-directory? [
|
||||
trim-tail-separators
|
||||
dup last-path-separator [ 1+ tail ] [
|
||||
drop "resource:" ?head [ file-name ] when
|
||||
drop special-path? [ file-name ] when
|
||||
] if
|
||||
] unless ;
|
||||
|
||||
|
|
@ -117,6 +124,8 @@ PRIVATE>
|
|||
: resource-path ( path -- newpath )
|
||||
"resource-path" get prepend-path ;
|
||||
|
||||
GENERIC: vocab-path ( path -- newpath )
|
||||
|
||||
GENERIC: (normalize-path) ( path -- path' )
|
||||
|
||||
M: string (normalize-path)
|
||||
|
|
@ -124,7 +133,12 @@ M: string (normalize-path)
|
|||
trim-head-separators resource-path
|
||||
(normalize-path)
|
||||
] [
|
||||
current-directory get prepend-path
|
||||
"vocab:" ?head [
|
||||
trim-head-separators vocab-path
|
||||
(normalize-path)
|
||||
] [
|
||||
current-directory get prepend-path
|
||||
] if
|
||||
] if ;
|
||||
|
||||
M: object normalize-path ( path -- path' )
|
||||
|
|
|
|||
|
|
@ -402,7 +402,7 @@ IN: parser.tests
|
|||
[ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
|
||||
] times
|
||||
|
||||
[ "resource:core/parser/test/assert-depth.factor" run-file ]
|
||||
[ "vocab:parser/test/assert-depth.factor" run-file ]
|
||||
[ got>> { 1 2 3 } sequence= ]
|
||||
must-fail-with
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
|
||||
! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: namespaces make sequences io io.files io.pathnames kernel
|
||||
assocs words vocabs definitions parser continuations hashtables
|
||||
|
|
@ -18,6 +18,22 @@ V{
|
|||
: add-vocab-root ( root -- )
|
||||
vocab-roots get adjoin ;
|
||||
|
||||
SYMBOL: root-cache
|
||||
|
||||
root-cache [ H{ } clone ] initialize
|
||||
|
||||
ERROR: not-found-in-roots path ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: find-root-for ( path -- path/f )
|
||||
vocab-roots get [ prepend-path exists? ] with find nip ;
|
||||
|
||||
M: string vocab-path ( string -- path/f )
|
||||
dup find-root-for [ prepend-path ] [ not-found-in-roots ] if* ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: vocab-dir ( vocab -- dir )
|
||||
vocab-name { { CHAR: . CHAR: / } } substitute ;
|
||||
|
||||
|
|
@ -26,25 +42,9 @@ V{
|
|||
[ [ dup peek ] dip append suffix ] when*
|
||||
"/" join ;
|
||||
|
||||
: vocab-dir? ( root name -- ? )
|
||||
over
|
||||
[ ".factor" vocab-dir+ append-path exists? ]
|
||||
[ 2drop f ]
|
||||
if ;
|
||||
|
||||
SYMBOL: root-cache
|
||||
|
||||
H{ } clone root-cache set-global
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: (find-vocab-root) ( name -- path/f )
|
||||
vocab-roots get swap [ vocab-dir? ] curry find nip ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: find-vocab-root ( vocab -- path/f )
|
||||
vocab-name dup root-cache get at [ ] [ (find-vocab-root) ] ?if ;
|
||||
vocab-name dup root-cache get at
|
||||
[ ] [ ".factor" vocab-dir+ find-root-for ] ?if ;
|
||||
|
||||
: vocab-append-path ( vocab path -- newpath )
|
||||
swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ;
|
||||
|
|
@ -104,14 +104,14 @@ SYMBOL: blacklist
|
|||
: add-to-blacklist ( error vocab -- )
|
||||
vocab-name blacklist get dup [ set-at ] [ 3drop ] if ;
|
||||
|
||||
GENERIC: (load-vocab) ( name -- )
|
||||
GENERIC: (load-vocab) ( name -- vocab )
|
||||
|
||||
M: vocab (load-vocab)
|
||||
[
|
||||
dup source-loaded?>> +parsing+ eq? [
|
||||
dup source-loaded?>> [ dup load-source ] unless
|
||||
dup docs-loaded?>> [ dup load-docs ] unless
|
||||
] unless drop
|
||||
] unless
|
||||
] [ [ swap add-to-blacklist ] keep rethrow ] recover ;
|
||||
|
||||
M: vocab-link (load-vocab)
|
||||
|
|
@ -120,22 +120,15 @@ M: vocab-link (load-vocab)
|
|||
M: string (load-vocab)
|
||||
create-vocab (load-vocab) ;
|
||||
|
||||
[
|
||||
[
|
||||
dup vocab-name blacklist get at* [ rethrow ] [
|
||||
drop dup find-vocab-root
|
||||
[ [ (load-vocab) ] with-compiler-errors ]
|
||||
[ dup vocab [ drop ] [ no-vocab ] if ]
|
||||
if
|
||||
] if
|
||||
] with-compiler-errors
|
||||
] load-vocab-hook set-global
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: vocab-where ( vocab -- loc )
|
||||
vocab-source-path dup [ 1 2array ] when ;
|
||||
[
|
||||
dup vocab-name blacklist get at* [ rethrow ] [
|
||||
drop dup find-vocab-root
|
||||
[ [ (load-vocab) ] with-compiler-errors ]
|
||||
[ dup vocab [ ] [ no-vocab ] ?if ]
|
||||
if
|
||||
] if
|
||||
] load-vocab-hook set-global
|
||||
|
||||
M: vocab where vocab-where ;
|
||||
|
||||
M: vocab-link where vocab-where ;
|
||||
M: vocab-spec where vocab-source-path dup [ 1 2array ] when ;
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007, 2008 Eduardo Cavazos, Slava Pestov.
|
||||
! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs strings kernel sorting namespaces
|
||||
sequences definitions ;
|
||||
|
|
@ -21,18 +21,26 @@ SYMBOL: +done+
|
|||
swap >>name
|
||||
H{ } clone >>words ;
|
||||
|
||||
TUPLE: vocab-link name ;
|
||||
|
||||
C: <vocab-link> vocab-link
|
||||
|
||||
UNION: vocab-spec vocab vocab-link ;
|
||||
|
||||
GENERIC: vocab-name ( vocab-spec -- name )
|
||||
|
||||
M: vocab vocab-name name>> ;
|
||||
|
||||
M: vocab-link vocab-name name>> ;
|
||||
|
||||
M: string vocab-name ;
|
||||
|
||||
GENERIC: vocab ( vocab-spec -- vocab )
|
||||
|
||||
M: vocab vocab ;
|
||||
|
||||
M: object vocab ( name -- vocab ) vocab-name dictionary get at ;
|
||||
|
||||
M: vocab vocab-name name>> ;
|
||||
|
||||
M: string vocab-name ;
|
||||
|
||||
GENERIC: vocab-words ( vocab-spec -- words )
|
||||
|
||||
M: vocab vocab-words words>> ;
|
||||
|
|
@ -62,11 +70,6 @@ M: f vocab-main ;
|
|||
|
||||
ERROR: no-vocab name ;
|
||||
|
||||
SYMBOL: load-vocab-hook ! ( name -- )
|
||||
|
||||
: load-vocab ( name -- vocab )
|
||||
dup load-vocab-hook get call vocab ;
|
||||
|
||||
: vocabs ( -- seq )
|
||||
dictionary get keys natural-sort ;
|
||||
|
||||
|
|
@ -88,17 +91,6 @@ SYMBOL: load-vocab-hook ! ( name -- )
|
|||
: child-vocabs ( vocab -- seq )
|
||||
vocab-name vocabs [ child-vocab? ] with filter ;
|
||||
|
||||
TUPLE: vocab-link name ;
|
||||
|
||||
: <vocab-link> ( name -- vocab-link )
|
||||
vocab-link boa ;
|
||||
|
||||
M: vocab-link hashcode* name>> hashcode* ;
|
||||
|
||||
M: vocab-link vocab-name name>> ;
|
||||
|
||||
UNION: vocab-spec vocab vocab-link ;
|
||||
|
||||
GENERIC: >vocab-link ( name -- vocab )
|
||||
|
||||
M: vocab-spec >vocab-link ;
|
||||
|
|
@ -110,3 +102,7 @@ M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
|
|||
vocab-name dictionary get delete-at ;
|
||||
|
||||
M: vocab-spec forget* forget-vocab ;
|
||||
|
||||
SYMBOL: load-vocab-hook ! ( name -- vocab )
|
||||
|
||||
: load-vocab ( name -- vocab ) load-vocab-hook get call ;
|
||||
|
|
@ -3,7 +3,7 @@ IN: benchmark.crc32
|
|||
|
||||
: crc32-file ( -- )
|
||||
10 [
|
||||
"resource:basis/mime/multipart/multipart-tests.factor"
|
||||
"vocab:mime/multipart/multipart-tests.factor"
|
||||
crc32 checksum-file drop
|
||||
] times ;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,6 +2,6 @@ USING: checksums checksums.md5 io.files kernel ;
|
|||
IN: benchmark.md5
|
||||
|
||||
: md5-file ( -- )
|
||||
"resource:basis/mime/multipart/multipart-tests.factor" md5 checksum-file drop ;
|
||||
"vocab:mime/multipart/multipart-tests.factor" md5 checksum-file drop ;
|
||||
|
||||
MAIN: md5-file
|
||||
|
|
|
|||
|
|
@ -2,6 +2,6 @@ USING: checksums checksums.sha1 io.files kernel ;
|
|||
IN: benchmark.sha1
|
||||
|
||||
: sha1-file ( -- )
|
||||
"resource:basis/mime/multipart/multipart-tests.factor" sha1 checksum-file drop ;
|
||||
"vocab:mime/multipart/multipart-tests.factor" sha1 checksum-file drop ;
|
||||
|
||||
MAIN: sha1-file
|
||||
|
|
|
|||
|
|
@ -5,8 +5,8 @@ sequences xml ;
|
|||
IN: benchmark.xml
|
||||
|
||||
: xml-benchmark ( -- )
|
||||
"resource:basis/xmode/modes/" [
|
||||
[ utf8 <file-reader> read-xml drop ] each
|
||||
"vocab:xmode/modes/" [
|
||||
[ file>xml drop ] each
|
||||
] with-directory-files ;
|
||||
|
||||
MAIN: xml-benchmark
|
||||
|
|
|
|||
|
|
@ -164,17 +164,17 @@ IN: id3.tests
|
|||
[
|
||||
T{ mp3v1-file
|
||||
{ title
|
||||
"BLAH\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
|
||||
"BLAH"
|
||||
}
|
||||
{ artist
|
||||
"ARTIST\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
|
||||
"ARTIST"
|
||||
}
|
||||
{ album
|
||||
"ALBUM\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
|
||||
"ALBUM"
|
||||
}
|
||||
{ year "2009" }
|
||||
{ comment
|
||||
"COMMENT\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
|
||||
"COMMENT"
|
||||
}
|
||||
{ genre 89 }
|
||||
}
|
||||
|
|
|
|||
|
|
@ -127,11 +127,11 @@ TUPLE: mp3v1-file title artist album year comment genre ;
|
|||
: (read-v1-tag-data) ( seq -- mp3-file )
|
||||
[ <mp3v1-file> ] dip
|
||||
{
|
||||
[ read-title ascii decode >>title ]
|
||||
[ read-artist ascii decode >>artist ]
|
||||
[ read-album ascii decode >>album ]
|
||||
[ read-year ascii decode >>year ]
|
||||
[ read-comment ascii decode >>comment ]
|
||||
[ read-title ascii decode filter-text-data >>title ]
|
||||
[ read-artist ascii decode filter-text-data >>artist ]
|
||||
[ read-album ascii decode filter-text-data >>album ]
|
||||
[ read-year ascii decode filter-text-data >>year ]
|
||||
[ read-comment ascii decode filter-text-data >>comment ]
|
||||
[ read-genre >fixnum >>genre ]
|
||||
} cleave ;
|
||||
|
||||
|
|
|
|||
|
|
@ -28,8 +28,8 @@ TUPLE: city
|
|||
first-zip name state latitude longitude gmt-offset dst-offset ;
|
||||
|
||||
MEMO: cities ( -- seq )
|
||||
"resource:extra/usa-cities/zipcode.csv" ascii <file-reader>
|
||||
csv rest-slice [
|
||||
"resource:extra/usa-cities/zipcode.csv" ascii file>csv
|
||||
rest-slice [
|
||||
[
|
||||
{
|
||||
[ string>number ]
|
||||
|
|
|
|||
|
|
@ -143,8 +143,8 @@ io.sockets.secure ;
|
|||
: <todo-secure-config> ( -- config )
|
||||
! This is only suitable for testing!
|
||||
<secure-config>
|
||||
"resource:basis/openssl/test/dh1024.pem" >>dh-file
|
||||
"resource:basis/openssl/test/server.pem" >>key-file
|
||||
"vocab:openssl/test/dh1024.pem" >>dh-file
|
||||
"vocab:openssl/test/server.pem" >>key-file
|
||||
"password" >>password ;
|
||||
|
||||
: <todo-app> ( -- responder )
|
||||
|
|
|
|||
|
|
@ -69,8 +69,8 @@ SYMBOL: dh-file
|
|||
init-factor-db ;
|
||||
|
||||
: init-testing ( -- )
|
||||
"resource:basis/openssl/test/dh1024.pem" dh-file set-global
|
||||
"resource:basis/openssl/test/server.pem" key-file set-global
|
||||
"vocab:openssl/test/dh1024.pem" dh-file set-global
|
||||
"vocab:openssl/test/server.pem" key-file set-global
|
||||
"password" key-password set-global
|
||||
common-configuration
|
||||
<factor-website>
|
||||
|
|
|
|||
Loading…
Reference in New Issue