Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
9910de0439
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue