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

use butlast, butlast-slice 

"extra/foo" resource-path -> "resource:extra/foo"
db4
Doug Coleman 2008-05-06 12:37:11 -05:00
parent 01f20cf32d
commit 7c09936f30
37 changed files with 76 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/benchmark/knucleotide/knucleotide.factor
View File

@ -56,7 +56,7 @@ IN: benchmark.knucleotide
drop ; drop ;
: knucleotide ( -- ) : knucleotide ( -- )
"extra/benchmark/knucleotide/knucleotide-input.txt" resource-path "resource:extra/benchmark/knucleotide/knucleotide-input.txt"
ascii [ read-input ] with-file-reader ascii [ read-input ] with-file-reader
process-input ; process-input ;

5
extra/combinators/lib/lib.factor
View File

@ -169,3 +169,8 @@ MACRO: multikeep ( word out-indexes -- ... )
: generate ( generator predicate -- obj ) : generate ( generator predicate -- obj )
[ dup ] swap [ dup [ nip ] unless not ] 3compose [ dup ] swap [ dup [ nip ] unless not ] 3compose
swap [ ] do-while ; swap [ ] do-while ;
MACRO: predicates ( seq -- quot/f )
dup [ 1quotation [ drop ] prepend ] map
>r [ [ dup ] prepend ] map r> zip [ drop f ] suffix
[ cond ] curry ;

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

@ -10,7 +10,7 @@ IN: help.lint
: check-example ( element -- ) : check-example ( element -- )
rest [ rest [
1 head* "\n" join 1vector butlast "\n" join 1vector
[ [
use [ clone ] change use [ clone ] change
[ eval>string ] with-datastack [ eval>string ] with-datastack

2
extra/html/parser/analyzer/analyzer.factor
View File

@ -99,7 +99,7 @@ IN: html.parser.analyzer
: find-between ( i/f tag/f vector -- vector ) : find-between ( i/f tag/f vector -- vector )
find-between* dup length 3 >= [ find-between* dup length 3 >= [
[ rest-slice 1 head-slice* ] keep like [ rest-slice butlast-slice ] keep like
] when ; ] when ;
: find-between-first ( string vector -- vector' ) : find-between-first ( string vector -- vector' )

2
extra/html/parser/utils/utils.factor
View File

@ -36,7 +36,7 @@ IN: html.parser.utils
dup quoted? [ quote ] unless ; dup quoted? [ quote ] unless ;
: unquote ( str -- newstr ) : unquote ( str -- newstr )
dup quoted? [ 1 head-slice* rest-slice >string ] when ; dup quoted? [ butlast-slice rest-slice >string ] when ;
: quote? ( ch -- ? ) "'\"" member? ; : quote? ( ch -- ? ) "'\"" member? ;

4
extra/http/http-tests.factor
View File

@ -166,7 +166,7 @@ test-db [
<dispatcher> <dispatcher>
add-quit-action add-quit-action
<dispatcher> <dispatcher>
"extra/http/test" resource-path <static> >>default "resource:extra/http/test" <static> >>default
"nested" add-responder "nested" add-responder
<action> <action>
[ "redirect-loop" f <standard-redirect> ] >>display [ "redirect-loop" f <standard-redirect> ] >>display
@ -178,7 +178,7 @@ test-db [
] unit-test ] unit-test
[ t ] [ [ t ] [
"extra/http/test/foo.html" resource-path ascii file-contents "resource:extra/http/test/foo.html" ascii file-contents
"http://localhost:1237/nested/foo.html" http-get = "http://localhost:1237/nested/foo.html" http-get =
] unit-test ] unit-test

2
extra/icfp/2006/2006.factor
View File

@ -148,4 +148,4 @@ SYMBOL: open-arrays
init f exec-loop ; init f exec-loop ;
: run-sand ( -- ) : run-sand ( -- )
"extra/icfp/2006/sandmark.umz" resource-path run-prog ; "resource:extra/icfp/2006/sandmark.umz" run-prog ;

2
extra/inverse/inverse.factor
View File

@ -197,7 +197,7 @@ DEFER: _
\ prefix [ unclip ] define-inverse \ prefix [ unclip ] define-inverse
\ unclip [ prefix ] define-inverse \ unclip [ prefix ] define-inverse
\ suffix [ dup 1 head* swap peek ] define-inverse \ suffix [ dup butlast swap peek ] define-inverse
! Constructor inverse ! Constructor inverse
: deconstruct-pred ( class -- quot ) : deconstruct-pred ( class -- quot )

5
extra/io/encodings/8-bit/8-bit.factor
View File

@ -30,9 +30,8 @@ IN: io.encodings.8-bit
} ; } ;
: encoding-file ( file-name -- stream ) : encoding-file ( file-name -- stream )
"extra/io/encodings/8-bit/" ".TXT" "resource:extra/io/encodings/8-bit/" ".TXT"
swapd 3append resource-path swapd 3append ascii <file-reader> ;
ascii <file-reader> ;
: tail-if ( seq n -- newseq ) : tail-if ( seq n -- newseq )
2dup swap length <= [ tail ] [ drop ] if ; 2dup swap length <= [ tail ] [ drop ] if ;

14
extra/io/windows/nt/launcher/launcher-tests.factor
View File

@ -41,7 +41,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test ] unit-test
[ ] [ [ ] [
"extra/io/windows/nt/launcher/test" resource-path [ "resource:extra/io/windows/nt/launcher/test" [
<process> <process>
vm "-script" "stderr.factor" 3array >>command vm "-script" "stderr.factor" 3array >>command
"out.txt" temp-file >>stdout "out.txt" temp-file >>stdout
@ -59,7 +59,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test ] unit-test
[ ] [ [ ] [
"extra/io/windows/nt/launcher/test" resource-path [ "resource:extra/io/windows/nt/launcher/test" [
<process> <process>
vm "-script" "stderr.factor" 3array >>command vm "-script" "stderr.factor" 3array >>command
"out.txt" temp-file >>stdout "out.txt" temp-file >>stdout
@ -73,7 +73,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test ] unit-test
[ "output" ] [ [ "output" ] [
"extra/io/windows/nt/launcher/test" resource-path [ "resource:extra/io/windows/nt/launcher/test" [
<process> <process>
vm "-script" "stderr.factor" 3array >>command vm "-script" "stderr.factor" 3array >>command
"err2.txt" temp-file >>stderr "err2.txt" temp-file >>stderr
@ -86,7 +86,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test ] unit-test
[ t ] [ [ t ] [
"extra/io/windows/nt/launcher/test" resource-path [ "resource:extra/io/windows/nt/launcher/test" [
<process> <process>
vm "-script" "env.factor" 3array >>command vm "-script" "env.factor" 3array >>command
ascii <process-reader> contents ascii <process-reader> contents
@ -96,7 +96,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test ] unit-test
[ t ] [ [ t ] [
"extra/io/windows/nt/launcher/test" resource-path [ "resource:extra/io/windows/nt/launcher/test" [
<process> <process>
vm "-script" "env.factor" 3array >>command vm "-script" "env.factor" 3array >>command
+replace-environment+ >>environment-mode +replace-environment+ >>environment-mode
@ -108,7 +108,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test ] unit-test
[ "B" ] [ [ "B" ] [
"extra/io/windows/nt/launcher/test" resource-path [ "resource:extra/io/windows/nt/launcher/test" [
<process> <process>
vm "-script" "env.factor" 3array >>command vm "-script" "env.factor" 3array >>command
{ { "A" "B" } } >>environment { { "A" "B" } } >>environment
@ -119,7 +119,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test ] unit-test
[ f ] [ [ f ] [
"extra/io/windows/nt/launcher/test" resource-path [ "resource:extra/io/windows/nt/launcher/test" [
<process> <process>
vm "-script" "env.factor" 3array >>command vm "-script" "env.factor" 3array >>command
{ { "HOME" "XXX" } } >>environment { { "HOME" "XXX" } } >>environment

2
extra/koszul/koszul.factor
View File

@ -184,7 +184,7 @@ DEFER: (d)
[ length ] keep [ (graded-ker/im-d) ] curry map ; [ length ] keep [ (graded-ker/im-d) ] curry map ;
: graded-betti ( generators -- seq ) : graded-betti ( generators -- seq )
basis graded graded-ker/im-d flip first2 1 head* 0 prefix v- ; basis graded graded-ker/im-d flip first2 butlast 0 prefix v- ;
! Bi-graded for two-step complexes ! Bi-graded for two-step complexes
: (bigraded-ker/im-d) ( u-deg z-deg bigraded-basis -- null/rank ) : (bigraded-ker/im-d) ( u-deg z-deg bigraded-basis -- null/rank )

2
extra/locals/locals.factor
View File

@ -101,7 +101,7 @@ UNION: special local quote local-word local-reader local-writer ;
] if ; ] if ;
: point-free-body ( quot args -- newquot ) : point-free-body ( quot args -- newquot )
>r 1 head-slice* r> [ localize ] curry map concat ; >r butlast-slice r> [ localize ] curry map concat ;
: point-free-end ( quot args -- newquot ) : point-free-end ( quot args -- newquot )
over peek special? over peek special?

2
extra/mortar/mortar.factor
View File

@ -122,7 +122,7 @@ over class-class-methods assoc-stack call ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: send-message-next ( object message -- ) : send-message-next ( object message -- )
over object-class class-methods 1 head* assoc-stack call ; over object-class class-methods butlast assoc-stack call ;
: <-~ scan parsed \ send-message-next parsed ; parsing : <-~ scan parsed \ send-message-next parsed ; parsing

4
extra/multiline/multiline.factor
View File

@ -14,7 +14,7 @@ IN: multiline
] [ ";" unexpected-eof ] if* ; ] [ ";" unexpected-eof ] if* ;
: parse-here ( -- str ) : parse-here ( -- str )
[ (parse-here) ] "" make 1 head* [ (parse-here) ] "" make butlast
lexer get next-line ; lexer get next-line ;
: STRING: : STRING:
@ -34,7 +34,7 @@ IN: multiline
[ [
lexer get lexer-column swap (parse-multiline-string) lexer get lexer-column swap (parse-multiline-string)
lexer get set-lexer-column lexer get set-lexer-column
] "" make rest 1 head* ; ] "" make rest butlast ;
: <" : <"
"\">" parse-multiline-string parsed ; parsing "\">" parse-multiline-string parsed ; parsing

10
extra/openssl/openssl-tests.factor
View File

@ -27,7 +27,7 @@ math.parser openssl prettyprint sequences tools.test ;
[ ] [ ssl-v23 new-ctx ] unit-test [ ] [ ssl-v23 new-ctx ] unit-test
[ ] [ get-ctx "extra/openssl/test/server.pem" resource-path use-cert-chain ] unit-test [ ] [ get-ctx "resource:extra/openssl/test/server.pem" use-cert-chain ] unit-test
! TODO: debug 'Memory protection fault at address 6c' ! TODO: debug 'Memory protection fault at address 6c'
! get-ctx 1024 "char" malloc-array 1024 0 f password-cb set-default-passwd ! get-ctx 1024 "char" malloc-array 1024 0 f password-cb set-default-passwd
@ -35,10 +35,10 @@ math.parser openssl prettyprint sequences tools.test ;
[ ] [ get-ctx "password" ascii string>alien set-default-passwd-userdata ] unit-test [ ] [ get-ctx "password" ascii string>alien set-default-passwd-userdata ] unit-test
! Enter PEM pass phrase: password ! Enter PEM pass phrase: password
[ ] [ get-ctx "extra/openssl/test/server.pem" resource-path [ ] [ get-ctx "resource:extra/openssl/test/server.pem"
SSL_FILETYPE_PEM use-private-key ] unit-test SSL_FILETYPE_PEM use-private-key ] unit-test
[ ] [ get-ctx "extra/openssl/test/root.pem" resource-path f [ ] [ get-ctx "resource:extra/openssl/test/root.pem" f
verify-load-locations ] unit-test verify-load-locations ] unit-test
[ ] [ get-ctx 1 set-verify-depth ] unit-test [ ] [ get-ctx 1 set-verify-depth ] unit-test
@ -47,7 +47,7 @@ verify-load-locations ] unit-test
! Load Diffie-Hellman parameters ! Load Diffie-Hellman parameters
! ========================================================= ! =========================================================
[ ] [ "extra/openssl/test/dh1024.pem" resource-path "r" bio-new-file ] unit-test [ ] [ "resource:extra/openssl/test/dh1024.pem" "r" bio-new-file ] unit-test
[ ] [ get-bio f f f read-pem-dh-params ] unit-test [ ] [ get-bio f f f read-pem-dh-params ] unit-test
@ -131,7 +131,7 @@ verify-load-locations ] unit-test
! Dump errors to file ! Dump errors to file
! ========================================================= ! =========================================================
[ ] [ "extra/openssl/test/errors.txt" resource-path "w" bio-new-file ] unit-test [ ] [ "resource:extra/openssl/test/errors.txt" "w" bio-new-file ] unit-test
[ 6 ] [ get-bio "Hello\n" bio-print ] unit-test [ 6 ] [ get-bio "Hello\n" bio-print ] unit-test

6
extra/porter-stemmer/porter-stemmer-tests.factor
View File

@ -56,11 +56,9 @@ io.files io.encodings.utf8 ;
[ "hell" ] [ "hell" step5 "" like ] unit-test [ "hell" ] [ "hell" step5 "" like ] unit-test
[ "mate" ] [ "mate" step5 "" like ] unit-test [ "mate" ] [ "mate" step5 "" like ] unit-test
: resource-lines resource-path utf8 file-lines ;
[ { } ] [ [ { } ] [
"extra/porter-stemmer/test/voc.txt" resource-lines "resource:extra/porter-stemmer/test/voc.txt" utf8 file-lines
[ stem ] map [ stem ] map
"extra/porter-stemmer/test/output.txt" resource-lines "resource:extra/porter-stemmer/test/output.txt" utf8 file-lines
[ 2array ] 2map [ first2 = not ] filter [ 2array ] 2map [ first2 = not ] filter
] unit-test ] unit-test

12
extra/porter-stemmer/porter-stemmer.factor
View File

@ -66,8 +66,6 @@ USING: kernel math parser sequences combinators splitting ;
: r ( str oldsuffix newsuffix -- str ) : r ( str oldsuffix newsuffix -- str )
pick consonant-seq 0 > [ nip ] [ drop ] if append ; pick consonant-seq 0 > [ nip ] [ drop ] if append ;
: butlast ( seq -- seq ) 1 head-slice* ;
: step1a ( str -- newstr ) : step1a ( str -- newstr )
dup peek CHAR: s = [ dup peek CHAR: s = [
{ {
@ -95,7 +93,7 @@ USING: kernel math parser sequences combinators splitting ;
{ [ "iz" ?tail ] [ "ize" append ] } { [ "iz" ?tail ] [ "ize" append ] }
{ {
[ dup length 1- over double-consonant? ] [ dup length 1- over double-consonant? ]
[ dup "lsz" last-is? [ butlast ] unless ] [ dup "lsz" last-is? [ butlast-slice ] unless ]
} }
{ {
[ t ] [ t ]
@ -122,7 +120,7 @@ USING: kernel math parser sequences combinators splitting ;
} cond ; } cond ;
: step1c ( str -- newstr ) : step1c ( str -- newstr )
dup butlast stem-vowel? [ dup butlast-slice stem-vowel? [
"y" ?tail [ "i" append ] when "y" ?tail [ "i" append ] when
] when ; ] when ;
@ -198,18 +196,18 @@ USING: kernel math parser sequences combinators splitting ;
: remove-e? ( str -- ? ) : remove-e? ( str -- ? )
dup consonant-seq dup 1 > dup consonant-seq dup 1 >
[ 2drop t ] [ 2drop t ]
[ 1 = [ butlast cvc? not ] [ drop f ] if ] if ; [ 1 = [ butlast-slice cvc? not ] [ drop f ] if ] if ;
: remove-e ( str -- newstr ) : remove-e ( str -- newstr )
dup peek CHAR: e = [ dup peek CHAR: e = [
dup remove-e? [ butlast ] when dup remove-e? [ butlast-slice ] when
] when ; ] when ;
: ll->l ( str -- newstr ) : ll->l ( str -- newstr )
{ {
{ [ dup peek CHAR: l = not ] [ ] } { [ dup peek CHAR: l = not ] [ ] }
{ [ dup length 1- over double-consonant? not ] [ ] } { [ dup length 1- over double-consonant? not ] [ ] }
{ [ dup consonant-seq 1 > ] [ butlast ] } { [ dup consonant-seq 1 > ] [ butlast-slice ] }
[ ] [ ]
} cond ; } cond ;

2
extra/project-euler/002/002.factor
View File

@ -41,7 +41,7 @@ PRIVATE>
: fib-upto* ( n -- seq ) : fib-upto* ( n -- seq )
0 1 [ pick over >= ] [ tuck + dup ] [ ] unfold 3nip 0 1 [ pick over >= ] [ tuck + dup ] [ ] unfold 3nip
1 head-slice* { 0 1 } prepend ; butlast-slice { 0 1 } prepend ;
: euler002a ( -- answer ) : euler002a ( -- answer )
1000000 fib-upto* [ even? ] filter sum ; 1000000 fib-upto* [ even? ] filter sum ;

2
extra/project-euler/022/022.factor
View File

@ -28,7 +28,7 @@ IN: project-euler.022
<PRIVATE <PRIVATE
: source-022 ( -- seq ) : source-022 ( -- seq )
"extra/project-euler/022/names.txt" resource-path "resource:extra/project-euler/022/names.txt"
ascii file-contents [ quotable? ] filter "," split ; ascii file-contents [ quotable? ] filter "," split ;
: name-scores ( seq -- seq ) : name-scores ( seq -- seq )

2
extra/project-euler/042/042.factor
View File

@ -30,7 +30,7 @@ IN: project-euler.042
<PRIVATE <PRIVATE
: source-042 ( -- seq ) : source-042 ( -- seq )
"extra/project-euler/042/words.txt" resource-path "resource:extra/project-euler/042/words.txt"
ascii file-contents [ quotable? ] filter "," split ; ascii file-contents [ quotable? ] filter "," split ;
: (triangle-upto) ( limit n -- ) : (triangle-upto) ( limit n -- )

4
extra/project-euler/059/059.factor
View File

@ -52,7 +52,7 @@ IN: project-euler.059
<PRIVATE <PRIVATE
: source-059 ( -- seq ) : source-059 ( -- seq )
"extra/project-euler/059/cipher1.txt" resource-path "resource:extra/project-euler/059/cipher1.txt"
ascii file-contents [ blank? ] right-trim "," split ascii file-contents [ blank? ] right-trim "," split
[ string>number ] map ; [ string>number ] map ;
@ -78,7 +78,7 @@ INSTANCE: rollover immutable-sequence
frequency-analysis sort-values keys peek ; frequency-analysis sort-values keys peek ;
: crack-key ( seq key-length -- key ) : crack-key ( seq key-length -- key )
[ " " decrypt ] dip group 1 head-slice* [ " " decrypt ] dip group butlast-slice
flip [ most-frequent ] map ; flip [ most-frequent ] map ;
PRIVATE> PRIVATE>

2
extra/project-euler/067/067.factor
View File

@ -38,7 +38,7 @@ IN: project-euler.067
<PRIVATE <PRIVATE
: source-067 ( -- seq ) : source-067 ( -- seq )
"extra/project-euler/067/triangle.txt" resource-path "resource:extra/project-euler/067/triangle.txt"
ascii file-lines [ " " split [ string>number ] map ] map ; ascii file-lines [ " " split [ string>number ] map ] map ;
PRIVATE> PRIVATE>

2
extra/project-euler/079/079.factor
View File

@ -27,7 +27,7 @@ IN: project-euler.079
<PRIVATE <PRIVATE
: source-079 ( -- seq ) : source-079 ( -- seq )
"extra/project-euler/079/keylog.txt" resource-path ascii file-lines ; "resource:extra/project-euler/079/keylog.txt" ascii file-lines ;
: >edges ( seq -- seq ) : >edges ( seq -- seq )
[ [

4
extra/rss/rss-tests.factor
View File

@ -22,7 +22,7 @@ IN: rss.tests
f f
} }
} }
} ] [ "extra/rss/rss1.xml" resource-path load-news-file ] unit-test } ] [ "resource:extra/rss/rss1.xml" load-news-file ] unit-test
[ T{ [ T{
feed feed
f f
@ -39,4 +39,4 @@ IN: rss.tests
T{ timestamp f 2003 12 13 8 29 29 T{ duration f 0 0 0 -4 0 0 } } T{ timestamp f 2003 12 13 8 29 29 T{ duration f 0 0 0 -4 0 0 } }
} }
} }
} ] [ "extra/rss/atom.xml" resource-path load-news-file ] unit-test } ] [ "resource:extra/rss/atom.xml" load-news-file ] unit-test

20
extra/space-invaders/space-invaders.factor
View File

@ -45,21 +45,21 @@ TUPLE: space-invaders port1 port2i port2o port3o port4lo port4hi port5o bitmap s
: init-sound ( index cpu filename -- ) : init-sound ( index cpu filename -- )
swapd >r space-invaders-sounds nth AL_BUFFER r> swapd >r space-invaders-sounds nth AL_BUFFER r>
resource-path create-buffer-from-wav set-source-param ; create-buffer-from-wav set-source-param ;
: init-sounds ( cpu -- ) : init-sounds ( cpu -- )
init-openal init-openal
[ 9 gen-sources swap set-space-invaders-sounds ] keep [ 9 gen-sources swap set-space-invaders-sounds ] keep
[ SOUND-SHOT "extra/space-invaders/resources/Shot.wav" init-sound ] keep [ SOUND-SHOT "resource:extra/space-invaders/resources/Shot.wav" init-sound ] keep
[ SOUND-UFO "extra/space-invaders/resources/Ufo.wav" init-sound ] keep [ SOUND-UFO "resource:extra/space-invaders/resources/Ufo.wav" init-sound ] keep
[ space-invaders-sounds SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ] keep [ space-invaders-sounds SOUND-UFO swap nth AL_LOOPING AL_TRUE set-source-param ] keep
[ SOUND-BASE-HIT "extra/space-invaders/resources/BaseHit.wav" init-sound ] keep [ SOUND-BASE-HIT "resource:extra/space-invaders/resources/BaseHit.wav" init-sound ] keep
[ SOUND-INVADER-HIT "extra/space-invaders/resources/InvHit.wav" init-sound ] keep [ SOUND-INVADER-HIT "resource:extra/space-invaders/resources/InvHit.wav" init-sound ] keep
[ SOUND-WALK1 "extra/space-invaders/resources/Walk1.wav" init-sound ] keep [ SOUND-WALK1 "resource:extra/space-invaders/resources/Walk1.wav" init-sound ] keep
[ SOUND-WALK2 "extra/space-invaders/resources/Walk2.wav" init-sound ] keep [ SOUND-WALK2 "resource:extra/space-invaders/resources/Walk2.wav" init-sound ] keep
[ SOUND-WALK3 "extra/space-invaders/resources/Walk3.wav" init-sound ] keep [ SOUND-WALK3 "resource:extra/space-invaders/resources/Walk3.wav" init-sound ] keep
[ SOUND-WALK4 "extra/space-invaders/resources/Walk4.wav" init-sound ] keep [ SOUND-WALK4 "resource:extra/space-invaders/resources/Walk4.wav" init-sound ] keep
[ SOUND-UFO-HIT "extra/space-invaders/resources/UfoHit.wav" init-sound ] keep [ SOUND-UFO-HIT "resource:extra/space-invaders/resources/UfoHit.wav" init-sound ] keep
f swap set-space-invaders-looping? ; f swap set-space-invaders-looping? ;
: <space-invaders> ( -- cpu ) : <space-invaders> ( -- cpu )

2
extra/tangle/tangle.factor
View File

@ -65,7 +65,7 @@ TUPLE: tangle-dispatcher < dispatcher tangle ;
: <tangle-dispatcher> ( tangle -- dispatcher ) : <tangle-dispatcher> ( tangle -- dispatcher )
tangle-dispatcher new-dispatcher swap >>tangle tangle-dispatcher new-dispatcher swap >>tangle
<path-responder> >>default <path-responder> >>default
"extra/tangle/resources" resource-path <static> "resources" add-responder "resource:extra/tangle/resources" <static> "resources" add-responder
<node-responder> "node" add-responder <node-responder> "node" add-responder
<action> [ all-node-ids <json-response> ] >>display "all" add-responder ; <action> [ all-node-ids <json-response> ] >>display "all" add-responder ;

4
extra/tools/deploy/backend/backend.factor
View File

@ -63,11 +63,11 @@ DEFER: ?make-staging-image
dup empty? [ dup empty? [
"-i=" my-boot-image-name append , "-i=" my-boot-image-name append ,
] [ ] [
dup 1 head* ?make-staging-image dup butlast ?make-staging-image
"-resource-path=" "" resource-path append , "-resource-path=" "" resource-path append ,
"-i=" over 1 head* staging-image-name append , "-i=" over butlast staging-image-name append ,
"-run=tools.deploy.restage" , "-run=tools.deploy.restage" ,
] if ] if

2
extra/tuple-syntax/tuple-syntax.factor
View File

@ -7,7 +7,7 @@ IN: tuple-syntax
: parse-slot-writer ( tuple -- slot# ) : parse-slot-writer ( tuple -- slot# )
scan dup "}" = [ 2drop f ] [ scan dup "}" = [ 2drop f ] [
1 head* swap object-slots slot-named slot-spec-offset butlast swap object-slots slot-named slot-spec-offset
] if ; ] if ;
: parse-slots ( accum tuple -- accum tuple ) : parse-slots ( accum tuple -- accum tuple )

2
extra/ui/gestures/gestures.factor
View File

@ -54,7 +54,7 @@ TUPLE: zoom-in-action ; C: <zoom-in-action> zoom-in-action
TUPLE: zoom-out-action ; C: <zoom-out-action> zoom-out-action TUPLE: zoom-out-action ; C: <zoom-out-action> zoom-out-action
: generalize-gesture ( gesture -- newgesture ) : generalize-gesture ( gesture -- newgesture )
tuple>array 1 head* >tuple ; tuple>array butlast >tuple ;
! Modifiers ! Modifiers
SYMBOLS: C+ A+ M+ S+ ; SYMBOLS: C+ A+ M+ S+ ;

2
extra/unicode/breaks/breaks.factor
View File

@ -30,7 +30,7 @@ CATEGORY: grapheme-control Zl Zp Cc Cf ;
concat [ dup ] H{ } map>assoc ; concat [ dup ] H{ } map>assoc ;
: other-extend-lines ( -- lines ) : other-extend-lines ( -- lines )
"extra/unicode/PropList.txt" resource-path ascii file-lines ; "resource:extra/unicode/PropList.txt" ascii file-lines ;
VALUE: other-extend VALUE: other-extend

4
extra/unicode/data/data.factor
View File

@ -14,7 +14,7 @@ IN: unicode.data
ascii file-lines [ ";" split ] map ; ascii file-lines [ ";" split ] map ;
: load-data ( -- data ) : load-data ( -- data )
"extra/unicode/UnicodeData.txt" resource-path data ; "resource:extra/unicode/UnicodeData.txt" data ;
: (process-data) ( index data -- newdata ) : (process-data) ( index data -- newdata )
[ [ nth ] keep first swap 2array ] with map [ [ nth ] keep first swap 2array ] with map
@ -120,7 +120,7 @@ VALUE: special-casing
! Special casing data ! Special casing data
: load-special-casing ( -- special-casing ) : load-special-casing ( -- special-casing )
"extra/unicode/SpecialCasing.txt" resource-path data "resource:extra/unicode/SpecialCasing.txt" data
[ length 5 = ] filter [ length 5 = ] filter
[ [ set-code-point ] each ] H{ } make-assoc ; [ [ set-code-point ] each ] H{ } make-assoc ;

2
extra/xml/tests/soap.factor
View File

@ -10,6 +10,6 @@ IN: xml.tests
[ assemble-data ] map ; [ assemble-data ] map ;
[ "http://www.foxnews.com/oreilly/" ] [ [ "http://www.foxnews.com/oreilly/" ] [
"extra/xml/tests/soap.xml" resource-path file>xml "resource:extra/xml/tests/soap.xml" file>xml
parse-result first first parse-result first first
] unit-test ] unit-test

2
extra/xml/tests/test.factor
View File

@ -9,7 +9,7 @@ USING: kernel xml tools.test io namespaces sequences xml.errors xml.entities
\ read-xml must-infer \ read-xml must-infer
SYMBOL: xml-file SYMBOL: xml-file
[ ] [ "extra/xml/tests/test.xml" resource-path [ ] [ "resource:extra/xml/tests/test.xml"
[ file>xml ] with-html-entities xml-file set ] unit-test [ file>xml ] with-html-entities xml-file set ] unit-test
[ "1.0" ] [ xml-file get xml-prolog prolog-version ] unit-test [ "1.0" ] [ xml-file get xml-prolog prolog-version ] unit-test
[ f ] [ xml-file get xml-prolog prolog-standalone ] unit-test [ f ] [ xml-file get xml-prolog prolog-standalone ] unit-test

6
extra/xmode/catalog/catalog.factor
View File

@ -24,7 +24,7 @@ TAGS>
] keep ; ] keep ;
: load-catalog ( -- modes ) : load-catalog ( -- modes )
"extra/xmode/modes/catalog" resource-path "resource:extra/xmode/modes/catalog"
file>xml parse-modes-tag ; file>xml parse-modes-tag ;
: modes ( -- assoc ) : modes ( -- assoc )
@ -38,8 +38,8 @@ TAGS>
MEMO: (load-mode) ( name -- rule-sets ) MEMO: (load-mode) ( name -- rule-sets )
modes at [ modes at [
mode-file mode-file
"extra/xmode/modes/" prepend "resource:extra/xmode/modes/" prepend
resource-path utf8 <file-reader> parse-mode utf8 <file-reader> parse-mode
] [ ] [
"text" (load-mode) "text" (load-mode)
] if* ; ] if* ;

4
extra/xmode/code2html/code2html.factor
View File

@ -20,8 +20,8 @@ IN: xmode.code2html
: default-stylesheet ( -- ) : default-stylesheet ( -- )
<style> <style>
"extra/xmode/code2html/stylesheet.css" "resource:extra/xmode/code2html/stylesheet.css"
resource-path utf8 file-contents write utf8 file-contents write
</style> ; </style> ;
: htmlize-stream ( path stream -- ) : htmlize-stream ( path stream -- )

4
extra/xmode/utilities/utilities-tests.factor
View File

@ -48,6 +48,6 @@ TAGS>
"This is a great company" "This is a great company"
} }
] [ ] [
"extra/xmode/utilities/test.xml" "resource:extra/xmode/utilities/test.xml"
resource-path file>xml parse-company-tag file>xml parse-company-tag
] unit-test ] unit-test

2
extra/yahoo/yahoo-tests.factor
View File

@ -6,6 +6,6 @@ USING: tools.test yahoo kernel io.files xml sequences ;
"Official Foo Fighters" "Official Foo Fighters"
"http://www.foofighters.com/" "http://www.foofighters.com/"
"Official site with news, tour dates, discography, store, community, and more." "Official site with news, tour dates, discography, store, community, and more."
} ] [ "extra/yahoo/test-results.xml" resource-path file>xml parse-yahoo first ] unit-test } ] [ "resource:extra/yahoo/test-results.xml" file>xml parse-yahoo first ] unit-test
[ "http://search.yahooapis.com/WebSearchService/V1/webSearch?appid=Factor-search&query=hi&results=1" ] [ "hi" 1 query ] unit-test [ "http://search.yahooapis.com/WebSearchService/V1/webSearch?appid=Factor-search&query=hi&results=1" ] [ "hi" 1 query ] unit-test