extra/mason/child/child.factor

   1 ! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays calendar combinators.short-circuit fry
   4 continuations debugger io.directories io.files io.launcher
   5 io.pathnames io.encodings.ascii kernel make mason.common
   6 mason.config mason.platform mason.report mason.notify namespaces
   7 sequences quotations macros system combinators splitting ;
   8 IN: mason.child
   9
  10 : nmake-cmd ( -- args )
  11     { "nmake" "/f" "nmakefile" }
  12     target-cpu get name>> "." split "-" join suffix ;
  13
  14 : gnu-make-cmd ( -- args )
  15     gnu-make
  16     target-os get name>> target-cpu get name>> (platform)
  17     2array ;
  18
  19 : make-cmd ( -- args )
  20     {
  21         { [ target-os get windows = ] [ nmake-cmd ] }
  22         [ gnu-make-cmd ]
  23     } cond ;
  24
  25 : make-vm ( -- )
  26     "factor" [
  27         <process>
  28             make-cmd >>command
  29             "../compile-log" >>stdout
  30             +stdout+ >>stderr
  31         try-process
  32     ] with-directory ;
  33
  34 : factor-vm ( -- string )
  35     target-os get windows = "./factor.com" "./factor" ? ;
  36
  37 : boot-cmd ( -- cmd )
  38     [
  39         factor-vm ,
  40         "-i=" boot-image-name append ,
  41         "-no-user-init" ,
  42         boot-flags get %
  43     ] { } make ;
  44
  45 : boot ( -- )
  46     "factor" [
  47         <process>
  48             boot-cmd >>command
  49             +closed+ >>stdin
  50             "../boot-log" >>stdout
  51             +stdout+ >>stderr
  52             1 hours >>timeout
  53         try-process
  54     ] with-directory ;
  55
  56 : test-cmd ( -- cmd ) factor-vm "-run=mason.test" 2array ;
  57
  58 : test ( -- )
  59     "factor" [
  60         <process>
  61             test-cmd >>command
  62             +closed+ >>stdin
  63             "../test-log" >>stdout
  64             +stdout+ >>stderr
  65             4 hours >>timeout
  66         try-process
  67     ] with-directory ;
  68
  69 : recover-else ( try catch else -- )
  70     [ [ '[ @ f t ] ] [ '[ @ f ] ] bi* recover ] dip '[ drop @ ] when ; inline
  71
  72 MACRO: recover-cond ( alist -- )
  73     dup { [ length 1 = ] [ first callable? ] } 1&&
  74     [ first ] [
  75         [ first first2 ] [ rest ] bi
  76         '[ _ _ [ _ recover-cond ] recover-else ]
  77     ] if ;
  78
  79 : build-child ( -- status )
  80     {
  81         { [ notify-make-vm make-vm ] [ compile-failed ] }
  82         { [ notify-boot boot ] [ boot-failed ] }
  83         { [ notify-test test ] [ test-failed ] }
  84         [ success ]
  85     } recover-cond ;