Paste: factor-bisect wip

Author: erg
Mode: factor
Date: Sat, 30 Apr 2022 15:59:43
Plain Text |
! Copyright (C) 2022 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
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 2 /i ] keep ] dip
    [ [ 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 ;%                                                                                                                             

Annotation: more

Author: erg
Mode: factor
Date: Tue, 2 May 2023 14:55:31
Plain Text |
! Copyright (C) 2022 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
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

Summary:
Author:
Mode:
Body: