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

basis/generalizations/generalizations-docs.factor

@@ -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 }

basis/generalizations/generalizations.factor

@@ -5,10 +5,13 @@ USING: kernel sequences sequences.private namespaces math
 math.ranges combinators macros quotations fry arrays ;
 IN: generalizations
 
-MACRO: narray ( n -- quot )
+MACRO: nsequence ( n seq -- quot )
-    [ <reversed> ] [ '[ , f <array> ] ] bi
+    [ 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 ]

core/memory/memory-tests.factor

@@ -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 ;
 

core/memory/memory.factor

@@ -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 ;

extra/builder/release/upload/upload.factor

@@ -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 )
+SYMBOL: upload-host
-  "factorcode.org:/var/www/factorcode.org/newsite/downloads"
-  platform
-  append-path ;
 
-: (upload) ( -- )
+SYMBOL: upload-username
-  { "scp" archive-name remote-location } to-strings
+
-  [ "Error uploading binary to factorcode" print ]
+SYMBOL: upload-directory
-  run-or-bail ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: 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 ;