*.image
*.dylib
factor
+factor.com
*#*#
.DS_Store
.gdb_history
CFLAGS += -O3 $(SITE_CFLAGS)
endif
-ifdef CONFIG
- include $(CONFIG)
-endif
+CONFIG = $(shell ./build-support/factor.sh config-target)
+include $(CONFIG)
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
freetype6.dll:
- wget http://factorcode.org/dlls/freetype6.dll
+ wget $(DLL_PATH)/freetype6.dll
chmod 755 freetype6.dll
zlib1.dll:
- wget http://factorcode.org/dlls/zlib1.dll
+ wget $(DLL_PATH)/zlib1.dll
chmod 755 zlib1.dll
-winnt-x86-32: freetype6.dll zlib1.dll
+windows-dlls: freetype6.dll zlib1.dll
+
+winnt-x86-32: windows-dlls
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
-winnt-x86-64:
+winnt-x86-64: windows-dlls
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
factor-console: $(DLL_OBJS) $(EXE_OBJS)
$(LINKER) $(ENGINE) $(DLL_OBJS)
$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
- $(CFLAGS) $(CFLAGS_CONSOLE) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
+ $(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
clean:
rm -f vm/*.o
USING: accessors kernel combinators math namespaces make assocs
sequences splitting sorting sets strings vectors hashtables
quotations arrays byte-arrays math.parser calendar
-calendar.format present urls
-
+calendar.format present urls fry
io io.encodings io.encodings.iana io.encodings.binary
io.encodings.8-bit io.crlf
-
unicode.case unicode.categories
-
http.parsers ;
-
-EXCLUDE: fry => , ;
-
IN: http
: (read-header) ( -- alist )
" " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
: parse-content-type ( content-type -- type encoding )
- ";" split1 parse-content-type-attributes "charset" swap at
- name>encoding over "text/" head? latin1 binary ? or ;
+ ";" split1
+ parse-content-type-attributes "charset" swap at
+ [ name>encoding ]
+ [ dup "text/" head? latin1 binary ? ] if* ;
-USING: http http.server math sequences continuations tools.test ;
+USING: http http.server math sequences continuations tools.test
+io.encodings.utf8 io.encodings.binary accessors ;
IN: http.server.tests
[ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test
\ make-http-error must-infer
+
+[ "text/plain; charset=UTF-8" ] [
+ <response>
+ "text/plain" >>content-type
+ utf8 >>content-charset
+ unparse-content-type
+] unit-test
+
+[ "text/xml" ] [
+ <response>
+ "text/xml" >>content-type
+ binary >>content-charset
+ unparse-content-type
+] unit-test
\ No newline at end of file
tri ;
: unparse-content-type ( request -- content-type )
- [ content-type>> "application/octet-stream" or ]
- [ content-charset>> encoding>name ]
- bi
- [ "; charset=" glue ] when* ;
+ [ content-type>> "application/octet-stream" or ] [ content-charset>> ] bi
+ dup binary eq? [ drop ] [ encoding>name "; charset=" glue ] if ;
: ensure-domain ( cookie -- cookie )
[
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: xml xml.data kernel io io.encodings interval-maps splitting fry
-math.parser sequences combinators assocs locals accessors math
-arrays values io.encodings.ascii ascii io.files biassocs math.order
-combinators.short-circuit io.binary io.encodings.iana ;
+math.parser sequences combinators assocs locals accessors math arrays
+byte-arrays values io.encodings.ascii ascii io.files biassocs
+math.order combinators.short-circuit io.binary io.encodings.iana ;
IN: io.encodings.chinese
SINGLETON: gb18030
! Resource file from:
! http://source.icu-project.org/repos/icu/data/trunk/charset/data/xml/gb-18030-2000.xml
+! Algorithms from:
+! http://www-128.ibm.com/developerworks/library/u-china.html
+
+: linear ( bytes -- num )
+ ! This hard-codes bMin and bMax
+ reverse first4
+ 10 * + 126 * + 10 * + ; foldable
+
TUPLE: range ufirst ulast bfirst blast ;
: b>byte-array ( string -- byte-array )
{
[ "uFirst" attr hex> ]
[ "uLast" attr hex> ]
- [ "bFirst" attr b>byte-array ]
- [ "bLast" attr b>byte-array ]
+ [ "bFirst" attr b>byte-array linear ]
+ [ "bLast" attr b>byte-array linear ]
} cleave range boa
] dip push ;
] each-element mapping ranges
] ;
-! Algorithms from:
-! http://www-128.ibm.com/developerworks/library/u-china.html
-
-: linear ( bytes -- num )
- ! This hard-codes bMin and bMax
- reverse first4
- 10 * + 126 * + 10 * + ;
-
: unlinear ( num -- bytes )
B{ HEX: 81 HEX: 30 HEX: 81 HEX: 30 } linear -
- 10 /mod swap [ HEX: 30 + ] dip
- 126 /mod swap [ HEX: 81 + ] dip
- 10 /mod swap [ HEX: 30 + ] dip
+ 10 /mod HEX: 30 + swap
+ 126 /mod HEX: 81 + swap
+ 10 /mod HEX: 30 + swap
HEX: 81 +
- B{ } 4sequence reverse ;
+ 4byte-array dup reverse-here ;
: >interval-map-by ( start-quot end-quot value-quot seq -- interval-map )
'[ _ [ @ 2array ] _ tri ] { } map>assoc <interval-map> ; inline
[ ufirst>> ] [ ulast>> ] [ ] >interval-map-by ;
: ranges-gb>u ( ranges -- interval-map )
- [ bfirst>> linear ] [ blast>> linear ] [ ] >interval-map-by ;
+ [ bfirst>> ] [ blast>> ] [ ] >interval-map-by ;
VALUE: gb>u
VALUE: u>gb
: lookup-range ( char -- byte-array )
dup u>gb interval-at [
- [ ufirst>> - ] [ bfirst>> linear ] bi + unlinear
+ [ ufirst>> - ] [ bfirst>> ] bi + unlinear
] [ encode-error ] if* ;
M: gb18030 encode-char ( char stream encoding -- )
: decode-quad ( byte-array -- char )
dup mapping value-at [ ] [
linear dup gb>u interval-at [
- [ bfirst>> linear - ] [ ufirst>> ] bi +
+ [ bfirst>> - ] [ ufirst>> ] bi +
] [ drop replacement-char ] if*
] ?if ;
: four-byte ( stream byte1 byte2 -- char )
rot 2 swap stream-read dup last-bytes?
- [ first2 B{ } 4sequence decode-quad ]
+ [ first2 4byte-array decode-quad ]
[ 3drop replacement-char ] if ;
: two-byte ( stream byte -- char )
over stream-read1 {
{ [ dup not ] [ 3drop replacement-char ] }
- { [ dup second-byte? ] [ B{ } 2sequence mapping value-at nip ] }
+ { [ dup second-byte? ] [ 2byte-array mapping value-at nip ] }
{ [ dup quad-2/4? ] [ four-byte ] }
[ 3drop replacement-char ]
} cond ;
M: gb18030 decode-char ( stream encoding -- char )
drop dup stream-read1 {
{ [ dup not ] [ 2drop f ] }
- { [ dup ascii? ] [ nip 1array B{ } like mapping value-at ] }
+ { [ dup ascii? ] [ nip 1byte-array mapping value-at ] }
{ [ dup quad-1/3? ] [ two-byte ] }
[ 2drop replacement-char ]
} cond ;
USING: io.encodings.iana io.encodings.iana.private
-io.encodings.utf8 tools.test assocs ;
+io.encodings.utf8 tools.test assocs namespaces ;
IN: io.encodings.iana.tests
[ utf8 ] [ "UTF-8" name>encoding ] unit-test
! Clean up after myself
[ ] [
- "EBCDIC-FI-SE-A" n>e-table delete-at
- "csEBCDICFISEA" n>e-table delete-at
- ebcdic-fisea e>n-table delete-at
+ "EBCDIC-FI-SE-A" n>e-table get delete-at
+ "csEBCDICFISEA" n>e-table get delete-at
+ ebcdic-fisea e>n-table get delete-at
] unit-test
[ "EBCDIC-FI-SE-A" name>encoding ] must-fail
[ "csEBCDICFISEA" name>encoding ] must-fail
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel io io.files combinators.short-circuit
-math.order values assocs io.encodings io.binary fry strings
-math io.encodings.ascii arrays accessors splitting math.parser
-biassocs io.encodings.iana ;
+math.order values assocs io.encodings io.binary fry strings math
+io.encodings.ascii arrays byte-arrays accessors splitting
+math.parser biassocs io.encodings.iana ;
IN: io.encodings.japanese
SINGLETON: shift-jis
{ [ 0 HEX: 7F between? ] [ HEX: A1 HEX: DF between? ] } 1|| ;
: write-halfword ( stream halfword -- )
- h>b/b swap B{ } 2sequence swap stream-write ;
+ h>b/b swap 2byte-array swap stream-write ;
M: jis encode-char
swapd ch>jis
USING: io.launcher tools.test calendar accessors environment
namespaces kernel system arrays io io.files io.encodings.ascii
sequences parser assocs hashtables math continuations eval
-io.files.temp io.directories io.pathnames ;
+io.files.temp io.directories io.pathnames splitting ;
IN: io.launcher.windows.nt.tests
[ ] [
[ f ] [ "notepad" get process-running? ] unit-test
+: console-vm ( -- path )
+ vm ".exe" ?tail [ ".com" append ] when ;
+
[ ] [
<process>
- vm "-quiet" "-run=hello-world" 3array >>command
+ console-vm "-quiet" "-run=hello-world" 3array >>command
"out.txt" temp-file >>stdout
try-process
] unit-test
[ ] [
<process>
- vm "-run=listener" 2array >>command
+ console-vm "-run=listener" 2array >>command
+closed+ >>stdin
try-process
] unit-test
[ ] [
launcher-test-path [
<process>
- vm "-script" "stderr.factor" 3array >>command
+ console-vm "-script" "stderr.factor" 3array >>command
"out.txt" temp-file >>stdout
"err.txt" temp-file >>stderr
try-process
[ ] [
launcher-test-path [
<process>
- vm "-script" "stderr.factor" 3array >>command
+ console-vm "-script" "stderr.factor" 3array >>command
"out.txt" temp-file >>stdout
+stdout+ >>stderr
try-process
[ "output" ] [
launcher-test-path [
<process>
- vm "-script" "stderr.factor" 3array >>command
+ console-vm "-script" "stderr.factor" 3array >>command
"err2.txt" temp-file >>stderr
ascii <process-reader> lines first
] with-directory
[ t ] [
launcher-test-path [
<process>
- vm "-script" "env.factor" 3array >>command
+ console-vm "-script" "env.factor" 3array >>command
ascii <process-reader> contents
] with-directory eval
[ t ] [
launcher-test-path [
<process>
- vm "-script" "env.factor" 3array >>command
+ console-vm "-script" "env.factor" 3array >>command
+replace-environment+ >>environment-mode
os-envs >>environment
ascii <process-reader> contents
[ "B" ] [
launcher-test-path [
<process>
- vm "-script" "env.factor" 3array >>command
+ console-vm "-script" "env.factor" 3array >>command
{ { "A" "B" } } >>environment
ascii <process-reader> contents
] with-directory eval
[ f ] [
launcher-test-path [
<process>
- vm "-script" "env.factor" 3array >>command
+ console-vm "-script" "env.factor" 3array >>command
{ { "USERPROFILE" "XXX" } } >>environment
+prepend-environment+ >>environment-mode
ascii <process-reader> contents
2 [
launcher-test-path [
<process>
- vm "-script" "append.factor" 3array >>command
+ console-vm "-script" "append.factor" 3array >>command
"append-test" temp-file <appender> >>stdout
try-process
] with-directory
[
[ no-case ]
] [
- dup peek quotation? [
+ dup peek callable? [
dup peek swap but-last
] [
[ no-case ] swap
Daniel Ehrenberg
+Slava Pestov
--- /dev/null
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup strings math kernel ;
+IN: wrap
+
+ABOUT: "wrap"
+
+ARTICLE: "wrap" "Word wrapping"
+"The " { $vocab-link "wrap" } " vocabulary implements word wrapping. There is support for simple string wrapping, with the following words:"
+{ $subsection wrap-lines }
+{ $subsection wrap-string }
+{ $subsection wrap-indented-string }
+"Additionally, the vocabulary provides capabilities to wrap arbitrary groups of things, in units called words."
+{ $subsection wrap }
+{ $subsection word }
+{ $subsection <word> } ;
+
+HELP: wrap-lines
+{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
+{ $description "Given a string, divides it into a sequence of lines where each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
+
+HELP: wrap-string
+{ $values { "string" string } { "width" integer } { "newstring" string } }
+{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space." } ;
+
+HELP: wrap-indented-string
+{ $values { "string" string } { "width" integer } { "indent" string } { "newstring" string } }
+{ $description "Given a string, alters the whitespace in the string so that each line has no more than " { $snippet "width" } " characters, unless there is a word longer than " { $snippet "width" } ". Linear whitespace between words is converted to a single space. Before each line, the indent string is added." } ;
+
+HELP: wrap
+{ $values { "words" { "a sequence of " { $instance word } "s" } } { "width" integer } { "lines" "a sequence of sequences of words" } }
+{ $description "Divides the words into lines, where the sum of the lengths of the words on a line (not counting breaks at the end of the line) is at most the given width. Every line except for the first one starts with a non-break, and every one but the last ends with a break." } ;
+
+HELP: word
+{ $class-description "A word, for the purposes of " { $vocab-link "wrap" } ", is a Factor object annotated with a length (in the " { $snippet "width" } " slot) and knowledge about whether it is an allowable position for an optional line break (in the " { $snippet "break?" } " slot). Words can be created with " { $link <word> } "." }
+{ $see-also wrap } ;
+
+HELP: <word>
+{ $values { "key" object } { "width" integer } { "break?" { { $link t } " or " { $link POSTPONE: f } } } { "word" word } }
+{ $description "Creates a " { $link word } " object with the given parameters." }
+{ $see-also wrap } ;
-IN: wrap.tests
+! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
USING: tools.test wrap multiline sequences ;
+IN: wrap.tests
[
{
} 35 wrap [ { } like ] map
] unit-test
+[
+ {
+ {
+ T{ word f 1 10 f }
+ T{ word f 2 10 f }
+ T{ word f 3 9 t }
+ T{ word f 3 9 t }
+ T{ word f 3 9 t }
+ }
+ {
+ T{ word f 4 10 f }
+ T{ word f 5 10 f }
+ }
+ }
+] [
+ {
+ T{ word f 1 10 f }
+ T{ word f 2 10 f }
+ T{ word f 3 9 t }
+ T{ word f 3 9 t }
+ T{ word f 3 9 t }
+ T{ word f 4 10 f }
+ T{ word f 5 10 f }
+ } 35 wrap [ { } like ] map
+] unit-test
+
[
<" This is a
long piece
] [
<" This is a long piece of text that we wish to word wrap."> 12
" " wrap-indented-string
-] unit-test
\ No newline at end of file
+] unit-test
+
+[ "this text\nhas lots of\nspaces" ]
+[ "this text has lots of spaces" 12 wrap-string ] unit-test
+
+[ "hello\nhow\nare\nyou\ntoday?" ]
+[ "hello how are you today?" 3 wrap-string ] unit-test
+! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel namespaces make splitting
math math.order fry assocs accessors ;
IN: wrap
: break-here? ( column word -- ? )
break?>> not [ width get > ] [ drop f ] if ;
+: walk ( n words -- n )
+ ! If on a break, take the rest of the breaks
+ ! If not on a break, go back until you hit a break
+ 2dup bounds-check? [
+ 2dup nth break?>>
+ [ [ break?>> not ] find-from drop ]
+ [ [ break?>> ] find-last-from drop 1+ ] if
+ ] [ drop ] if ;
+
: find-optimal-break ( words -- n )
- [ 0 ] dip [ [ width>> + dup ] keep break-here? ] find drop nip ;
+ [ 0 ] keep
+ [ [ width>> + dup ] keep break-here? ] find drop nip
+ [ 1 max swap walk ] [ drop f ] if* ;
: (wrap) ( words -- )
- dup find-optimal-break
- [ 1 max cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* ;
+ [
+ dup find-optimal-break
+ [ cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if*
+ ] unless-empty ;
: intersperse ( seq elt -- seq' )
[ '[ _ , ] [ , ] interleave ] { } make ;
: join-words ( wrapped-lines -- lines )
[
- [ break?>> ]
- [ trim-head-slice ]
- [ trim-tail-slice ] bi
+ [ break?>> ] trim-slice
[ key>> ] map concat
] map ;
set_factor_binary() {
case $OS in
- winnt) FACTOR_BINARY=factor-console.exe;;
+ winnt) FACTOR_BINARY=factor.com;;
*) FACTOR_BINARY=factor;;
esac
}
$ECHO FACTOR_BINARY=$FACTOR_BINARY
$ECHO FACTOR_LIBRARY=$FACTOR_LIBRARY
$ECHO FACTOR_IMAGE=$FACTOR_IMAGE
+ $ECHO CONFIG_TARGET=$CONFIG_TARGET
$ECHO MAKE_TARGET=$MAKE_TARGET
$ECHO BOOT_IMAGE=$BOOT_IMAGE
$ECHO MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET
if [[ $OS == macosx && $ARCH == ppc ]] ; then
MAKE_IMAGE_TARGET=macosx-ppc
MAKE_TARGET=macosx-ppc
+ CONFIG_TARGET=macosx.ppc
elif [[ $OS == linux && $ARCH == ppc ]] ; then
MAKE_IMAGE_TARGET=linux-ppc
MAKE_TARGET=linux-ppc
+ CONFIG_TARGET=linux.ppc
elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then
MAKE_IMAGE_TARGET=winnt-x86.64
MAKE_TARGET=winnt-x86-64
+ CONFIG_TARGET=windows.nt.x86.64
+ elif [[ $OS == winnt && $ARCH == x86 && $WORD == 32 ]] ; then
+ MAKE_IMAGE_TARGET=winnt-x86.32
+ MAKE_TARGET=winnt-x86-32
+ CONFIG_TARGET=windows.nt.x86.32
elif [[ $ARCH == x86 && $WORD == 64 ]] ; then
MAKE_IMAGE_TARGET=unix-x86.64
MAKE_TARGET=$OS-x86-64
+ CONFIG_TARGET=$OS.x86.64
else
MAKE_IMAGE_TARGET=$ARCH.$WORD
MAKE_TARGET=$OS-$ARCH-$WORD
+ CONFIG_TARGET=$OS.$ARCH.$WORD
fi
BOOT_IMAGE=boot.$MAKE_IMAGE_TARGET.image
+ CONFIG_TARGET=vm/Config.$CONFIG_TARGET
}
parse_build_info() {
dlls) get_config_info; maybe_download_dlls;;
net-bootstrap) get_config_info; update_boot_images; bootstrap ;;
make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;;
+ config-target) ECHO=false; find_build_info; echo $CONFIG_TARGET ;;
*) usage ;;
esac
[ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test\r
\r
[ -10 B{ } resize-byte-array ] must-fail\r
+\r
+[ B{ 123 } ] [ 123 1byte-array ] unit-test
\ No newline at end of file
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private alien.accessors sequences
sequences.private math ;
INSTANCE: byte-array sequence
-: 1byte-array ( x -- byte-array ) 1 <byte-array> [ set-first ] keep ; inline
+: 1byte-array ( x -- byte-array ) B{ } 1sequence ; inline
: 2byte-array ( x y -- byte-array ) B{ } 2sequence ; inline
USING: alien strings kernel math tools.test io prettyprint
namespaces combinators words classes sequences accessors
-math.functions ;
+math.functions arrays ;
IN: combinators.tests
! Compiled
\ test-case-7 must-infer
[ "plus" ] [ \ + test-case-7 ] unit-test
+
+! Some corner cases (no pun intended)
+DEFER: corner-case-1
+
+<< \ corner-case-1 2 [ + ] curry 1array [ case ] curry (( a -- b )) define-declared >>
+
+[ t ] [ \ corner-case-1 optimized>> ] unit-test
+[ 4 ] [ 2 corner-case-1 ] unit-test
+
+[ 4 ] [ 2 2 [ + ] curry 1array case ] unit-test
\ No newline at end of file
] [
dup wrapper? [ wrapped>> ] when
] if =
- ] [ quotation? ] if
+ ] [ callable? ] if
] find nip ;
: case ( obj assoc -- )
case-find {
{ [ dup array? ] [ nip second call ] }
- { [ dup quotation? ] [ call ] }
+ { [ dup callable? ] [ call ] }
{ [ dup not ] [ no-case ] }
} cond ;
{ $description "Tries the quotation up to " { $snippet "n" } " times until it returns true. Retries the quotation if an exception is thrown or if the quotation returns " { $link f } ". The quotation is expected to have side effects that may fail, such as generating a random name for a new file until successful." }
{ $examples
"Try to get a 0 as a random number:"
- { $unchecked-example "USING: continuations math prettyprint ;"
- "[ 5 random 0 = ] 5 retry t"
+ { $unchecked-example "USING: continuations math prettyprint random ;"
+ "[ 5 random 0 = ] 5 retry"
"t"
}
} ;
{ $values { "seq" sequence } { "first" "the first element" } { "second" "the second element" } { "third" "the third element" } { "fourth" "the fourth element" } }
{ $contract "Unsafe variant of " { $link first4 } " that does not perform bounds checks." } ;
+HELP: 1sequence
+{ $values { "obj" object } { "exemplar" sequence } { "seq" sequence } }
+{ $description "Creates a one-element sequence of the same type as " { $snippet "exemplar" } "." } ;
+
HELP: 2sequence
{ $values { "obj1" object } { "obj2" object } { "exemplar" sequence } { "seq" sequence } }
{ $description "Creates a two-element sequence of the same type as " { $snippet "exemplar" } "." } ;
: from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
+: (1sequence) ( obj seq -- seq )
+ [ 0 swap set-nth-unsafe ] keep ; inline
+
: (2sequence) ( obj1 obj2 seq -- seq )
[ 1 swap set-nth-unsafe ] keep
- [ 0 swap set-nth-unsafe ] keep ; inline
+ (1sequence) ; inline
: (3sequence) ( obj1 obj2 obj3 seq -- seq )
[ 2 swap set-nth-unsafe ] keep
PRIVATE>
+: 1sequence ( obj exemplar -- seq )
+ 1 swap [ (1sequence) ] new-like ; inline
+
: 2sequence ( obj1 obj2 exemplar -- seq )
2 swap [ (2sequence) ] new-like ; inline
[ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test
[ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test
+
+[ V{ "lulz" } ] [ "lulz" 1vector ] unit-test
\ No newline at end of file
INSTANCE: vector growable
-: 1vector ( x -- vector ) 1array >vector ;
+: 1vector ( x -- vector ) V{ } 1sequence ;
: ?push ( elt seq/f -- seq )
[ 1 <vector> ] unless* [ push ] keep ;
{ nipd 3 }\r
{ nkeep 5 }\r
{ npick 6 }\r
- { nrev 5 }\r
{ nrot 5 }\r
{ nslip 5 }\r
{ ntuck 6 }\r
LIBS = -lm
PLAF_DLL_OBJS += vm/os-windows.o
EXE_EXTENSION=.exe
+CONSOLE_EXTENSION=.com
DLL_EXTENSION=.dll
LINKER = $(CC) -shared -mno-cygwin -o
LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX)
PLAF_EXE_OBJS += vm/main-windows-nt.o
CFLAGS += -mwindows
CFLAGS_CONSOLE += -mconsole
+CONSOLE_EXTENSION = .com
include vm/Config.windows
+DLL_PATH=http://factorcode.org/dlls
WINDRES=windres
include vm/Config.windows.nt
include vm/Config.x86.32
+#error "lol"
+DLL_PATH=http://factorcode.org/dlls/64
CC=$(WIN64_PATH)-gcc.exe
WINDRES=$(WIN64_PATH)-windres.exe
include vm/Config.windows.nt
snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
temp_path[sizeof(temp_path) - 1] = 0;
- if(!windows_stat(temp_path)) {
- unsigned int len = wcslen(full_path);
- F_CHAR magic[] = L"-console";
- unsigned int magic_len = wcslen(magic);
-
- if(!wcsncmp(full_path + len - magic_len, magic, MIN(len, magic_len)))
- full_path[len - magic_len] = 0;
- snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
- temp_path[sizeof(temp_path) - 1] = 0;
- }
-
return safe_strdup(temp_path);
}
projects / factor.git / commitdiff