Paste: factor-bisect wip
Author: | erg |
Mode: | factor |
Date: | Sat, 30 Apr 2022 15:59:43 |
Plain Text |
USING: accessors assocs assocs.extras bootstrap.image calendar
formatting http.client io io.encodings.utf8 io.launcher kernel
math math.parser modern.html prettyprint random sequences
sorting splitting zealot.factor ;
IN: factor-bisect
: git-ids-assoc ( -- assoc )
{ "git" "log" "--format=format:%H %at" }
utf8 <process-stream> stream-lines
[ " " split1 string>number unix-time>timestamp ] H{ } map>assoc ;
: get-build-ids ( arch -- seq )
"https://downloads.factorcode.org/images/build/" http-get nip
"<hr>" "<hr/>" replace string>html first children>> second children>> third children>>
[ open-tag? ] filter
[ props>> first second payload>> ] map
[ length 30 < ] reject
swap '[ [ _ ] dip subseq? ] filter
[ "." split1-last nip ] map ;
: platform-git-ids ( arch -- assoc )
[ git-ids-assoc ] dip get-build-ids
rekey-new-assoc sift-values sort-values ;
: build-image-download-name ( arch git-id -- str )
"https://downloads.factorcode.org/images/build/boot.%s.image.%s" sprintf ;
: factorcode-boot-image-paths ( arch -- assoc )
[ platform-git-ids ] keep
'[ [ _ ] 2dip [ build-image-download-name ] dip ] assoc-map ;
: my-arch-boot-image-paths ( -- assoc )
my-arch-name factorcode-boot-image-paths ;
: bisect-middle-factor ( seq cmd -- ? )
[ [ length 1 - ] keep ] dip
'[
nth
first 40 tail* dup ... flush _ bisect-new-factor "t" =
] 2keep swap cut ? ;
: build-all-factors ( seq -- )
[ first 40 tail* dup ... flush build-new-factor ] each ;
: bisect-factor ( cmd -- git-id )
[ my-arch-boot-image-paths ] dip bisect-middle-factor ;%
Author: | erg |
Mode: | factor |
Date: | Tue, 2 May 2023 14:55:31 |
Plain Text |
USING: accessors assocs assocs.extras bootstrap.image calendar
formatting http.client io io.encodings.utf8 io.launcher kernel
math math.parser modern.html prettyprint random sequences sets
sorting splitting zealot.factor ;
IN: factor-bisect
CONSTANT: bad-checksums { "846d2315ff2032c4a6f1e1da469b88ed300cc5c9" }
: git-ids-assoc ( -- assoc )
{ "git" "log" "--format=format:%H %at" }
utf8 <process-stream> stream-lines
[ " " split1 string>number unix-time>timestamp ] H{ } map>assoc ;
: get-build-ids ( arch -- seq )
"https://downloads.factorcode.org/images/build/" http-get nip
"<hr>" "<hr/>" replace string>html first children>> second children>> third children>>
[ open-tag? ] filter
[ props>> first second payload>> ] map
[ length 30 < ] reject
swap '[ [ _ ] dip subseq? ] filter
[ "." split1-last nip ] map ;
: platform-git-ids ( arch -- assoc )
[ git-ids-assoc ] dip get-build-ids bad-checksums diff
rekey-new-assoc sift-values sort-values ;
: build-image-download-name ( arch git-id -- str )
"https://downloads.factorcode.org/images/build/boot.%s.image.%s" sprintf ;
: factorcode-boot-image-paths ( arch -- assoc )
[ platform-git-ids ] keep
'[ [ _ ] 2dip [ build-image-download-name ] dip ] assoc-map ;
: my-arch-boot-image-paths ( -- assoc )
my-arch-name factorcode-boot-image-paths ;
: bisect-middle-factor ( seq cmd -- ? )
[ [ length 2 /i ] keep ] dip
'[
nth
first 40 tail* dup ... flush _ bisect-new-factor nip
] 2keep swap cut ? ;
: build-all-factors ( seq -- )
[ first 40 tail* dup ... flush build-new-factor ] each ;
: bisect-factor ( cmd -- git-id )
[ my-arch-boot-image-paths ] dip bisect-middle-factor ;
New Annotation