diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor index f68d5eafbd..9609cd123b 100755 --- a/core/io/files/files-docs.factor +++ b/core/io/files/files-docs.factor @@ -89,7 +89,6 @@ ARTICLE: "io.files" "Basic file operations" { $subsection "fs-meta" } { $subsection "directories" } { $subsection "delete-move-copy" } -{ $subsection "unique" } { $see-also "os" } ; ABOUT: "io.files" diff --git a/extra/db/types/types.factor b/extra/db/types/types.factor index c2aa825db8..023c72cd2d 100755 --- a/extra/db/types/types.factor +++ b/extra/db/types/types.factor @@ -153,33 +153,6 @@ TUPLE: no-sql-modifier ; [ lookup-modifier ] map " " join dup empty? [ " " swap append ] unless ; -SYMBOL: building-seq -: get-building-seq ( n -- seq ) - building-seq get nth ; - -: n, get-building-seq push ; -: n% get-building-seq push-all ; -: n# >r number>string r> n% ; - -: 0, 0 n, ; -: 0% 0 n% ; -: 0# 0 n# ; -: 1, 1 n, ; -: 1% 1 n% ; -: 1# 1 n# ; -: 2, 2 n, ; -: 2% 2 n% ; -: 2# 2 n# ; - -: nmake ( quot exemplars -- seqs ) - dup length dup zero? [ 1+ ] when - [ - [ - [ drop 1024 swap new-resizable ] 2map - [ building-seq set call ] keep - ] 2keep >r [ like ] 2map r> firstn - ] with-scope ; - HOOK: bind% db ( spec -- ) TUPLE: no-slot-named ; diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 8fc45ec486..45197b1a90 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -2,6 +2,42 @@ USING: assocs html.parser kernel math sequences strings ascii arrays shuffle unicode.case namespaces splitting http ; IN: html.parser.analyzer +: (find-relative) + [ >r + dup r> ?nth* [ 2drop f f ] unless ] [ 2drop f ] if ; + +: find-relative ( seq quot n -- i elt ) + >r over [ find drop ] dip r> swap pick + (find-relative) ; + +: (find-all) ( n seq quot -- ) + 2dup >r >r find* [ + dupd 2array , 1+ r> r> (find-all) + ] [ + r> r> 3drop + ] if* ; + +: find-all ( seq quot -- alist ) + [ 0 -rot (find-all) ] { } make ; + +: (find-nth) ( offset seq quot n count -- obj ) + >r >r [ find* ] 2keep 4 npick [ + r> r> 1+ 2dup <= [ + 4drop + ] [ + >r >r >r >r drop 1+ r> r> r> r> + (find-nth) + ] if + ] [ + 2drop r> r> 2drop + ] if ; + +: find-nth ( seq quot n -- i elt ) + 0 -roll 0 (find-nth) ; + +: find-nth-relative ( seq quot n offest -- i elt ) + >r [ find-nth ] 3keep 2drop nip r> swap pick + (find-relative) ; + : remove-blank-text ( vector -- vector' ) [ dup tag-name text = [ @@ -51,29 +87,33 @@ IN: html.parser.analyzer >r >lower r> [ tag-attributes at over = ] with find rot drop ; -: find-between ( i/f tag/f vector -- vector ) +: find-between* ( i/f tag/f vector -- vector ) pick integer? [ - rot 1+ tail-slice + rot tail-slice >r tag-name r> - [ find-matching-close drop ] keep swap head + [ find-matching-close drop 1+ ] keep swap head ] [ 3drop V{ } clone ] if ; + +: find-between ( i/f tag/f vector -- vector ) + find-between* dup length 3 >= [ + [ 1 tail-slice 1 head-slice* ] keep like + ] when ; + +: find-between-first ( string vector -- vector' ) + [ find-first-name ] keep find-between ; + +: tag-link ( tag -- link/f ) + tag-attributes [ "href" swap at ] [ f ] if* ; : find-links ( vector -- vector ) [ tag-name "a" = ] subset - [ tag-attributes "href" swap at ] map - [ ] subset ; + [ tag-link ] subset ; -: (find-all) ( n seq quot -- ) - 2dup >r >r find* [ - dupd 2array , 1+ r> r> (find-all) - ] [ - r> r> 3drop - ] if* ; -: find-all ( seq quot -- alist ) - [ 0 -rot (find-all) ] { } make ; +: find-by-text ( seq quot -- tag ) + [ dup tag-name text = ] swap compose find drop ; : find-opening-tags-by-name ( name seq -- seq ) [ [ tag-name = ] keep tag-closing? not and ] with find-all ; diff --git a/extra/io/windows/ce/ce.factor b/extra/io/windows/ce/ce.factor index a5e0cb6b4a..878f5899f6 100755 --- a/extra/io/windows/ce/ce.factor +++ b/extra/io/windows/ce/ce.factor @@ -3,4 +3,5 @@ io.windows.ce.files io.windows.ce.sockets io.windows.ce.launcher namespaces io.windows.mmap ; IN: io.windows.ce +USE: io.windows.files T{ windows-ce-io } set-io-backend diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index fdd574d00e..d107f80723 100644 --- a/extra/io/windows/files/files.factor +++ b/extra/io/windows/files/files.factor @@ -50,17 +50,20 @@ SYMBOL: +encrypted+ { +encrypted+ FILE_ATTRIBUTE_ENCRYPTED } } get-flags ; +: win32-file-type ( n -- symbol ) + FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ; + : WIN32_FIND_DATA>file-info { - [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ] [ [ WIN32_FIND_DATA-nFileSizeLow ] [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit ] [ WIN32_FIND_DATA-dwFileAttributes ] - [ - WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp - ] + ! [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp ] + [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp ] + ! [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp ] } cleave \ file-info construct-boa ; @@ -73,16 +76,15 @@ SYMBOL: +encrypted+ : BY_HANDLE_FILE_INFORMATION>file-info { - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type ] [ [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit ] [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes ] - [ - BY_HANDLE_FILE_INFORMATION-ftLastWriteTime - FILETIME>timestamp - ] + ! [ BY_HANDLE_FILE_INFORMATION-ftCreationTime FILETIME>timestamp ] + [ BY_HANDLE_FILE_INFORMATION-ftLastWriteTime FILETIME>timestamp ] + ! [ BY_HANDLE_FILE_INFORMATION-ftLastAccessTime FILETIME>timestamp ] } cleave \ file-info construct-boa ; diff --git a/extra/io/windows/nt/nt.factor b/extra/io/windows/nt/nt.factor index be57a398a2..9bc587e00e 100755 --- a/extra/io/windows/nt/nt.factor +++ b/extra/io/windows/nt/nt.factor @@ -9,6 +9,7 @@ USE: io.windows.nt.launcher USE: io.windows.nt.monitors USE: io.windows.nt.sockets USE: io.windows.mmap +USE: io.windows.files USE: io.backend T{ windows-nt-io } set-io-backend diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index c02932a020..050de0ae1c 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -140,13 +140,13 @@ PRIVATE> : strings ( alphabet length -- seqs ) >r dup length r> number-strings map-alphabet ; -: nths ( nths seq -- subseq ) - ! nths is a sequence of ones and zeroes +: switches ( seq1 seq -- subseq ) + ! seq1 is a sequence of ones and zeroes >r [ length ] keep [ nth 1 = ] curry subset r> [ nth ] curry { } map-as ; : power-set ( seq -- subsets ) - 2 over length exact-number-strings swap [ nths ] curry map ; + 2 over length exact-number-strings swap [ switches ] curry map ; : push-either ( elt quot accum1 accum2 -- ) >r >r keep swap r> r> ? push ; inline @@ -214,3 +214,9 @@ PRIVATE> : attempt-each ( seq quot -- result ) (each) iterate-prep (attempt-each-integer) ; inline + +: ?nth* ( n seq -- elt/f ? ) + 2dup bounds-check? [ nth-unsafe t ] [ 2drop f f ] if ; flushable + +: nths ( indices seq -- seq' ) + [ swap nth ] with map ;