diff --git a/.gitignore b/.gitignore index 05a53c02c6..435595f502 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,7 @@ Factor/factor *.image *.dylib factor +factor.com *#*# .DS_Store .gdb_history diff --git a/Makefile b/Makefile index b41e756729..e84a5f9c5a 100644 --- a/Makefile +++ b/Makefile @@ -17,9 +17,8 @@ else 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) @@ -130,18 +129,20 @@ solaris-x86-64: $(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 @@ -167,7 +168,7 @@ factor: $(DLL_OBJS) $(EXE_OBJS) 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 diff --git a/basis/http/http.factor b/basis/http/http.factor index cda3460c71..2b5414b299 100755 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -3,17 +3,11 @@ 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 ) @@ -217,5 +211,7 @@ TUPLE: post-data data params content-type content-encoding ; " " 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* ; diff --git a/basis/http/server/server-tests.factor b/basis/http/server/server-tests.factor index fdba9a63ef..171973fcd8 100644 --- a/basis/http/server/server-tests.factor +++ b/basis/http/server/server-tests.factor @@ -1,6 +1,21 @@ -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" ] [ + + "text/plain" >>content-type + utf8 >>content-charset + unparse-content-type +] unit-test + +[ "text/xml" ] [ + + "text/xml" >>content-type + binary >>content-charset + unparse-content-type +] unit-test \ No newline at end of file diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 97c14a6457..b6ee70057b 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -97,10 +97,8 @@ GENERIC: write-full-response ( request response -- ) 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 ) [ diff --git a/basis/io/encodings/chinese/chinese.factor b/basis/io/encodings/chinese/chinese.factor index 01ddb810ba..b0013b6e08 100644 --- a/basis/io/encodings/chinese/chinese.factor +++ b/basis/io/encodings/chinese/chinese.factor @@ -1,9 +1,9 @@ ! 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 @@ -17,6 +17,14 @@ gb18030 "GB18030" register-encoding ! 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 ) @@ -27,8 +35,8 @@ TUPLE: range ufirst ulast bfirst blast ; { [ "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 ; @@ -51,21 +59,13 @@ TUPLE: range ufirst ulast bfirst blast ; ] 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 ; inline @@ -74,7 +74,7 @@ TUPLE: range ufirst ulast bfirst blast ; [ 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 @@ -87,7 +87,7 @@ ascii xml>gb-data : 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 -- ) @@ -109,19 +109,19 @@ 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 ; @@ -129,7 +129,7 @@ M: gb18030 encode-char ( char stream encoding -- ) 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 ; diff --git a/basis/io/encodings/iana/iana-tests.factor b/basis/io/encodings/iana/iana-tests.factor index 5ffcc161d4..3175e624ce 100644 --- a/basis/io/encodings/iana/iana-tests.factor +++ b/basis/io/encodings/iana/iana-tests.factor @@ -1,5 +1,5 @@ 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 @@ -15,9 +15,9 @@ ebcdic-fisea "EBCDIC-FI-SE-A" register-encoding ! 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 diff --git a/basis/io/encodings/japanese/japanese.factor b/basis/io/encodings/japanese/japanese.factor index e3257ad63e..194ade377b 100644 --- a/basis/io/encodings/japanese/japanese.factor +++ b/basis/io/encodings/japanese/japanese.factor @@ -1,9 +1,9 @@ ! 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 @@ -55,7 +55,7 @@ make-jis to: shift-jis-table { [ 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 diff --git a/basis/io/launcher/windows/nt/nt-tests.factor b/basis/io/launcher/windows/nt/nt-tests.factor index 93b1e8c2ff..4dd0eebed3 100644 --- a/basis/io/launcher/windows/nt/nt-tests.factor +++ b/basis/io/launcher/windows/nt/nt-tests.factor @@ -1,7 +1,7 @@ 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 [ ] [ @@ -23,9 +23,12 @@ IN: io.launcher.windows.nt.tests [ f ] [ "notepad" get process-running? ] unit-test +: console-vm ( -- path ) + vm ".exe" ?tail [ ".com" append ] when ; + [ ] [ - vm "-quiet" "-run=hello-world" 3array >>command + console-vm "-quiet" "-run=hello-world" 3array >>command "out.txt" temp-file >>stdout try-process ] unit-test @@ -36,7 +39,7 @@ IN: io.launcher.windows.nt.tests [ ] [ - vm "-run=listener" 2array >>command + console-vm "-run=listener" 2array >>command +closed+ >>stdin try-process ] unit-test @@ -47,7 +50,7 @@ IN: io.launcher.windows.nt.tests [ ] [ launcher-test-path [ - 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 @@ -65,7 +68,7 @@ IN: io.launcher.windows.nt.tests [ ] [ launcher-test-path [ - vm "-script" "stderr.factor" 3array >>command + console-vm "-script" "stderr.factor" 3array >>command "out.txt" temp-file >>stdout +stdout+ >>stderr try-process @@ -79,7 +82,7 @@ IN: io.launcher.windows.nt.tests [ "output" ] [ launcher-test-path [ - vm "-script" "stderr.factor" 3array >>command + console-vm "-script" "stderr.factor" 3array >>command "err2.txt" temp-file >>stderr ascii lines first ] with-directory @@ -92,7 +95,7 @@ IN: io.launcher.windows.nt.tests [ t ] [ launcher-test-path [ - vm "-script" "env.factor" 3array >>command + console-vm "-script" "env.factor" 3array >>command ascii contents ] with-directory eval @@ -102,7 +105,7 @@ IN: io.launcher.windows.nt.tests [ t ] [ launcher-test-path [ - vm "-script" "env.factor" 3array >>command + console-vm "-script" "env.factor" 3array >>command +replace-environment+ >>environment-mode os-envs >>environment ascii contents @@ -114,7 +117,7 @@ IN: io.launcher.windows.nt.tests [ "B" ] [ launcher-test-path [ - vm "-script" "env.factor" 3array >>command + console-vm "-script" "env.factor" 3array >>command { { "A" "B" } } >>environment ascii contents ] with-directory eval @@ -125,7 +128,7 @@ IN: io.launcher.windows.nt.tests [ f ] [ launcher-test-path [ - vm "-script" "env.factor" 3array >>command + console-vm "-script" "env.factor" 3array >>command { { "USERPROFILE" "XXX" } } >>environment +prepend-environment+ >>environment-mode ascii contents @@ -151,7 +154,7 @@ IN: io.launcher.windows.nt.tests 2 [ launcher-test-path [ - vm "-script" "append.factor" 3array >>command + console-vm "-script" "append.factor" 3array >>command "append-test" temp-file >>stdout try-process ] with-directory diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 7afac0440f..808ea6a141 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/basis/stack-checker/transforms/transforms.factor @@ -70,7 +70,7 @@ IN: stack-checker.transforms [ [ no-case ] ] [ - dup peek quotation? [ + dup peek callable? [ dup peek swap but-last ] [ [ no-case ] swap diff --git a/basis/wrap/authors.txt b/basis/wrap/authors.txt index f990dd0ed2..33616a2d6a 100644 --- a/basis/wrap/authors.txt +++ b/basis/wrap/authors.txt @@ -1 +1,2 @@ Daniel Ehrenberg +Slava Pestov diff --git a/basis/wrap/wrap-docs.factor b/basis/wrap/wrap-docs.factor new file mode 100644 index 0000000000..c94e12907f --- /dev/null +++ b/basis/wrap/wrap-docs.factor @@ -0,0 +1,41 @@ +! 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 } ; + +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 } "." } +{ $see-also wrap } ; + +HELP: +{ $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 } ; diff --git a/basis/wrap/wrap-tests.factor b/basis/wrap/wrap-tests.factor index b2d18761e2..ba5168a1c2 100644 --- a/basis/wrap/wrap-tests.factor +++ b/basis/wrap/wrap-tests.factor @@ -1,5 +1,7 @@ -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 [ { @@ -23,6 +25,32 @@ USING: tools.test wrap multiline sequences ; } 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 @@ -45,4 +73,10 @@ word wrap."> ] [ <" 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 diff --git a/basis/wrap/wrap.factor b/basis/wrap/wrap.factor index 8e4e2753a8..e93509b58e 100644 --- a/basis/wrap/wrap.factor +++ b/basis/wrap/wrap.factor @@ -1,3 +1,5 @@ +! 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 @@ -15,12 +17,25 @@ SYMBOL: width : 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 ; @@ -34,9 +49,7 @@ SYMBOL: width : join-words ( wrapped-lines -- lines ) [ - [ break?>> ] - [ trim-head-slice ] - [ trim-tail-slice ] bi + [ break?>> ] trim-slice [ key>> ] map concat ] map ; diff --git a/build-support/factor.sh b/build-support/factor.sh index 44c047155d..e70ef40e5c 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -236,7 +236,7 @@ find_word_size() { set_factor_binary() { case $OS in - winnt) FACTOR_BINARY=factor-console.exe;; + winnt) FACTOR_BINARY=factor.com;; *) FACTOR_BINARY=factor;; esac } @@ -260,6 +260,7 @@ echo_build_info() { $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 @@ -289,20 +290,30 @@ set_build_info() { 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() { @@ -570,5 +581,6 @@ case "$1" in 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 diff --git a/core/byte-arrays/byte-arrays-tests.factor b/core/byte-arrays/byte-arrays-tests.factor index edaea108a1..1c3e4d3bdf 100644 --- a/core/byte-arrays/byte-arrays-tests.factor +++ b/core/byte-arrays/byte-arrays-tests.factor @@ -9,3 +9,5 @@ USING: tools.test byte-arrays sequences kernel ; [ B{ 1 2 } ] [ 2 B{ 1 2 3 4 5 6 7 8 9 } resize-byte-array ] unit-test [ -10 B{ } resize-byte-array ] must-fail + +[ B{ 123 } ] [ 123 1byte-array ] unit-test \ No newline at end of file diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor index f0d188ce4a..72989ac447 100644 --- a/core/byte-arrays/byte-arrays.factor +++ b/core/byte-arrays/byte-arrays.factor @@ -1,4 +1,4 @@ -! 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 ; @@ -19,7 +19,7 @@ M: byte-array resize INSTANCE: byte-array sequence -: 1byte-array ( x -- byte-array ) 1 [ set-first ] keep ; inline +: 1byte-array ( x -- byte-array ) B{ } 1sequence ; inline : 2byte-array ( x y -- byte-array ) B{ } 2sequence ; inline diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor index 5a56d2b636..1a73e22e31 100644 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -1,6 +1,6 @@ USING: alien strings kernel math tools.test io prettyprint namespaces combinators words classes sequences accessors -math.functions ; +math.functions arrays ; IN: combinators.tests ! Compiled @@ -314,3 +314,13 @@ IN: combinators.tests \ 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 diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index c4c18c1c62..e356a6d246 100755 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -59,13 +59,13 @@ ERROR: no-case ; ] [ 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 ; diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 2cc44bee1b..2bf59f7780 100644 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -246,8 +246,8 @@ HELP: retry { $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" } } ; diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor index f213be4fe7..6ca782a202 100755 --- a/core/sequences/sequences-docs.factor +++ b/core/sequences/sequences-docs.factor @@ -207,6 +207,10 @@ HELP: first4-unsafe { $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" } "." } ; diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 2c30a62fe3..9e64cfa536 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -137,9 +137,12 @@ INSTANCE: iota immutable-sequence : 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 @@ -151,6 +154,9 @@ INSTANCE: iota immutable-sequence PRIVATE> +: 1sequence ( obj exemplar -- seq ) + 1 swap [ (1sequence) ] new-like ; inline + : 2sequence ( obj1 obj2 exemplar -- seq ) 2 swap [ (2sequence) ] new-like ; inline diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor index f2e29d79e8..12e2ea49f7 100644 --- a/core/vectors/vectors-tests.factor +++ b/core/vectors/vectors-tests.factor @@ -97,3 +97,5 @@ IN: vectors.tests [ 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 diff --git a/core/vectors/vectors.factor b/core/vectors/vectors.factor index a6bfef71d0..1bdda7b69d 100644 --- a/core/vectors/vectors.factor +++ b/core/vectors/vectors.factor @@ -40,7 +40,7 @@ M: sequence new-resizable drop ; INSTANCE: vector growable -: 1vector ( x -- vector ) 1array >vector ; +: 1vector ( x -- vector ) V{ } 1sequence ; : ?push ( elt seq/f -- seq ) [ 1 ] unless* [ push ] keep ; diff --git a/extra/reports/noise/noise.factor b/extra/reports/noise/noise.factor index 1ce7f9c726..3e47adac0b 100755 --- a/extra/reports/noise/noise.factor +++ b/extra/reports/noise/noise.factor @@ -53,7 +53,6 @@ IN: reports.noise { nipd 3 } { nkeep 5 } { npick 6 } - { nrev 5 } { nrot 5 } { nslip 5 } { ntuck 6 } diff --git a/vm/Config.windows b/vm/Config.windows index 41eca86b5c..45d2f0cb98 100644 --- a/vm/Config.windows +++ b/vm/Config.windows @@ -2,6 +2,7 @@ CFLAGS += -DWINDOWS -mno-cygwin 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) diff --git a/vm/Config.windows.nt b/vm/Config.windows.nt index de28ba64ba..ffaa899fe1 100644 --- a/vm/Config.windows.nt +++ b/vm/Config.windows.nt @@ -6,4 +6,5 @@ PLAF_EXE_OBJS += vm/resources.o PLAF_EXE_OBJS += vm/main-windows-nt.o CFLAGS += -mwindows CFLAGS_CONSOLE += -mconsole +CONSOLE_EXTENSION = .com include vm/Config.windows diff --git a/vm/Config.windows.nt.x86.32 b/vm/Config.windows.nt.x86.32 index 9a020a7bc1..d27629fe83 100644 --- a/vm/Config.windows.nt.x86.32 +++ b/vm/Config.windows.nt.x86.32 @@ -1,3 +1,4 @@ +DLL_PATH=http://factorcode.org/dlls WINDRES=windres include vm/Config.windows.nt include vm/Config.x86.32 diff --git a/vm/Config.windows.nt.x86.64 b/vm/Config.windows.nt.x86.64 index f0c0a068cb..13ef665b19 100644 --- a/vm/Config.windows.nt.x86.64 +++ b/vm/Config.windows.nt.x86.64 @@ -1,3 +1,5 @@ +#error "lol" +DLL_PATH=http://factorcode.org/dlls/64 CC=$(WIN64_PATH)-gcc.exe WINDRES=$(WIN64_PATH)-windres.exe include vm/Config.windows.nt diff --git a/vm/os-windows.c b/vm/os-windows.c index c4d29ea57f..2abc04cb3b 100755 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -109,17 +109,6 @@ const F_CHAR *default_image_path(void) 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); }