Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2008-04-04 16:21:59 -05:00
commit 842cdf0891
4 changed files with 44 additions and 56 deletions

View File

@ -13,8 +13,6 @@ IN: builder
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! : cd ( path -- ) current-directory set ;
: cd ( path -- ) set-current-directory ; : cd ( path -- ) set-current-directory ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -51,23 +49,15 @@ IN: builder
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: gnu-make ( -- string ) : gnu-make ( -- string )
os { "freebsd" "openbsd" "netbsd" } member? os { freebsd openbsd netbsd } member?
[ "gmake" ] [ "gmake" ]
[ "make" ] [ "make" ]
if ; if ;
! : do-make-clean ( -- ) { "make" "clean" } try-process ;
: do-make-clean ( -- ) { gnu-make "clean" } to-strings try-process ; : do-make-clean ( -- ) { gnu-make "clean" } to-strings try-process ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! : make-vm ( -- desc )
! <process>
! { "make" } >>command
! "../compile-log" >>stdout
! +stdout+ >>stderr ;
: make-vm ( -- desc ) : make-vm ( -- desc )
<process> <process>
{ gnu-make } to-strings >>command { gnu-make } to-strings >>command
@ -94,7 +84,7 @@ IN: builder
+closed+ >>stdin +closed+ >>stdin
"../boot-log" >>stdout "../boot-log" >>stdout
+stdout+ >>stderr +stdout+ >>stderr
20 minutes >>timeout ; 60 minutes >>timeout ;
: do-bootstrap ( -- ) : do-bootstrap ( -- )
bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail ; bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail ;
@ -127,10 +117,10 @@ SYMBOL: build-status
"report" utf8 "report" utf8
[ [
"Build machine: " write host-name print "Build machine: " write host-name print
"CPU: " write cpu print "CPU: " write cpu .
"OS: " write os print "OS: " write os .
"Build directory: " write cwd print "Build directory: " write current-directory get print
git-clone [ "git clone failed" print ] run-or-bail git-clone [ "git clone failed" print ] run-or-bail
@ -158,8 +148,6 @@ SYMBOL: build-status
"Did not pass test-all: " print "test-all-vocabs" cat "Did not pass test-all: " print "test-all-vocabs" cat
"test-failures" cat "test-failures" cat
! "test-failures" eval-file test-failures.
"help-lint results:" print "help-lint" cat "help-lint results:" print "help-lint" cat
"Benchmarks: " print "benchmarks" eval-file benchmarks. "Benchmarks: " print "benchmarks" eval-file benchmarks.

View File

@ -1,6 +1,6 @@
USING: kernel system namespaces sequences splitting combinators USING: kernel system namespaces sequences splitting combinators
io io.files io.launcher io io.files io.launcher prettyprint
bake combinators.cleave builder.common builder.util ; bake combinators.cleave builder.common builder.util ;
IN: builder.release IN: builder.release
@ -33,22 +33,22 @@ IN: builder.release
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: cpu- ( -- cpu ) cpu "." split "-" join ; : cpu- ( -- cpu ) cpu unparse "." split "-" join ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: base-name ( -- string ) { "factor" os cpu- stamp> } to-strings "-" join ; : base-name ( -- string )
{ "factor" [ os unparse ] cpu- stamp> } to-strings "-" join ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: extension ( -- extension ) : extension ( -- extension )
os
{ {
{ "linux" [ ".tar.gz" ] } { [ os winnt? ] [ ".zip" ] }
{ "winnt" [ ".zip" ] } { [ os macosx? ] [ ".dmg" ] }
{ "macosx" [ ".dmg" ] } { [ os unix? ] [ ".tar.gz" ] }
} }
case ; cond ;
: archive-name ( -- string ) base-name extension append ; : archive-name ( -- string ) base-name extension append ;
@ -69,9 +69,9 @@ IN: builder.release
: archive-cmd ( -- cmd ) : archive-cmd ( -- cmd )
{ {
{ [ windows? ] [ windows-archive-cmd ] } { [ os windows? ] [ windows-archive-cmd ] }
{ [ macosx? ] [ macosx-archive-cmd ] } { [ os macosx? ] [ macosx-archive-cmd ] }
{ [ unix? ] [ unix-archive-cmd ] } { [ os unix? ] [ unix-archive-cmd ] }
} }
cond ; cond ;
@ -83,13 +83,13 @@ IN: builder.release
{ "rm" "-rf" common-files } to-strings try-process ; { "rm" "-rf" common-files } to-strings try-process ;
: remove-factor-app ( -- ) : remove-factor-app ( -- )
macosx? not [ { "rm" "-rf" "Factor.app" } try-process ] when ; os macosx? not [ { "rm" "-rf" "Factor.app" } try-process ] when ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: upload-to-factorcode SYMBOL: upload-to-factorcode
: platform ( -- string ) { os cpu- } to-strings "-" join ; : platform ( -- string ) { [ os unparse ] cpu- } to-strings "-" join ;
: remote-location ( -- dest ) : remote-location ( -- dest )
"factorcode.org:/var/www/factorcode.org/newsite/downloads" "factorcode.org:/var/www/factorcode.org/newsite/downloads"

View File

@ -1,40 +1,35 @@
USING: kernel namespaces sequences assocs builder continuations ! USING: kernel namespaces sequences assocs continuations
vocabs vocabs.loader ! vocabs vocabs.loader
io ! io
io.files ! io.files
prettyprint ! prettyprint
tools.vocabs ! tools.vocabs
tools.test ! tools.test
io.encodings.utf8 ! io.encodings.utf8
combinators.cleave ! combinators.cleave
! help.lint
! bootstrap.stage2 benchmark builder.util ;
USING: kernel namespaces assocs
io.files io.encodings.utf8 prettyprint
help.lint help.lint
bootstrap.stage2 benchmark builder.util ; benchmark
bootstrap.stage2
tools.test tools.vocabs
builder.util ;
IN: builder.test IN: builder.test
: do-load ( -- ) : do-load ( -- )
try-everything keys "../load-everything-vocabs" utf8 [ . ] with-file-writer ; try-everything keys "../load-everything-vocabs" utf8 [ . ] with-file-writer ;
! : do-tests ( -- )
! run-all-tests keys "../test-all-vocabs" utf8 [ . ] with-file-writer ;
: do-tests ( -- ) : do-tests ( -- )
run-all-tests run-all-tests
[ keys "../test-all-vocabs" utf8 [ . ] with-file-writer ] [ keys "../test-all-vocabs" utf8 [ . ] with-file-writer ]
[ "../test-failures" utf8 [ test-failures. ] with-file-writer ] [ "../test-failures" utf8 [ test-failures. ] with-file-writer ]
bi ; bi ;
! : do-tests ( -- )
! run-all-tests
! "../test-all-vocabs" utf8
! [
! [ keys . ]
! [ test-failures. ]
! bi
! ]
! with-file-writer ;
: do-help-lint ( -- ) : do-help-lint ( -- )
"" run-help-lint "../help-lint" utf8 [ typos. ] with-file-writer ; "" run-help-lint "../help-lint" utf8 [ typos. ] with-file-writer ;

View File

@ -22,11 +22,16 @@ IN: newfx
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: nth-is-of ( i val seq -- seq ) dup >r swapd set-nth r> ;
: is-nth-of ( val i seq -- seq ) dup >r set-nth r> ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: mutate-nth ( seq i val -- ) swap rot set-nth ; : mutate-nth ( seq i val -- ) swap rot set-nth ;
: mutate-at-nth ( seq val i -- ) rot set-nth ; : mutate-nth-at ( seq val i -- ) rot set-nth ;
: mutate-nth-of ( i val seq -- ) swapd set-nth ; : mutate-nth-of ( i val seq -- ) swapd set-nth ;
: mutate-at-nth-of ( val i seq -- ) set-nth ; : mutate-nth-at-of ( val i seq -- ) set-nth ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!