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

basis/alien/c-types/c-types-tests.factor

@@ -8,10 +8,6 @@ sequences system libc alien.strings io.encodings.utf8 ;
 
 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test
 
-: foo ( -- n ) &: fdafd [ 123 ] unless* ;
-
-[ 123 ] [ foo ] unit-test
-
 [ -1 ] [ -1 <char> *char ] unit-test
 [ -1 ] [ -1 <short> *short ] unit-test
 [ -1 ] [ -1 <int> *int ] unit-test

basis/alien/syntax/syntax.factor

@@ -4,7 +4,7 @@ USING: accessors arrays alien alien.c-types alien.structs
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
 effects assocs combinators lexer strings.parser alien.parser 
-fry vocabs.parser ;
+fry vocabs.parser words.constant ;
 IN: alien.syntax
 
 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
@@ -31,10 +31,11 @@ IN: alien.syntax
 
 : C-ENUM:
     ";" parse-tokens
-    dup length
+    [ [ create-in ] dip define-constant ] each-index ;
-    [ [ create-in ] dip 1quotation define ] 2each ;
     parsing
 
+: address-of ( name library -- value )
+    load-library dlsym [ "No such symbol" throw ] unless* ;
+
 : &:
-    scan "c-library" get
+    scan "c-library" get '[ _ _ address-of ] over push-all ; parsing
-    '[ _ _ load-library dlsym ] over push-all ; parsing

basis/furnace/utilities/utilities.factor

@@ -96,11 +96,7 @@ M: object modify-form drop ;
     dup method>> {
         { "GET" [ url>> query>> ] }
         { "HEAD" [ url>> query>> ] }
-        { "POST" [
+        { "POST" [ post-data>> params>> ] }
-            post-data>>
-            dup content-type>> "application/x-www-form-urlencoded" =
-            [ content>> ] [ drop f ] if
-        ] }
     } case ;
 
 : referrer ( -- referrer/f )

basis/heaps/heaps-tests.factor

@@ -32,10 +32,8 @@ IN: heaps.tests
 
 : random-alist ( n -- alist )
     [
-        [
+        drop 32 random-bits dup number>string
-            32 random-bits dup number>string swap set
+    ] H{ } map>assoc ;
-        ] times
-    ] H{ } make-assoc ;
 
 : test-heap-sort ( n -- ? )
     random-alist dup >alist sort-keys swap heap-sort = ;

basis/http/client/client.factor

@@ -25,7 +25,7 @@ IN: http.client
     dup header>> >hashtable
     over url>> host>> [ over url>> url-host "host" pick set-at ] when
     over post-data>> [
-        [ raw>> length "content-length" pick set-at ]
+        [ data>> length "content-length" pick set-at ]
         [ content-type>> "content-type" pick set-at ]
         bi
     ] when*
@@ -36,19 +36,35 @@ GENERIC: >post-data ( object -- post-data )
 
 M: post-data >post-data ;
 
-M: string >post-data utf8 encode "application/octet-stream" <post-data> ;
+M: string >post-data
+    utf8 encode
+    "application/octet-stream" <post-data>
+        swap >>data ;
 
-M: byte-array >post-data "application/octet-stream" <post-data> ;
+M: byte-array >post-data
+    "application/octet-stream" <post-data>
+        swap >>data ;
 
-M: assoc >post-data assoc>query ascii encode "application/x-www-form-urlencoded" <post-data> ;
+M: assoc >post-data
+    "application/x-www-form-urlencoded" <post-data>
+        swap >>params ;
 
 M: f >post-data ;
 
+: normalize-post-data ( request -- request )
+    dup post-data>> [
+        dup params>> [
+            assoc>query ascii encode >>data
+        ] when* drop
+    ] when* ;
+
 : unparse-post-data ( request -- request )
-    [ >post-data ] change-post-data ;
+    [ >post-data ] change-post-data
+    normalize-post-data ;
 
 : write-post-data ( request -- request )
-    dup method>> [ "POST" = ] [ "PUT" = ] bi or [ dup post-data>> raw>> write ] when ; 
+    dup method>> [ "POST" = ] [ "PUT" = ] bi or
+    [ dup post-data>> data>> write ] when ; 
 
 : write-request ( request -- )
     unparse-post-data

basis/http/http-tests.factor

@@ -35,7 +35,7 @@ blah
         { method "POST" }
         { version "1.1" }
         { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } }
-        { post-data T{ post-data { content "blah" } { raw "blah" } { content-type "application/octet-stream" } } }
+        { post-data T{ post-data { data "blah" } { content-type "application/octet-stream" } } }
         { cookies V{ } }
     }
 ] [

basis/http/http.factor

@@ -213,14 +213,11 @@ body ;
     raw-response new
         "1.1" >>version ;
 
-TUPLE: post-data raw content content-type form-variables uploaded-files ;
+TUPLE: post-data data params content-type content-encoding ;
 
-: <post-data> ( form-variables uploaded-files raw content-type -- post-data )
+: <post-data> ( content-type -- post-data )
     post-data new
-        swap >>content-type
+        swap >>content-type ;
-        swap >>raw
-        swap >>uploaded-files
-        swap >>form-variables ;
 
 : parse-content-type-attributes ( string -- attributes )
     " " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;

basis/http/server/cgi/cgi.factor

@@ -34,7 +34,7 @@ IN: http.server.cgi
         request get "accept" header "HTTP_ACCEPT" set
 
         post-request? [
-            request get post-data>> raw>>
+            request get post-data>> data>>
             [ "CONTENT_TYPE" set ]
             [ length number>string "CONTENT_LENGTH" set ]
             bi
@@ -54,7 +54,7 @@ IN: http.server.cgi
     swap '[
         binary encode-output
         _ output-stream get swap <cgi-process> binary <process-stream> [
-            post-request? [ request get post-data>> raw>> write flush ] when
+            post-request? [ request get post-data>> data>> write flush ] when
             input-stream get swap (stream-copy)
         ] with-stream
     ] >>body ;

basis/http/server/server.factor

@@ -55,18 +55,17 @@ ERROR: no-boundary ;
 : read-content ( request -- bytes )
     "content-length" header string>number read ;
 
-: parse-content ( request content-type -- form-variables uploaded-files raw )
+: parse-content ( request content-type -- post-data )
-    {
+    [ <post-data> swap ] keep {
-        { "multipart/form-data" [ read-multipart-data f ] }
+        { "multipart/form-data" [ read-multipart-data assoc-union >>params ] }
-        { "application/x-www-form-urlencoded" [ read-content [ f f ] dip ] }
+        { "application/x-www-form-urlencoded" [ read-content query>assoc >>params ] }
-        [ drop read-content [ f f ] dip ]
+        [ drop read-content >>data ]
     } case ;
 
 : read-post-data ( request -- request )
     dup method>> "POST" = [
         dup dup "content-type" header
-        [ ";" split1 drop parse-content ] keep
+        ";" split1 drop parse-content >>post-data
-        <post-data> >>post-data
     ] when ;
 
 : extract-host ( request -- request )

basis/refs/refs-docs.factor

@@ -14,7 +14,7 @@ ARTICLE: "refs" "References to assoc entries"
 "References to values:"
 { $subsection value-ref }
 { $subsection <value-ref> }
-"References are used by the inspector." ;
+"References are used by the UI inspector." ;
 
 ABOUT: "refs"
 

core/sequences/sequences-docs.factor

@@ -1096,7 +1096,7 @@ HELP: set-fourth
 
 HELP: replicate
 { $values
-     { "seq" sequence } { "quot" quotation }
+     { "seq" sequence } { "quot" { $quotation "( -- elt )" } }
      { "newseq" sequence } }
 { $description "Calls the quotation for every element of the sequence in order. However, the element is not passed to the quotation -- it is dropped, and the quotation produces an element of its own that is collected into a sequence of the same class as the input sequence." }
 { $examples 

core/slots/slots.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays byte-arrays kernel kernel.private math namespaces
 make sequences strings words effects generic generic.standard
 classes classes.algebra slots.private combinators accessors
-words sequences.private assocs alien quotations ;
+words sequences.private assocs alien quotations hashtables ;
 IN: slots
 
 TUPLE: slot-spec name offset class initial read-only ;
@@ -86,7 +86,7 @@ ERROR: bad-slot-value value class ;
     ] [ ] make ;
 
 : writer-props ( slot-spec -- assoc )
-    [ "writing" set ] H{ } make-assoc ;
+    "writing" associate ;
 
 : define-writer ( class slot-spec -- )
     [ name>> writer-word ] [ writer-quot ] [ writer-props ] tri

vm/factor.c

@@ -53,8 +53,7 @@ INLINE bool factor_arg(const F_CHAR* str, const F_CHAR* arg, CELL* value)
 void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv)
 {
 	default_parameters(p);
-	const F_CHAR *executable_path = vm_executable_path();
+	p->executable_path = argv[0];
-	p->executable_path = executable_path ? executable_path : argv[0];
 
 	int i = 0;
 
@@ -106,6 +105,11 @@ void init_factor(F_PARAMETERS *p)
 	/* OS-specific initialization */
 	early_init();
 
+	const F_CHAR *executable_path = vm_executable_path();
+
+	if(executable_path)
+		p->executable_path = executable_path;
+
 	if(p->image_path == NULL)
 		p->image_path = default_image_path();
 

vm/image.c

@@ -112,7 +112,10 @@ bool save_image(const F_CHAR *filename)
 	FILE* file;
 	F_HEADER h;
 
+	F_CHAR temporary_filename[] = STRING_LITERAL("##saving-factor-image##");
+
 	file = OPEN_WRITE(filename);
+	//file = OPEN_WRITE(temporary_filename);
 	if(file == NULL)
 	{
 		print_string("Cannot open image file: "); print_native_string(filename); nl();
@@ -164,6 +167,16 @@ bool save_image(const F_CHAR *filename)
 	}
 
 	return true;
+
+	if(MOVE_FILE_FAILS(temporary_filename, filename))
+	{
+		print_string("Failed to rename tempoarary image file: "); print_string(strerror(errno)); nl();
+		//if(DELETE_FILE_FAILS(temporary_filename))
+			//print_string("Failed to clean up temporary image file: "); print_string(strerror(errno)); nl();
+		return false;
+	}
+
+	return true;
 }
 
 void primitive_save_image(void)

vm/os-unix.h

@@ -22,6 +22,8 @@ typedef char F_SYMBOL;
 #define STRCMP strcmp
 #define STRNCMP strncmp
 #define STRDUP strdup
+#define MOVE_FILE_FAILS(old,new) (rename((old),(new)) < 0)
+#define DELETE_FILE_FAILS(old) (unlink((old)) < 0)
 
 #define FIXNUM_FORMAT "%ld"
 #define CELL_FORMAT "%lu"

vm/os-windows.h

@@ -19,6 +19,8 @@ typedef wchar_t F_CHAR;
 #define STRCMP wcscmp
 #define STRNCMP wcsncmp
 #define STRDUP _wcsdup
+#define MOVE_FILE_FAILS(old,new) (MoveFile((old),(new)) == 0)
+#define DELETE_FILE_FAILS(old) (DeleteFile((old)) == 0)
 
 #ifdef WIN64
 	#define CELL_FORMAT "%Iu"