path+, prepend

db4
Doug Coleman 2008-03-19 19:15:43 -05:00
parent 3e7940216e
commit d0b348591a
14 changed files with 35 additions and 25 deletions

View File

@ -25,7 +25,7 @@ SYMBOL: bootstrap-time
"exclude" "include"
[ get-global " " split [ empty? not ] subset ] 2apply
seq-diff
[ "bootstrap." swap append require ] each ;
[ "bootstrap." prepend require ] each ;
: compile-remaining ( -- )
"Compiling remaining words..." print flush

View File

@ -13,7 +13,7 @@ PREDICATE: class union-class
drop [ drop f ]
] [
unclip first "predicate" word-prop swap
[ >r "predicate" word-prop [ dup ] swap append r> ]
[ >r "predicate" word-prop [ dup ] prepend r> ]
assoc-map alist>quot
] if ;

View File

@ -80,7 +80,7 @@ M: hashtable hashcode*
: hash-case-quot ( default assoc -- quot )
hash-case-table hash-dispatch-quot
[ dup hashcode >fixnum ] swap append ;
[ dup hashcode >fixnum ] prepend ;
: contiguous-range? ( keys -- from to ? )
dup [ fixnum? ] all? [

View File

@ -7,12 +7,12 @@ splitting io.files ;
: run-bootstrap-init ( -- )
"user-init" get [
home ".factor-boot-rc" path+ ?run-file
home ".factor-boot-rc" append-path ?run-file
] when ;
: run-user-init ( -- )
"user-init" get [
home ".factor-rc" path+ ?run-file
home ".factor-rc" append-path ?run-file
] when ;
: cli-var-param ( name value -- ) swap set-global ;

View File

@ -385,7 +385,7 @@ cell 8 = [
[ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
[ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test
: xword-def word-def [ { fixnum } declare ] swap append ;
: xword-def word-def [ { fixnum } declare ] prepend ;
[ -100 ] [ -100 <char> [ { byte-array } declare *char ] compile-call ] unit-test
[ 156 ] [ -100 <uchar> [ { byte-array } declare *uchar ] compile-call ] unit-test

View File

@ -53,7 +53,7 @@ TUPLE: no-math-method left right generic ;
2dup and [
2dup math-upgrade >r
math-class-max over order min-class applicable-method
r> swap append
r> prepend
] [
2drop object-method
] if ;

View File

@ -161,7 +161,7 @@ C: <hook-combination> hook-combination
0 (dispatch#) [
swap slip
hook-combination-var [ get ] curry
swap append
prepend
] with-variable ; inline
M: hook-combination make-default-method
@ -170,7 +170,7 @@ M: hook-combination make-default-method
M: hook-combination perform-combination
[
standard-methods
[ [ drop ] swap append ] assoc-map
[ [ drop ] prepend ] assoc-map
single-combination
] with-hook ;

View File

@ -19,7 +19,7 @@ ARTICLE: "pathnames" "Pathname manipulation"
{ $subsection parent-directory }
{ $subsection file-name }
{ $subsection last-path-separator }
{ $subsection path+ }
{ $subsection append-path }
"Pathnames relative to Factor's install directory:"
{ $subsection resource-path }
{ $subsection ?resource-path }
@ -224,7 +224,7 @@ HELP: stat ( path -- directory? permissions length modified )
{ stat exists? directory? } related-words
HELP: path+
HELP: append-path
{ $values { "str1" "a string" } { "str2" "a string" } { "str" "a string" } }
{ $description "Concatenates two pathnames." } ;

View File

@ -32,10 +32,13 @@ HOOK: rename-file io-backend ( from to -- )
: left-trim-separators ( str -- newstr )
[ path-separator? ] left-trim ;
: path+ ( str1 str2 -- str )
: append-path ( str1 str2 -- str )
>r right-trim-separators "/" r>
left-trim-separators 3append ;
: prepend-path ( str1 str2 -- str )
swap append-path ; inline
: last-path-separator ( path -- n ? )
[ length 1- ] keep [ path-separator? ] find-last* ;
@ -119,7 +122,7 @@ HOOK: make-directory io-backend ( path -- )
: fixup-directory ( path seq -- newseq )
[
dup string?
[ tuck path+ directory? 2array ] [ nip ] if
[ tuck append-path directory? 2array ] [ nip ] if
] with map
[ first special-directory? not ] subset ;
@ -127,7 +130,7 @@ HOOK: make-directory io-backend ( path -- )
normalize-directory dup (directory) fixup-directory ;
: directory* ( path -- seq )
dup directory [ first2 >r path+ r> 2array ] with map ;
dup directory [ first2 >r append-path r> 2array ] with map ;
! Touching files
HOOK: touch-file io-backend ( path -- )
@ -146,7 +149,7 @@ HOOK: delete-directory io-backend ( path -- )
: delete-tree ( path -- )
dup directory? (delete-tree) ;
: to-directory over file-name path+ ;
: to-directory over file-name append-path ;
! Moving and renaming files
HOOK: move-file io-backend ( from to -- )
@ -179,7 +182,7 @@ DEFER: copy-tree-into
: copy-tree ( from to -- )
over directory? [
>r dup directory swap r> [
>r swap first path+ r> copy-tree-into
>r swap first append-path r> copy-tree-into
] 2curry each
] [
copy-file
@ -194,7 +197,7 @@ DEFER: copy-tree-into
! Special paths
: resource-path ( path -- newpath )
\ resource-path get [ image parent-directory ] unless*
swap path+ ;
prepend-path ;
: ?resource-path ( path -- newpath )
"resource:" ?head [ resource-path ] when ;
@ -236,7 +239,7 @@ M: pathname <=> [ pathname-string ] compare ;
[ dup make-directory ]
when ;
: temp-file ( name -- path ) temp-directory swap path+ ;
: temp-file ( name -- path ) temp-directory prepend-path ;
! Home directory
: home ( -- dir )

View File

@ -35,7 +35,7 @@ IN: optimizer.specializers
swap "method-class" word-prop add* ;
: specialize-method ( quot method -- quot' )
method-declaration [ declare ] curry swap append ;
method-declaration [ declare ] curry prepend ;
: specialize-quot ( quot specializer -- quot' )
dup { number } = [

View File

@ -299,6 +299,8 @@ M: immutable-sequence clone-like like ;
: append ( seq1 seq2 -- newseq ) over (append) ;
: prepend ( seq1 seq2 -- newseq ) swap append ; inline
: 3append ( seq1 seq2 seq3 -- newseq ) pick (3append) ;
: change-nth ( i seq quot -- )

View File

@ -163,6 +163,11 @@ IN: bootstrap.syntax
[ construct-boa ] curry define-inline
] define-syntax
"ERROR:" [
CREATE-CLASS dup ";" parse-tokens define-tuple-class
dup [ construct-boa throw ] curry define
] define-syntax
"FORGET:" [
scan-word
dup parsing? [ V{ } clone swap execute first ] when

View File

@ -136,7 +136,7 @@ IN: vocabs.loader.tests
[
{ "2" "a" "b" "d" "e" "f" }
[
"vocabs.loader.test." swap append forget-vocab
"vocabs.loader.test." prepend forget-vocab
] each
] with-compilation-unit ;

View File

@ -25,7 +25,7 @@ V{
: vocab-dir? ( root name -- ? )
over [
".factor" vocab-dir+ path+ resource-exists?
".factor" vocab-dir+ append-path resource-exists?
] [
2drop f
] if ;
@ -39,14 +39,14 @@ H{ } clone root-cache set-global
vocab-roots get swap [ vocab-dir? ] curry find nip
] cache ;
: vocab-path+ ( vocab path -- newpath )
swap find-vocab-root dup [ swap path+ ] [ 2drop f ] if ;
: vocab-append-path ( vocab path -- newpath )
swap find-vocab-root dup [ prepend-path ] [ 2drop f ] if ;
: vocab-source-path ( vocab -- path/f )
dup ".factor" vocab-dir+ vocab-path+ ;
dup ".factor" vocab-dir+ vocab-append-path ;
: vocab-docs-path ( vocab -- path/f )
dup "-docs.factor" vocab-dir+ vocab-path+ ;
dup "-docs.factor" vocab-dir+ vocab-append-path ;
SYMBOL: load-help?