builder: bit refactoring

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 ;
+: target ( -- target ) { os [ cpu "." split ] } to-strings "-" join ;
-
-: 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 ;
 
 : factor-binary ( -- name )
   os
   { { "macosx" [ "./Factor.app/Contents/MacOS/factor" ] }
-    { "winnt" [ "./factor-nt.exe" ] }
+    { "winnt"  [ "./factor-nt.exe" ] }
-    [ drop "./factor" ] }
+    [ 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 ( -- )
+: make-vm ( -- desc )
-  `{
+  <process*>
-     { +arguments+ { "make" ,[ target ] } }
+    { "make" target } to-strings >>arguments
-     { +stdout+    "../compile-log" }
+    "../compile-log"             >>stdout
-     { +stderr+    +stdout+ }
+    +stdout+                     >>stderr
-   }
+  >desc ;
-  >hashtable ;
+
+: bootstrap-cmd ( -- cmd )
+  { factor-binary [ "-i=" my-boot-image-name append ] "-no-user-init" }
+  to-strings ;
 
 : bootstrap ( -- desc )
-  `{
+  <process*>
-     { +arguments+ {
+    bootstrap-cmd >>arguments
-                     ,[ factor-binary ]
+    "../boot-log" >>stdout
-                     ,[ "-i=" my-boot-image-name append ]
+    +stdout+      >>stderr
-                     "-no-user-init"
+    20 minutes>ms >>timeout
-                   } }
+  >desc ;
-     { +stdout+   "../boot-log" }
-     { +stderr+   +stdout+ }
-     { +timeout+  ,[ 20 minutes>ms ] }
-   } ;
 
-: 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 ) <file-reader> contents eval ;
-  
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: cat ( file -- ) <file-reader> 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 ;
+  <email>
+    "ed@factorcode.org"     >>from
+    builder-recipients get  >>to
+    "report" tag-subject    >>subject
+    "../report" file>string >>body
+  send ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

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*> 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 ) <file-reader> contents eval ;
+
+: cat ( file -- ) <file-reader> contents print ;
+
+: run-or-bail ( desc quot -- )
+  [ [ try-process ] curry ]
+  [ [ throw       ] curry ]
+  bi*
+  recover ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+