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

db4
Doug Coleman 2008-09-06 23:58:32 -05:00
commit 6458f7c67b
5 changed files with 74 additions and 15 deletions

View File

@ -2,6 +2,16 @@ USING: help.syntax help.markup kernel sequences quotations
math arrays ;
IN: generalizations
HELP: nsequence
{ $values { "n" integer } { "seq" "an exemplar" } }
{ $description "A generalization of " { $link 2sequence } ", "
{ $link 3sequence } ", and " { $link 4sequence } " "
"that constructs a sequence from the top " { $snippet "n" } " elements of the stack."
}
{ $examples
{ $example "CHAR: f CHAR: i CHAR: s CHAR: h 4 \"\" nsequence ." "\"fish\"" }
} ;
HELP: narray
{ $values { "n" integer } }
{ $description "A generalization of " { $link 1array } ", "
@ -9,6 +19,8 @@ HELP: narray
"that constructs an array from the top " { $snippet "n" } " elements of the stack."
} ;
{ nsequence narray } related-words
HELP: firstn
{ $values { "n" integer } }
{ $description "A generalization of " { $link first } ", "
@ -127,11 +139,15 @@ HELP: nkeep
{ $see-also keep nslip } ;
ARTICLE: "generalizations" "Generalized shuffle words and combinators"
"A number of stack shuffling words and combinators for use in "
"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "
"macros where the arity of the input quotations depends on an "
"input parameter."
$nl
"Generalized sequence operations:"
{ $subsection narray }
{ $subsection nsequence }
{ $subsection firstn }
"Generated stack shuffle operations:"
{ $subsection ndup }
{ $subsection npick }
{ $subsection nrot }
@ -139,6 +155,7 @@ ARTICLE: "generalizations" "Generalized shuffle words and combinators"
{ $subsection nnip }
{ $subsection ndrop }
{ $subsection nrev }
"Generalized combinators:"
{ $subsection ndip }
{ $subsection nslip }
{ $subsection nkeep }

View File

@ -5,10 +5,13 @@ USING: kernel sequences sequences.private namespaces math
math.ranges combinators macros quotations fry arrays ;
IN: generalizations
MACRO: narray ( n -- quot )
[ <reversed> ] [ '[ , f <array> ] ] bi
MACRO: nsequence ( n seq -- quot )
[ drop <reversed> ] [ '[ , , new-sequence ] ] 2bi
[ '[ @ [ , swap set-nth-unsafe ] keep ] ] reduce ;
MACRO: narray ( n -- quot )
'[ , { } nsequence ] ;
MACRO: firstn ( n -- )
dup zero? [ drop [ drop ] ] [
[ [ '[ , _ nth-unsafe ] ] map ]

View File

@ -3,6 +3,8 @@ sequences tools.test words namespaces layouts classes
classes.builtin arrays quotations ;
IN: memory.tests
[ [ ] instances ] must-infer
! Code GC wasn't kicking in when needed
: leak-step 800000 f <array> 1quotation call drop ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel continuations sequences arrays system ;
USING: kernel continuations sequences vectors arrays system math ;
IN: memory
: (each-object) ( quot: ( obj -- ) -- )
@ -9,7 +9,14 @@ IN: memory
: each-object ( quot -- )
begin-scan [ (each-object) ] [ end-scan ] [ ] cleanup ; inline
: count-instances ( quot -- n )
0 swap [ 1 0 ? + ] compose each-object ; inline
: instances ( quot -- seq )
pusher [ each-object ] dip >array ; inline
#! To ensure we don't need to grow the vector while scanning
#! the heap, we do two scans, the first one just counts the
#! number of objects that satisfy the predicate.
[ count-instances 100 + <vector> ] keep swap
[ [ push-if ] 2curry each-object ] keep >array ; inline
: save ( -- ) image save-image ;

View File

@ -1,5 +1,5 @@
USING: kernel namespaces io io.files
USING: kernel namespaces sequences arrays io io.files
builder.util
builder.common
builder.release.archive ;
@ -8,17 +8,47 @@ IN: builder.release.upload
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: remote-location ( -- dest )
"factorcode.org:/var/www/factorcode.org/newsite/downloads"
platform
append-path ;
SYMBOL: upload-host
: (upload) ( -- )
{ "scp" archive-name remote-location } to-strings
[ "Error uploading binary to factorcode" print ]
run-or-bail ;
SYMBOL: upload-username
SYMBOL: upload-directory
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: remote-location ( -- dest )
upload-directory get platform append ;
: remote-archive-name ( -- dest )
remote-location "/" archive-name 3append ;
: temp-archive-name ( -- dest )
remote-archive-name ".incomplete" append ;
: upload-command ( -- args )
"scp"
archive-name
[ upload-username get % "@" % upload-host get % ":" % temp-archive-name % ] "" make
3array ;
: rename-command ( -- args )
[
"ssh" ,
upload-host get ,
"-l" ,
upload-username get ,
"mv" ,
temp-archive-name ,
remote-archive-name ,
] { } make ;
: upload-temp-file ( -- )
upload-command [ "Error uploading binary to factorcode" print ] run-or-bail ;
: rename-temp-file ( -- )
rename-command [ "Error renaming binary on factorcode" print ] run-or-bail ;
: upload ( -- )
upload-to-factorcode get
[ (upload) ]
[ upload-temp-file rename-temp-file ]
when ;