[ { "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
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
: C-ENUM:
";" parse-tokens
- dup length
- [ [ create-in ] dip 1quotation define ] 2each ;
+ [ [ create-in ] dip define-constant ] each-index ;
parsing
+: address-of ( name library -- value )
+ load-library dlsym [ "No such symbol" throw ] unless* ;
+
: &:
- scan "c-library" get
- '[ _ _ load-library dlsym ] over push-all ; parsing
+ scan "c-library" get '[ _ _ address-of ] over push-all ; parsing
dup method>> {
{ "GET" [ url>> query>> ] }
{ "HEAD" [ url>> query>> ] }
- { "POST" [
- post-data>>
- dup content-type>> "application/x-www-form-urlencoded" =
- [ content>> ] [ drop f ] if
- ] }
+ { "POST" [ post-data>> params>> ] }
} case ;
: referrer ( -- referrer/f )
: random-alist ( n -- alist )
[
- [
- 32 random-bits dup number>string swap set
- ] times
- ] H{ } make-assoc ;
+ drop 32 random-bits dup number>string
+ ] H{ } map>assoc ;
: test-heap-sort ( n -- ? )
random-alist dup >alist sort-keys swap heap-sort = ;
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*
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
{ 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{ } }
}
] [
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 >>raw
- swap >>uploaded-files
- swap >>form-variables ;
+ swap >>content-type ;
: parse-content-type-attributes ( string -- attributes )
" " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
request get "accept" header "HTTP_ACCEPT" set\r
\r
post-request? [\r
- request get post-data>> raw>>\r
+ request get post-data>> data>>\r
[ "CONTENT_TYPE" set ]\r
[ length number>string "CONTENT_LENGTH" set ]\r
bi\r
swap '[\r
binary encode-output\r
_ output-stream get swap <cgi-process> binary <process-stream> [\r
- post-request? [ request get post-data>> raw>> write flush ] when\r
+ post-request? [ request get post-data>> data>> write flush ] when\r
input-stream get swap (stream-copy)\r
] with-stream\r
] >>body ;\r
: read-content ( request -- bytes )
"content-length" header string>number read ;
-: parse-content ( request content-type -- form-variables uploaded-files raw )
- {
- { "multipart/form-data" [ read-multipart-data f ] }
- { "application/x-www-form-urlencoded" [ read-content [ f f ] dip ] }
- [ drop read-content [ f f ] dip ]
+: parse-content ( request content-type -- post-data )
+ [ <post-data> swap ] keep {
+ { "multipart/form-data" [ read-multipart-data assoc-union >>params ] }
+ { "application/x-www-form-urlencoded" [ read-content query>assoc >>params ] }
+ [ drop read-content >>data ]
} case ;
: read-post-data ( request -- request )
dup method>> "POST" = [
dup dup "content-type" header
- [ ";" split1 drop parse-content ] keep
- <post-data> >>post-data
+ ";" split1 drop parse-content >>post-data
] when ;
: extract-host ( request -- request )
"References to values:"
{ $subsection value-ref }
{ $subsection <value-ref> }
-"References are used by the inspector." ;
+"References are used by the UI inspector." ;
ABOUT: "refs"
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
-! 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 ;
] [ ] 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
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 = executable_path ? executable_path : argv[0];
+ p->executable_path = argv[0];
int i = 0;
/* 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();
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();
}
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)
#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"
#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"
projects / factor.git / commitdiff