From eca7c0b739ae778e22d54e8e8b537789b964285a Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 14 Feb 2008 00:43:50 -0600 Subject: [PATCH] builder: bit refactoring --- extra/builder/builder.factor | 101 ++++++++++----------------------- extra/builder/util/util.factor | 82 ++++++++++++++++++++++++++ 2 files changed, 112 insertions(+), 71 deletions(-) create mode 100644 extra/builder/util/util.factor diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index a3e925338f..eb5b6689b0 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -3,45 +3,25 @@ USING: kernel parser io io.files io.launcher io.sockets hashtables math threads arrays system continuations namespaces sequences splitting math.parser prettyprint tools.time calendar bake vars http.client combinators bootstrap.image bootstrap.image.download - combinators.cleave benchmark ; + combinators.cleave benchmark + classes strings quotations words parser-combinators new-slots accessors + assocs.lib smtp builder.util ; IN: builder ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: runtime ( quot -- time ) benchmark nip ; - -: minutes>ms ( min -- ms ) 60 * 1000 * ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - SYMBOL: builder-recipients -: host-name* ( -- name ) host-name "." split first ; +: tag-subject ( str -- str ) { "builder@" host-name* ": " , } bake to-string ; -: tag-subject ( str -- str ) `{ "builder@" ,[ host-name* ] ": " , } concat ; - -: email-string ( subject -- ) - `{ "mutt" "-s" ,[ tag-subject ] %[ builder-recipients get ] } - [ ] with-process-stream drop ; - -: email-file ( subject file -- ) - `{ - { +stdin+ , } - { +arguments+ - { "mutt" "-s" ,[ tag-subject ] %[ builder-recipients get ] } } - } - >hashtable run-process drop ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: target ( -- target ) `{ ,[ os ] %[ cpu "." split ] } "-" join ; +: target ( -- target ) { os [ cpu "." split ] } to-strings "-" join ; : factor-binary ( -- name ) os { { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] } - { "winnt" [ "./factor-nt.exe" ] } - [ drop "./factor" ] } + { "winnt" [ "./factor-nt.exe" ] } + [ drop "./factor" ] } case ; : git-pull ( -- desc ) @@ -57,14 +37,6 @@ SYMBOL: builder-recipients ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: datestamp ( -- string ) - now `{ ,[ dup timestamp-year ] - ,[ dup timestamp-month ] - ,[ dup timestamp-day ] - ,[ dup timestamp-hour ] - ,[ timestamp-minute ] } - [ pad-00 ] map "-" join ; - VAR: stamp : enter-build-dir ( -- ) @@ -82,49 +54,31 @@ VAR: stamp : make-clean ( -- desc ) { "make" "clean" } ; -: make-vm ( -- ) - `{ - { +arguments+ { "make" ,[ target ] } } - { +stdout+ "../compile-log" } - { +stderr+ +stdout+ } - } - >hashtable ; +: make-vm ( -- desc ) + + { "make" target } to-strings >>arguments + "../compile-log" >>stdout + +stdout+ >>stderr + >desc ; + +: bootstrap-cmd ( -- cmd ) + { factor-binary [ "-i=" my-boot-image-name append ] "-no-user-init" } + to-strings ; : bootstrap ( -- desc ) - `{ - { +arguments+ { - ,[ factor-binary ] - ,[ "-i=" my-boot-image-name append ] - "-no-user-init" - } } - { +stdout+ "../boot-log" } - { +stderr+ +stdout+ } - { +timeout+ ,[ 20 minutes>ms ] } - } ; + + bootstrap-cmd >>arguments + "../boot-log" >>stdout + +stdout+ >>stderr + 20 minutes>ms >>timeout + >desc ; -: builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ; +: builder-test ( -- desc ) { factor-binary "-run=builder.test" } to-strings ; SYMBOL: build-status ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: milli-seconds>time ( n -- string ) - 1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ; - -: eval-file ( file -- obj ) contents eval ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: cat ( file -- ) contents print ; - -: run-or-bail ( desc quot -- ) - [ [ try-process ] curry ] - [ [ throw ] curry ] - bi* - recover ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : (build) ( -- ) enter-build-dir @@ -182,7 +136,12 @@ SYMBOL: build-status : build ( -- ) [ (build) ] [ drop ] recover - "report" "../report" email-file ; + + "ed@factorcode.org" >>from + builder-recipients get >>to + "report" tag-subject >>subject + "../report" file>string >>body + send ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/builder/util/util.factor b/extra/builder/util/util.factor new file mode 100644 index 0000000000..9917cbd759 --- /dev/null +++ b/extra/builder/util/util.factor @@ -0,0 +1,82 @@ + +USING: kernel words namespaces classes parser continuations + io io.files io.launcher io.sockets + math math.parser + combinators sequences splitting quotations arrays strings tools.time + parser-combinators accessors assocs.lib + combinators.cleave bake calendar new-slots ; + +IN: builder.util + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: runtime ( quot -- time ) benchmark nip ; + +: minutes>ms ( min -- ms ) 60 * 1000 * ; + +: file>string ( file -- string ) [ stdio get contents ] with-file-in ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +DEFER: to-strings + +: to-string ( obj -- str ) + dup class + { + { string [ ] } + { quotation [ call ] } + { word [ execute ] } + { fixnum [ number>string ] } + { array [ to-strings concat ] } + } + case ; + +: to-strings ( seq -- str ) + dup [ string? ] all? + [ ] + [ [ to-string ] map flatten ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: process* arguments stdout stderr timeout ; + +: process* construct-empty ; + +: >desc ( process* -- desc ) + H{ } clone + over arguments>> [ +arguments+ swap put-at ] when* + over stdout>> [ +stdout+ swap put-at ] when* + over stderr>> [ +stderr+ swap put-at ] when* + over timeout>> [ +timeout+ swap put-at ] when* + nip ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: host-name* ( -- name ) host-name "." split first ; + +: datestamp ( -- string ) + now `{ ,[ dup timestamp-year ] + ,[ dup timestamp-month ] + ,[ dup timestamp-day ] + ,[ dup timestamp-hour ] + ,[ timestamp-minute ] } + [ pad-00 ] map "-" join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: milli-seconds>time ( n -- string ) + 1000 /i 60 /mod >r 60 /mod r> 3array [ pad-00 ] map ":" join ; + +: eval-file ( file -- obj ) contents eval ; + +: cat ( file -- ) contents print ; + +: run-or-bail ( desc quot -- ) + [ [ try-process ] curry ] + [ [ throw ] curry ] + bi* + recover ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +