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

Fix Windows bootstrap

db4
U-SLAVA-DFB8FF805\Slava 2008-06-27 01:56:53 -05:00
parent 38d5151322
commit 8930162251
1 changed files with 7 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
extra/io/windows/nt/files/files.factor
View File

@ -3,7 +3,7 @@ io.timeouts io.ports io.windows io.windows.files
io.windows.nt.backend windows windows.kernel32 io.windows.nt.backend windows windows.kernel32
kernel libc math threads system kernel libc math threads system
alien.c-types alien.arrays alien.strings sequences combinators alien.c-types alien.arrays alien.strings sequences combinators
combinators.lib sequences.lib ascii splitting alien strings combinators.short-circuit ascii splitting alien strings
assocs namespaces io.files.private accessors ; assocs namespaces io.files.private accessors ;
IN: io.windows.nt.files IN: io.windows.nt.files
@ -22,21 +22,18 @@ M: winnt root-directory? ( path -- ? )
{ {
{ [ dup empty? ] [ f ] } { [ dup empty? ] [ f ] }
{ [ dup [ path-separator? ] all? ] [ t ] } { [ dup [ path-separator? ] all? ] [ t ] }
{ [ dup right-trim-separators { [ dup right-trim-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] }
{ [ dup length 2 = ] [ dup second CHAR: : = ] } 0&& nip ] [
t
] }
[ f ] [ f ]
} cond nip ; } cond nip ;
ERROR: not-absolute-path ; ERROR: not-absolute-path ;
: root-directory ( string -- string' ) : root-directory ( string -- string' )
{ dup {
[ dup length 2 >= ] [ length 2 >= ]
[ dup second CHAR: : = ] [ second CHAR: : = ]
[ dup first Letter? ] [ first Letter? ]
} 0&& [ 2 head ] [ not-absolute-path ] if ; } 1&& [ 2 head ] [ not-absolute-path ] if ;
: prepend-prefix ( string -- string' ) : prepend-prefix ( string -- string' )
dup unicode-prefix head? [ dup unicode-prefix head? [