diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 8a81bb1972..3ab489739b 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -86,11 +86,11 @@ SYMBOL: +unknown+ : stat ( path -- directory? permissions length modified ) normalize-pathname (stat) ; -: file-length ( path -- n ) stat drop 2nip ; +! : file-length ( path -- n ) stat drop 2nip ; : file-modified ( path -- n ) stat >r 3drop r> ; -: file-permissions ( path -- perm ) stat 2drop nip ; +! : file-permissions ( path -- perm ) stat 2drop nip ; : exists? ( path -- ? ) file-modified >boolean ; @@ -219,11 +219,11 @@ M: pathname <=> [ pathname-string ] compare ; : with-file-reader ( path encoding quot -- ) >r r> with-stream ; inline -! : file-contents ( path encoding -- str ) -! dupd [ file-info file-info-size read ] with-file-reader ; - : file-contents ( path encoding -- str ) - dupd [ file-length read ] with-file-reader ; + dupd [ file-info file-info-size read ] with-file-reader ; + +! : file-contents ( path encoding -- str ) +! dupd [ file-length read ] with-file-reader ; : with-file-writer ( path encoding quot -- ) >r r> with-stream ; inline diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor old mode 100755 new mode 100644 diff --git a/extra/combinators/cleave/cleave-docs.factor b/extra/combinators/cleave/cleave-docs.factor index 0c491b88b1..18968628d5 100644 --- a/extra/combinators/cleave/cleave-docs.factor +++ b/extra/combinators/cleave/cleave-docs.factor @@ -9,6 +9,7 @@ ARTICLE: "cleave-combinators" "Cleave Combinators" { $subsection bi } { $subsection tri } +{ $subsection cleave } { $notes "From the Merriam-Webster Dictionary: " @@ -49,10 +50,17 @@ HELP: tri ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +HELP: cleave + +{ $code "( obj { q1 q2 ... qN } -- q1(obj) q2(obj) ... qN(obj) )" } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ARTICLE: "spread-combinators" "Spread Combinators" { $subsection bi* } -{ $subsection tri* } ; +{ $subsection tri* } +{ $subsection spread } ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -80,3 +88,9 @@ HELP: tri* { "p(x)" "p applied to x" } { "q(y)" "q applied to y" } { "r(z)" "r applied to z" } } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +HELP: spread + +{ $code "( v1 v2 ... vN { q1 q2 ... qN } -- q1(v1) q2(v2) ... qN(vN) )" } ; \ No newline at end of file diff --git a/extra/combinators/cleave/cleave.factor b/extra/combinators/cleave/cleave.factor old mode 100755 new mode 100644 index 383d5ca9ac..fd66536c12 --- a/extra/combinators/cleave/cleave.factor +++ b/extra/combinators/cleave/cleave.factor @@ -15,9 +15,9 @@ IN: combinators.cleave ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: 2bi ( obj obj quot quot -- val val ) >r 2keep r> call ; inline +: 2bi ( x y p q -- p(x,y) q(x,y) ) >r 2keep r> call ; inline -: 2tri ( obj obj quot quot quot -- val val val ) +: 2tri ( x y z p q r -- p(x,y,z) q(x,y,z) r(x,y,z) ) >r >r 2keep r> 2keep r> call ; inline ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -36,6 +36,18 @@ MACRO: cleave ( seq -- ) [ drop ] append ; +MACRO: 2cleave ( seq -- ) + dup + [ drop [ 2dup ] ] map concat + swap + dup + [ drop [ >r >r ] ] map concat + swap + [ [ r> r> ] append ] map concat + 3append + [ 2drop ] + append ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! The spread family ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/http/server/static/static.factor b/extra/http/server/static/static.factor index 18870a993f..9c05b87a71 100755 --- a/extra/http/server/static/static.factor +++ b/extra/http/server/static/static.factor @@ -14,7 +14,8 @@ TUPLE: file-responder root hook special ; >r unix-1970 r> seconds time+ ; : file-http-date ( filename -- string ) - file-modified unix-time>timestamp timestamp>http-string ; + file-info file-info-modified + unix-time>timestamp timestamp>http-string ; : last-modified-matches? ( filename -- ? ) file-http-date dup [ @@ -31,7 +32,7 @@ TUPLE: file-responder root hook special ; [ swap - [ file-length "content-length" set-header ] + [ file-info file-info-size "content-length" set-header ] [ file-http-date "last-modified" set-header ] [ '[ , binary stdio get stream-copy ] >>body ] tri