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 ;
: knucleotide ( -- )
"extra/benchmark/knucleotide/knucleotide-input.txt" resource-path
"resource:extra/benchmark/knucleotide/knucleotide-input.txt"
ascii [ read-input ] with-file-reader
process-input ;

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

@ -169,3 +169,8 @@ MACRO: multikeep ( word out-indexes -- ... )
: generate ( generator predicate -- obj )
[ dup ] swap [ dup [ nip ] unless not ] 3compose
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 -- )
rest [
1 head* "\n" join 1vector
butlast "\n" join 1vector
[
use [ clone ] change
[ 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* dup length 3 >= [
[ rest-slice 1 head-slice* ] keep like
[ rest-slice butlast-slice ] keep like
] when ;
: 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 ;
: unquote ( str -- newstr )
dup quoted? [ 1 head-slice* rest-slice >string ] when ;
dup quoted? [ butlast-slice rest-slice >string ] when ;
: quote? ( ch -- ? ) "'\"" member? ;

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

@ -166,7 +166,7 @@ test-db [
<dispatcher>
add-quit-action
<dispatcher>
"extra/http/test" resource-path <static> >>default
"resource:extra/http/test" <static> >>default
"nested" add-responder
<action>
[ "redirect-loop" f <standard-redirect> ] >>display
@ -178,7 +178,7 @@ test-db [
] unit-test
[ 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 =
] unit-test

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

@ -148,4 +148,4 @@ SYMBOL: open-arrays
init f exec-loop ;
: 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
\ unclip [ prefix ] define-inverse
\ suffix [ dup 1 head* swap peek ] define-inverse
\ suffix [ dup butlast swap peek ] define-inverse
! Constructor inverse
: 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 )
"extra/io/encodings/8-bit/" ".TXT"
swapd 3append resource-path
ascii <file-reader> ;
"resource:extra/io/encodings/8-bit/" ".TXT"
swapd 3append ascii <file-reader> ;
: tail-if ( seq n -- newseq )
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
[ ] [
"extra/io/windows/nt/launcher/test" resource-path [
"resource:extra/io/windows/nt/launcher/test" [
<process>
vm "-script" "stderr.factor" 3array >>command
"out.txt" temp-file >>stdout
@ -59,7 +59,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test
[ ] [
"extra/io/windows/nt/launcher/test" resource-path [
"resource:extra/io/windows/nt/launcher/test" [
<process>
vm "-script" "stderr.factor" 3array >>command
"out.txt" temp-file >>stdout
@ -73,7 +73,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test
[ "output" ] [
"extra/io/windows/nt/launcher/test" resource-path [
"resource:extra/io/windows/nt/launcher/test" [
<process>
vm "-script" "stderr.factor" 3array >>command
"err2.txt" temp-file >>stderr
@ -86,7 +86,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test
[ t ] [
"extra/io/windows/nt/launcher/test" resource-path [
"resource:extra/io/windows/nt/launcher/test" [
<process>
vm "-script" "env.factor" 3array >>command
ascii <process-reader> contents
@ -96,7 +96,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test
[ t ] [
"extra/io/windows/nt/launcher/test" resource-path [
"resource:extra/io/windows/nt/launcher/test" [
<process>
vm "-script" "env.factor" 3array >>command
+replace-environment+ >>environment-mode
@ -108,7 +108,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test
[ "B" ] [
"extra/io/windows/nt/launcher/test" resource-path [
"resource:extra/io/windows/nt/launcher/test" [
<process>
vm "-script" "env.factor" 3array >>command
{ { "A" "B" } } >>environment
@ -119,7 +119,7 @@ sequences parser assocs hashtables math continuations ;
] unit-test
[ f ] [
"extra/io/windows/nt/launcher/test" resource-path [
"resource:extra/io/windows/nt/launcher/test" [
<process>
vm "-script" "env.factor" 3array >>command
{ { "HOME" "XXX" } } >>environment

2
extra/koszul/koszul.factor
View File

@ -184,7 +184,7 @@ DEFER: (d)
[ length ] keep [ (graded-ker/im-d) ] curry map ;
: 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
: (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 ;
: 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 )
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 -- )
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

4
extra/multiline/multiline.factor
View File

@ -14,7 +14,7 @@ IN: multiline
] [ ";" unexpected-eof ] if* ;
: parse-here ( -- str )
[ (parse-here) ] "" make 1 head*
[ (parse-here) ] "" make butlast
lexer get next-line ;
: STRING:
@ -34,7 +34,7 @@ IN: multiline
[
lexer get lexer-column swap (parse-multiline-string)
lexer get set-lexer-column
] "" make rest 1 head* ;
] "" make rest butlast ;
: <"
"\">" 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
[ ] [ 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'
! 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
! 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
[ ] [ get-ctx "extra/openssl/test/root.pem" resource-path f
[ ] [ get-ctx "resource:extra/openssl/test/root.pem" f
verify-load-locations ] unit-test
[ ] [ get-ctx 1 set-verify-depth ] unit-test
@ -47,7 +47,7 @@ verify-load-locations ] unit-test
! 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
@ -131,7 +131,7 @@ verify-load-locations ] unit-test
! 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
extra/porter-stemmer/porter-stemmer-tests.factor
View File

@ -56,11 +56,9 @@ io.files io.encodings.utf8 ;
[ "hell" ] [ "hell" 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
"extra/porter-stemmer/test/output.txt" resource-lines
"resource:extra/porter-stemmer/test/output.txt" utf8 file-lines
[ 2array ] 2map [ first2 = not ] filter
] 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 )
pick consonant-seq 0 > [ nip ] [ drop ] if append ;
: butlast ( seq -- seq ) 1 head-slice* ;
: step1a ( str -- newstr )
dup peek CHAR: s = [
{
@ -95,7 +93,7 @@ USING: kernel math parser sequences combinators splitting ;
{ [ "iz" ?tail ] [ "ize" append ] }
{
[ dup length 1- over double-consonant? ]
[ dup "lsz" last-is? [ butlast ] unless ]
[ dup "lsz" last-is? [ butlast-slice ] unless ]
}
{
[ t ]
@ -122,7 +120,7 @@ USING: kernel math parser sequences combinators splitting ;
} cond ;
: step1c ( str -- newstr )
dup butlast stem-vowel? [
dup butlast-slice stem-vowel? [
"y" ?tail [ "i" append ] when
] when ;
@ -198,18 +196,18 @@ USING: kernel math parser sequences combinators splitting ;
: remove-e? ( str -- ? )
dup consonant-seq dup 1 >
[ 2drop t ]
[ 1 = [ butlast cvc? not ] [ drop f ] if ] if ;
[ 1 = [ butlast-slice cvc? not ] [ drop f ] if ] if ;
: remove-e ( str -- newstr )
dup peek CHAR: e = [
dup remove-e? [ butlast ] when
dup remove-e? [ butlast-slice ] when
] when ;
: ll->l ( str -- newstr )
{
{ [ dup peek CHAR: l = not ] [ ] }
{ [ dup length 1- over double-consonant? not ] [ ] }
{ [ dup consonant-seq 1 > ] [ butlast ] }
{ [ dup consonant-seq 1 > ] [ butlast-slice ] }
[ ]
} cond ;

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

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

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

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

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

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

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

@ -52,7 +52,7 @@ IN: project-euler.059
<PRIVATE
: 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
[ string>number ] map ;
@ -78,7 +78,7 @@ INSTANCE: rollover immutable-sequence
frequency-analysis sort-values keys peek ;
: crack-key ( seq key-length -- key )
[ " " decrypt ] dip group 1 head-slice*
[ " " decrypt ] dip group butlast-slice
flip [ most-frequent ] map ;
PRIVATE>

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

@ -38,7 +38,7 @@ IN: project-euler.067
<PRIVATE
: 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 ;
PRIVATE>

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

@ -27,7 +27,7 @@ IN: project-euler.079
<PRIVATE
: 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 )
[

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

@ -22,7 +22,7 @@ IN: rss.tests
f
}
}
} ] [ "extra/rss/rss1.xml" resource-path load-news-file ] unit-test
} ] [ "resource:extra/rss/rss1.xml" load-news-file ] unit-test
[ T{
feed
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 } }
}
}
} ] [ "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 -- )
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-openal
[ 9 gen-sources swap set-space-invaders-sounds ] keep
[ SOUND-SHOT "extra/space-invaders/resources/Shot.wav" init-sound ] keep
[ SOUND-UFO "extra/space-invaders/resources/Ufo.wav" init-sound ] keep
[ SOUND-SHOT "resource:extra/space-invaders/resources/Shot.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
[ SOUND-BASE-HIT "extra/space-invaders/resources/BaseHit.wav" init-sound ] keep
[ SOUND-INVADER-HIT "extra/space-invaders/resources/InvHit.wav" init-sound ] keep
[ SOUND-WALK1 "extra/space-invaders/resources/Walk1.wav" init-sound ] keep
[ SOUND-WALK2 "extra/space-invaders/resources/Walk2.wav" init-sound ] keep
[ SOUND-WALK3 "extra/space-invaders/resources/Walk3.wav" init-sound ] keep
[ SOUND-WALK4 "extra/space-invaders/resources/Walk4.wav" init-sound ] keep
[ SOUND-UFO-HIT "extra/space-invaders/resources/UfoHit.wav" init-sound ] keep
[ SOUND-BASE-HIT "resource:extra/space-invaders/resources/BaseHit.wav" init-sound ] keep
[ SOUND-INVADER-HIT "resource:extra/space-invaders/resources/InvHit.wav" init-sound ] keep
[ SOUND-WALK1 "resource:extra/space-invaders/resources/Walk1.wav" init-sound ] keep
[ SOUND-WALK2 "resource:extra/space-invaders/resources/Walk2.wav" init-sound ] keep
[ SOUND-WALK3 "resource:extra/space-invaders/resources/Walk3.wav" init-sound ] keep
[ SOUND-WALK4 "resource:extra/space-invaders/resources/Walk4.wav" init-sound ] keep
[ SOUND-UFO-HIT "resource:extra/space-invaders/resources/UfoHit.wav" init-sound ] keep
f swap set-space-invaders-looping? ;
: <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 new-dispatcher swap >>tangle
<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
<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? [
"-i=" my-boot-image-name append ,
] [
dup 1 head* ?make-staging-image
dup butlast ?make-staging-image
"-resource-path=" "" resource-path append ,
"-i=" over 1 head* staging-image-name append ,
"-i=" over butlast staging-image-name append ,
"-run=tools.deploy.restage" ,
] if

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

@ -7,7 +7,7 @@ IN: tuple-syntax
: parse-slot-writer ( tuple -- slot# )
scan dup "}" = [ 2drop f ] [
1 head* swap object-slots slot-named slot-spec-offset
butlast swap object-slots slot-named slot-spec-offset
] if ;
: 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
: generalize-gesture ( gesture -- newgesture )
tuple>array 1 head* >tuple ;
tuple>array butlast >tuple ;
! Modifiers
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 ;
: other-extend-lines ( -- lines )
"extra/unicode/PropList.txt" resource-path ascii file-lines ;
"resource:extra/unicode/PropList.txt" ascii file-lines ;
VALUE: other-extend

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

@ -14,7 +14,7 @@ IN: unicode.data
ascii file-lines [ ";" split ] map ;
: load-data ( -- data )
"extra/unicode/UnicodeData.txt" resource-path data ;
"resource:extra/unicode/UnicodeData.txt" data ;
: (process-data) ( index data -- newdata )
[ [ nth ] keep first swap 2array ] with map
@ -120,7 +120,7 @@ VALUE: special-casing
! Special casing data
: load-special-casing ( -- special-casing )
"extra/unicode/SpecialCasing.txt" resource-path data
"resource:extra/unicode/SpecialCasing.txt" data
[ length 5 = ] filter
[ [ 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 ;
[ "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
] 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
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
[ "1.0" ] [ xml-file get xml-prolog prolog-version ] 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 ;
: load-catalog ( -- modes )
"extra/xmode/modes/catalog" resource-path
"resource:extra/xmode/modes/catalog"
file>xml parse-modes-tag ;
: modes ( -- assoc )
@ -38,8 +38,8 @@ TAGS>
MEMO: (load-mode) ( name -- rule-sets )
modes at [
mode-file
"extra/xmode/modes/" prepend
resource-path utf8 <file-reader> parse-mode
"resource:extra/xmode/modes/" prepend
utf8 <file-reader> parse-mode
] [
"text" (load-mode)
] if* ;

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

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

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

@ -48,6 +48,6 @@ TAGS>
"This is a great company"
}
] [
"extra/xmode/utilities/test.xml"
resource-path file>xml parse-company-tag
"resource:extra/xmode/utilities/test.xml"
file>xml parse-company-tag
] 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"
"http://www.foofighters.com/"
"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