factor: trim using lists

[factor.git] / extra / tar / tar.factor

diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor
index 8445ae002d08dbc4bed97bb70d10ca4f43d1053d..45570dcabd4f29f361a67b34c5b1fffb742001f2 100644 (file)
--- a/extra/tar/tar.factor
+++ b/extra/tar/tar.factor
@@ -3,8 +3,7 @@
 USING: accessors byte-arrays combinators io io.backend
 io.directories io.encodings.binary io.files io.files.links
 io.pathnames io.streams.byte-array io.streams.string kernel
-math math.parser namespaces sequences strings summary
-typed ;
+math math.parser namespaces sequences summary typed ;
 IN: tar
 
 CONSTANT: zero-checksum 256
@@ -25,8 +24,8 @@ ERROR: checksum-error header ;
 : read-c-string ( n -- str )
     read [ zero? ] trim-tail "" like ;
 
-: read-tar-header ( -- obj )
-    \ tar-header new
+: read-tar-header ( -- header )
+    tar-header new
         100 read-c-string >>name
         8 read-c-string trim-string oct> >>mode
         8 read-c-string trim-string oct> >>uid
@@ -47,11 +46,11 @@ ERROR: checksum-error header ;
 TYPED: checksum-header ( seq: byte-array -- n )
     148 cut-slice 8 tail-slice [ 0 [ + ] reduce ] bi@ + 256 + >fixnum ;
 
-: read-data-blocks ( tar-header -- )
+: read-data-blocks ( header -- )
     dup size>> 0 > [
         block-size read [
             over size>> dup block-size <= [
-                head-slice >byte-array write drop
+                head write drop
             ] [
                 drop write
                 [ block-size - ] change-size
@@ -62,12 +61,12 @@ TYPED: checksum-header ( seq: byte-array -- n )
         ] if*
     ] [
         drop
-    ] if ;
+    ] if ; inline recursive
 
-: parse-tar-header ( seq -- obj )
+: parse-tar-header ( seq -- header )
     dup checksum-header dup zero-checksum = [
         2drop
-        \ tar-header new
+        tar-header new
             0 >>size
             0 >>checksum
     ] [
@@ -79,18 +78,15 @@ TYPED: checksum-header ( seq: byte-array -- n )
 
 ERROR: unknown-typeflag ch ;
 
-M: unknown-typeflag summary ( obj -- str )
+M: unknown-typeflag summary
     ch>> [ "Unknown typeflag: " ] dip prefix ;
 
-: read/write-blocks ( tar-header path -- )
+: read/write-blocks ( header path -- )
     binary [ read-data-blocks ] with-file-writer ;
 
-: prepend-current-directory ( path -- path' )
-    current-directory get prepend-path ;
-
 ! Normal file
 : typeflag-0 ( header -- )
-    dup name>> prepend-current-directory read/write-blocks ;
+    dup name>> read/write-blocks ;
 
 TUPLE: hard-link linkname name ;
 C: <hard-link> hard-link
@@ -114,7 +110,7 @@ C: <symbolic-link> symbolic-link
 
 ! Directory
 : typeflag-5 ( header -- )
-    name>> prepend-current-directory make-directories ;
+    name>> make-directories ;
 
 ! FIFO
 : typeflag-6 ( header -- ) unknown-typeflag ;
@@ -158,7 +154,7 @@ C: <symbolic-link> symbolic-link
     ;
     ! [ read-data-blocks ] with-string-writer
     ! [ zero? ] trim-tail filename set
-    ! filename get prepend-current-directory make-directories ;
+    ! filename get make-directories ;
 
 ! Multi volume continuation entry
 : typeflag-M ( header -- ) unknown-typeflag ;
@@ -211,12 +207,10 @@ C: <symbolic-link> symbolic-link
 GENERIC: do-link ( object -- )
 
 M: hard-link do-link
-    [ linkname>> ]
-    [ name>> prepend-current-directory ] bi make-hard-link ;
+    [ linkname>> ] [ name>> ] bi make-hard-link ;
 
 M: symbolic-link do-link
-    [ linkname>> ]
-    [ name>> prepend-current-directory ] bi make-link ;
+    [ linkname>> ] [ name>> ] bi make-link ;
 
 ! FIXME: linux tar calls unlinkat and makelinkat
 : make-links ( -- )