path+, prepend
parent
3e7940216e
commit
d0b348591a
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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? [
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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." } ;
|
||||
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 } = [
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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?
|
||||
|
||||
|
|
Loading…
Reference in New Issue