Merge branch 'master' of git://factorcode.org/git/factor
commit
7ae06b0d27
|
@ -11,6 +11,7 @@ Factor/factor
|
||||||
*.image
|
*.image
|
||||||
*.dylib
|
*.dylib
|
||||||
factor
|
factor
|
||||||
|
factor.com
|
||||||
*#*#
|
*#*#
|
||||||
.DS_Store
|
.DS_Store
|
||||||
.gdb_history
|
.gdb_history
|
||||||
|
|
17
Makefile
17
Makefile
|
@ -17,9 +17,8 @@ else
|
||||||
CFLAGS += -O3 $(SITE_CFLAGS)
|
CFLAGS += -O3 $(SITE_CFLAGS)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
ifdef CONFIG
|
CONFIG = $(shell ./build-support/factor.sh config-target)
|
||||||
include $(CONFIG)
|
include $(CONFIG)
|
||||||
endif
|
|
||||||
|
|
||||||
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
|
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
|
||||||
|
|
||||||
|
@ -130,18 +129,20 @@ solaris-x86-64:
|
||||||
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
|
$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64
|
||||||
|
|
||||||
freetype6.dll:
|
freetype6.dll:
|
||||||
wget http://factorcode.org/dlls/freetype6.dll
|
wget $(DLL_PATH)/freetype6.dll
|
||||||
chmod 755 freetype6.dll
|
chmod 755 freetype6.dll
|
||||||
|
|
||||||
zlib1.dll:
|
zlib1.dll:
|
||||||
wget http://factorcode.org/dlls/zlib1.dll
|
wget $(DLL_PATH)/zlib1.dll
|
||||||
chmod 755 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) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
|
||||||
$(MAKE) $(CONSOLE_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) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
|
||||||
$(MAKE) $(CONSOLE_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)
|
factor-console: $(DLL_OBJS) $(EXE_OBJS)
|
||||||
$(LINKER) $(ENGINE) $(DLL_OBJS)
|
$(LINKER) $(ENGINE) $(DLL_OBJS)
|
||||||
$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
|
$(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:
|
clean:
|
||||||
rm -f vm/*.o
|
rm -f vm/*.o
|
||||||
|
|
|
@ -3,17 +3,11 @@
|
||||||
USING: accessors kernel combinators math namespaces make assocs
|
USING: accessors kernel combinators math namespaces make assocs
|
||||||
sequences splitting sorting sets strings vectors hashtables
|
sequences splitting sorting sets strings vectors hashtables
|
||||||
quotations arrays byte-arrays math.parser calendar
|
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 io.encodings io.encodings.iana io.encodings.binary
|
||||||
io.encodings.8-bit io.crlf
|
io.encodings.8-bit io.crlf
|
||||||
|
|
||||||
unicode.case unicode.categories
|
unicode.case unicode.categories
|
||||||
|
|
||||||
http.parsers ;
|
http.parsers ;
|
||||||
|
|
||||||
EXCLUDE: fry => , ;
|
|
||||||
|
|
||||||
IN: http
|
IN: http
|
||||||
|
|
||||||
: (read-header) ( -- alist )
|
: (read-header) ( -- alist )
|
||||||
|
@ -217,5 +211,7 @@ TUPLE: post-data data params content-type content-encoding ;
|
||||||
" " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
|
" " split harvest [ "=" split1 [ >lower ] dip ] { } map>assoc ;
|
||||||
|
|
||||||
: parse-content-type ( content-type -- type encoding )
|
: parse-content-type ( content-type -- type encoding )
|
||||||
";" split1 parse-content-type-attributes "charset" swap at
|
";" split1
|
||||||
name>encoding over "text/" head? latin1 binary ? or ;
|
parse-content-type-attributes "charset" swap at
|
||||||
|
[ name>encoding ]
|
||||||
|
[ dup "text/" head? latin1 binary ? ] if* ;
|
||||||
|
|
|
@ -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
|
IN: http.server.tests
|
||||||
|
|
||||||
[ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test
|
[ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test
|
||||||
|
|
||||||
\ make-http-error must-infer
|
\ 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
|
|
@ -97,10 +97,8 @@ GENERIC: write-full-response ( request response -- )
|
||||||
tri ;
|
tri ;
|
||||||
|
|
||||||
: unparse-content-type ( request -- content-type )
|
: unparse-content-type ( request -- content-type )
|
||||||
[ content-type>> "application/octet-stream" or ]
|
[ content-type>> "application/octet-stream" or ] [ content-charset>> ] bi
|
||||||
[ content-charset>> encoding>name ]
|
dup binary eq? [ drop ] [ encoding>name "; charset=" glue ] if ;
|
||||||
bi
|
|
||||||
[ "; charset=" glue ] when* ;
|
|
||||||
|
|
||||||
: ensure-domain ( cookie -- cookie )
|
: ensure-domain ( cookie -- cookie )
|
||||||
[
|
[
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2009 Daniel Ehrenberg
|
! Copyright (C) 2009 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: xml xml.data kernel io io.encodings interval-maps splitting fry
|
USING: xml xml.data kernel io io.encodings interval-maps splitting fry
|
||||||
math.parser sequences combinators assocs locals accessors math
|
math.parser sequences combinators assocs locals accessors math arrays
|
||||||
arrays values io.encodings.ascii ascii io.files biassocs math.order
|
byte-arrays values io.encodings.ascii ascii io.files biassocs
|
||||||
combinators.short-circuit io.binary io.encodings.iana ;
|
math.order combinators.short-circuit io.binary io.encodings.iana ;
|
||||||
IN: io.encodings.chinese
|
IN: io.encodings.chinese
|
||||||
|
|
||||||
SINGLETON: gb18030
|
SINGLETON: gb18030
|
||||||
|
@ -17,6 +17,14 @@ gb18030 "GB18030" register-encoding
|
||||||
! Resource file from:
|
! Resource file from:
|
||||||
! http://source.icu-project.org/repos/icu/data/trunk/charset/data/xml/gb-18030-2000.xml
|
! 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 ;
|
TUPLE: range ufirst ulast bfirst blast ;
|
||||||
|
|
||||||
: b>byte-array ( string -- byte-array )
|
: b>byte-array ( string -- byte-array )
|
||||||
|
@ -27,8 +35,8 @@ TUPLE: range ufirst ulast bfirst blast ;
|
||||||
{
|
{
|
||||||
[ "uFirst" attr hex> ]
|
[ "uFirst" attr hex> ]
|
||||||
[ "uLast" attr hex> ]
|
[ "uLast" attr hex> ]
|
||||||
[ "bFirst" attr b>byte-array ]
|
[ "bFirst" attr b>byte-array linear ]
|
||||||
[ "bLast" attr b>byte-array ]
|
[ "bLast" attr b>byte-array linear ]
|
||||||
} cleave range boa
|
} cleave range boa
|
||||||
] dip push ;
|
] dip push ;
|
||||||
|
|
||||||
|
@ -51,21 +59,13 @@ TUPLE: range ufirst ulast bfirst blast ;
|
||||||
] each-element mapping ranges
|
] 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 )
|
: unlinear ( num -- bytes )
|
||||||
B{ HEX: 81 HEX: 30 HEX: 81 HEX: 30 } linear -
|
B{ HEX: 81 HEX: 30 HEX: 81 HEX: 30 } linear -
|
||||||
10 /mod swap [ HEX: 30 + ] dip
|
10 /mod HEX: 30 + swap
|
||||||
126 /mod swap [ HEX: 81 + ] dip
|
126 /mod HEX: 81 + swap
|
||||||
10 /mod swap [ HEX: 30 + ] dip
|
10 /mod HEX: 30 + swap
|
||||||
HEX: 81 +
|
HEX: 81 +
|
||||||
B{ } 4sequence reverse ;
|
4byte-array dup reverse-here ;
|
||||||
|
|
||||||
: >interval-map-by ( start-quot end-quot value-quot seq -- interval-map )
|
: >interval-map-by ( start-quot end-quot value-quot seq -- interval-map )
|
||||||
'[ _ [ @ 2array ] _ tri ] { } map>assoc <interval-map> ; inline
|
'[ _ [ @ 2array ] _ tri ] { } map>assoc <interval-map> ; inline
|
||||||
|
@ -74,7 +74,7 @@ TUPLE: range ufirst ulast bfirst blast ;
|
||||||
[ ufirst>> ] [ ulast>> ] [ ] >interval-map-by ;
|
[ ufirst>> ] [ ulast>> ] [ ] >interval-map-by ;
|
||||||
|
|
||||||
: ranges-gb>u ( ranges -- interval-map )
|
: ranges-gb>u ( ranges -- interval-map )
|
||||||
[ bfirst>> linear ] [ blast>> linear ] [ ] >interval-map-by ;
|
[ bfirst>> ] [ blast>> ] [ ] >interval-map-by ;
|
||||||
|
|
||||||
VALUE: gb>u
|
VALUE: gb>u
|
||||||
VALUE: u>gb
|
VALUE: u>gb
|
||||||
|
@ -87,7 +87,7 @@ ascii <file-reader> xml>gb-data
|
||||||
|
|
||||||
: lookup-range ( char -- byte-array )
|
: lookup-range ( char -- byte-array )
|
||||||
dup u>gb interval-at [
|
dup u>gb interval-at [
|
||||||
[ ufirst>> - ] [ bfirst>> linear ] bi + unlinear
|
[ ufirst>> - ] [ bfirst>> ] bi + unlinear
|
||||||
] [ encode-error ] if* ;
|
] [ encode-error ] if* ;
|
||||||
|
|
||||||
M: gb18030 encode-char ( char stream encoding -- )
|
M: gb18030 encode-char ( char stream encoding -- )
|
||||||
|
@ -109,19 +109,19 @@ M: gb18030 encode-char ( char stream encoding -- )
|
||||||
: decode-quad ( byte-array -- char )
|
: decode-quad ( byte-array -- char )
|
||||||
dup mapping value-at [ ] [
|
dup mapping value-at [ ] [
|
||||||
linear dup gb>u interval-at [
|
linear dup gb>u interval-at [
|
||||||
[ bfirst>> linear - ] [ ufirst>> ] bi +
|
[ bfirst>> - ] [ ufirst>> ] bi +
|
||||||
] [ drop replacement-char ] if*
|
] [ drop replacement-char ] if*
|
||||||
] ?if ;
|
] ?if ;
|
||||||
|
|
||||||
: four-byte ( stream byte1 byte2 -- char )
|
: four-byte ( stream byte1 byte2 -- char )
|
||||||
rot 2 swap stream-read dup last-bytes?
|
rot 2 swap stream-read dup last-bytes?
|
||||||
[ first2 B{ } 4sequence decode-quad ]
|
[ first2 4byte-array decode-quad ]
|
||||||
[ 3drop replacement-char ] if ;
|
[ 3drop replacement-char ] if ;
|
||||||
|
|
||||||
: two-byte ( stream byte -- char )
|
: two-byte ( stream byte -- char )
|
||||||
over stream-read1 {
|
over stream-read1 {
|
||||||
{ [ dup not ] [ 3drop replacement-char ] }
|
{ [ 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 ] }
|
{ [ dup quad-2/4? ] [ four-byte ] }
|
||||||
[ 3drop replacement-char ]
|
[ 3drop replacement-char ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
@ -129,7 +129,7 @@ M: gb18030 encode-char ( char stream encoding -- )
|
||||||
M: gb18030 decode-char ( stream encoding -- char )
|
M: gb18030 decode-char ( stream encoding -- char )
|
||||||
drop dup stream-read1 {
|
drop dup stream-read1 {
|
||||||
{ [ dup not ] [ 2drop f ] }
|
{ [ 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 ] }
|
{ [ dup quad-1/3? ] [ two-byte ] }
|
||||||
[ 2drop replacement-char ]
|
[ 2drop replacement-char ]
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: io.encodings.iana io.encodings.iana.private
|
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
|
IN: io.encodings.iana.tests
|
||||||
|
|
||||||
[ utf8 ] [ "UTF-8" name>encoding ] unit-test
|
[ utf8 ] [ "UTF-8" name>encoding ] unit-test
|
||||||
|
@ -15,9 +15,9 @@ ebcdic-fisea "EBCDIC-FI-SE-A" register-encoding
|
||||||
|
|
||||||
! Clean up after myself
|
! Clean up after myself
|
||||||
[ ] [
|
[ ] [
|
||||||
"EBCDIC-FI-SE-A" n>e-table delete-at
|
"EBCDIC-FI-SE-A" n>e-table get delete-at
|
||||||
"csEBCDICFISEA" n>e-table delete-at
|
"csEBCDICFISEA" n>e-table get delete-at
|
||||||
ebcdic-fisea e>n-table delete-at
|
ebcdic-fisea e>n-table get delete-at
|
||||||
] unit-test
|
] unit-test
|
||||||
[ "EBCDIC-FI-SE-A" name>encoding ] must-fail
|
[ "EBCDIC-FI-SE-A" name>encoding ] must-fail
|
||||||
[ "csEBCDICFISEA" name>encoding ] must-fail
|
[ "csEBCDICFISEA" name>encoding ] must-fail
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! Copyright (C) 2009 Daniel Ehrenberg
|
! Copyright (C) 2009 Daniel Ehrenberg
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: sequences kernel io io.files combinators.short-circuit
|
USING: sequences kernel io io.files combinators.short-circuit
|
||||||
math.order values assocs io.encodings io.binary fry strings
|
math.order values assocs io.encodings io.binary fry strings math
|
||||||
math io.encodings.ascii arrays accessors splitting math.parser
|
io.encodings.ascii arrays byte-arrays accessors splitting
|
||||||
biassocs io.encodings.iana ;
|
math.parser biassocs io.encodings.iana ;
|
||||||
IN: io.encodings.japanese
|
IN: io.encodings.japanese
|
||||||
|
|
||||||
SINGLETON: shift-jis
|
SINGLETON: shift-jis
|
||||||
|
@ -55,7 +55,7 @@ make-jis to: shift-jis-table
|
||||||
{ [ 0 HEX: 7F between? ] [ HEX: A1 HEX: DF between? ] } 1|| ;
|
{ [ 0 HEX: 7F between? ] [ HEX: A1 HEX: DF between? ] } 1|| ;
|
||||||
|
|
||||||
: write-halfword ( stream halfword -- )
|
: 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
|
M: jis encode-char
|
||||||
swapd ch>jis
|
swapd ch>jis
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
USING: io.launcher tools.test calendar accessors environment
|
USING: io.launcher tools.test calendar accessors environment
|
||||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||||
sequences parser assocs hashtables math continuations eval
|
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
|
IN: io.launcher.windows.nt.tests
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
|
@ -23,9 +23,12 @@ IN: io.launcher.windows.nt.tests
|
||||||
|
|
||||||
[ f ] [ "notepad" get process-running? ] unit-test
|
[ f ] [ "notepad" get process-running? ] unit-test
|
||||||
|
|
||||||
|
: console-vm ( -- path )
|
||||||
|
vm ".exe" ?tail [ ".com" append ] when ;
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
<process>
|
<process>
|
||||||
vm "-quiet" "-run=hello-world" 3array >>command
|
console-vm "-quiet" "-run=hello-world" 3array >>command
|
||||||
"out.txt" temp-file >>stdout
|
"out.txt" temp-file >>stdout
|
||||||
try-process
|
try-process
|
||||||
] unit-test
|
] unit-test
|
||||||
|
@ -36,7 +39,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
<process>
|
<process>
|
||||||
vm "-run=listener" 2array >>command
|
console-vm "-run=listener" 2array >>command
|
||||||
+closed+ >>stdin
|
+closed+ >>stdin
|
||||||
try-process
|
try-process
|
||||||
] unit-test
|
] unit-test
|
||||||
|
@ -47,7 +50,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
[ ] [
|
[ ] [
|
||||||
launcher-test-path [
|
launcher-test-path [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "stderr.factor" 3array >>command
|
console-vm "-script" "stderr.factor" 3array >>command
|
||||||
"out.txt" temp-file >>stdout
|
"out.txt" temp-file >>stdout
|
||||||
"err.txt" temp-file >>stderr
|
"err.txt" temp-file >>stderr
|
||||||
try-process
|
try-process
|
||||||
|
@ -65,7 +68,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
[ ] [
|
[ ] [
|
||||||
launcher-test-path [
|
launcher-test-path [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "stderr.factor" 3array >>command
|
console-vm "-script" "stderr.factor" 3array >>command
|
||||||
"out.txt" temp-file >>stdout
|
"out.txt" temp-file >>stdout
|
||||||
+stdout+ >>stderr
|
+stdout+ >>stderr
|
||||||
try-process
|
try-process
|
||||||
|
@ -79,7 +82,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
[ "output" ] [
|
[ "output" ] [
|
||||||
launcher-test-path [
|
launcher-test-path [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "stderr.factor" 3array >>command
|
console-vm "-script" "stderr.factor" 3array >>command
|
||||||
"err2.txt" temp-file >>stderr
|
"err2.txt" temp-file >>stderr
|
||||||
ascii <process-reader> lines first
|
ascii <process-reader> lines first
|
||||||
] with-directory
|
] with-directory
|
||||||
|
@ -92,7 +95,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
[ t ] [
|
[ t ] [
|
||||||
launcher-test-path [
|
launcher-test-path [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "env.factor" 3array >>command
|
console-vm "-script" "env.factor" 3array >>command
|
||||||
ascii <process-reader> contents
|
ascii <process-reader> contents
|
||||||
] with-directory eval
|
] with-directory eval
|
||||||
|
|
||||||
|
@ -102,7 +105,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
[ t ] [
|
[ t ] [
|
||||||
launcher-test-path [
|
launcher-test-path [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "env.factor" 3array >>command
|
console-vm "-script" "env.factor" 3array >>command
|
||||||
+replace-environment+ >>environment-mode
|
+replace-environment+ >>environment-mode
|
||||||
os-envs >>environment
|
os-envs >>environment
|
||||||
ascii <process-reader> contents
|
ascii <process-reader> contents
|
||||||
|
@ -114,7 +117,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
[ "B" ] [
|
[ "B" ] [
|
||||||
launcher-test-path [
|
launcher-test-path [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "env.factor" 3array >>command
|
console-vm "-script" "env.factor" 3array >>command
|
||||||
{ { "A" "B" } } >>environment
|
{ { "A" "B" } } >>environment
|
||||||
ascii <process-reader> contents
|
ascii <process-reader> contents
|
||||||
] with-directory eval
|
] with-directory eval
|
||||||
|
@ -125,7 +128,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
[ f ] [
|
[ f ] [
|
||||||
launcher-test-path [
|
launcher-test-path [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "env.factor" 3array >>command
|
console-vm "-script" "env.factor" 3array >>command
|
||||||
{ { "USERPROFILE" "XXX" } } >>environment
|
{ { "USERPROFILE" "XXX" } } >>environment
|
||||||
+prepend-environment+ >>environment-mode
|
+prepend-environment+ >>environment-mode
|
||||||
ascii <process-reader> contents
|
ascii <process-reader> contents
|
||||||
|
@ -151,7 +154,7 @@ IN: io.launcher.windows.nt.tests
|
||||||
2 [
|
2 [
|
||||||
launcher-test-path [
|
launcher-test-path [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "append.factor" 3array >>command
|
console-vm "-script" "append.factor" 3array >>command
|
||||||
"append-test" temp-file <appender> >>stdout
|
"append-test" temp-file <appender> >>stdout
|
||||||
try-process
|
try-process
|
||||||
] with-directory
|
] with-directory
|
||||||
|
|
|
@ -70,7 +70,7 @@ IN: stack-checker.transforms
|
||||||
[
|
[
|
||||||
[ no-case ]
|
[ no-case ]
|
||||||
] [
|
] [
|
||||||
dup peek quotation? [
|
dup peek callable? [
|
||||||
dup peek swap but-last
|
dup peek swap but-last
|
||||||
] [
|
] [
|
||||||
[ no-case ] swap
|
[ no-case ] swap
|
||||||
|
|
|
@ -1 +1,2 @@
|
||||||
Daniel Ehrenberg
|
Daniel Ehrenberg
|
||||||
|
Slava Pestov
|
||||||
|
|
|
@ -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 <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 } ;
|
|
@ -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 ;
|
USING: tools.test wrap multiline sequences ;
|
||||||
|
IN: wrap.tests
|
||||||
|
|
||||||
[
|
[
|
||||||
{
|
{
|
||||||
|
@ -23,6 +25,32 @@ USING: tools.test wrap multiline sequences ;
|
||||||
} 35 wrap [ { } like ] map
|
} 35 wrap [ { } like ] map
|
||||||
] unit-test
|
] 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
|
<" This is a
|
||||||
long piece
|
long piece
|
||||||
|
@ -46,3 +74,9 @@ word wrap.">
|
||||||
<" This is a long piece of text that we wish to word wrap."> 12
|
<" This is a long piece of text that we wish to word wrap."> 12
|
||||||
" " wrap-indented-string
|
" " wrap-indented-string
|
||||||
] unit-test
|
] 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
|
||||||
|
|
|
@ -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
|
USING: sequences kernel namespaces make splitting
|
||||||
math math.order fry assocs accessors ;
|
math math.order fry assocs accessors ;
|
||||||
IN: wrap
|
IN: wrap
|
||||||
|
@ -15,12 +17,25 @@ SYMBOL: width
|
||||||
: break-here? ( column word -- ? )
|
: break-here? ( column word -- ? )
|
||||||
break?>> not [ width get > ] [ drop f ] if ;
|
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 )
|
: 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 -- )
|
: (wrap) ( words -- )
|
||||||
|
[
|
||||||
dup find-optimal-break
|
dup find-optimal-break
|
||||||
[ 1 max cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if* ;
|
[ cut-slice [ , ] [ (wrap) ] bi* ] [ , ] if*
|
||||||
|
] unless-empty ;
|
||||||
|
|
||||||
: intersperse ( seq elt -- seq' )
|
: intersperse ( seq elt -- seq' )
|
||||||
[ '[ _ , ] [ , ] interleave ] { } make ;
|
[ '[ _ , ] [ , ] interleave ] { } make ;
|
||||||
|
@ -34,9 +49,7 @@ SYMBOL: width
|
||||||
|
|
||||||
: join-words ( wrapped-lines -- lines )
|
: join-words ( wrapped-lines -- lines )
|
||||||
[
|
[
|
||||||
[ break?>> ]
|
[ break?>> ] trim-slice
|
||||||
[ trim-head-slice ]
|
|
||||||
[ trim-tail-slice ] bi
|
|
||||||
[ key>> ] map concat
|
[ key>> ] map concat
|
||||||
] map ;
|
] map ;
|
||||||
|
|
||||||
|
|
|
@ -236,7 +236,7 @@ find_word_size() {
|
||||||
|
|
||||||
set_factor_binary() {
|
set_factor_binary() {
|
||||||
case $OS in
|
case $OS in
|
||||||
winnt) FACTOR_BINARY=factor-console.exe;;
|
winnt) FACTOR_BINARY=factor.com;;
|
||||||
*) FACTOR_BINARY=factor;;
|
*) FACTOR_BINARY=factor;;
|
||||||
esac
|
esac
|
||||||
}
|
}
|
||||||
|
@ -260,6 +260,7 @@ echo_build_info() {
|
||||||
$ECHO FACTOR_BINARY=$FACTOR_BINARY
|
$ECHO FACTOR_BINARY=$FACTOR_BINARY
|
||||||
$ECHO FACTOR_LIBRARY=$FACTOR_LIBRARY
|
$ECHO FACTOR_LIBRARY=$FACTOR_LIBRARY
|
||||||
$ECHO FACTOR_IMAGE=$FACTOR_IMAGE
|
$ECHO FACTOR_IMAGE=$FACTOR_IMAGE
|
||||||
|
$ECHO CONFIG_TARGET=$CONFIG_TARGET
|
||||||
$ECHO MAKE_TARGET=$MAKE_TARGET
|
$ECHO MAKE_TARGET=$MAKE_TARGET
|
||||||
$ECHO BOOT_IMAGE=$BOOT_IMAGE
|
$ECHO BOOT_IMAGE=$BOOT_IMAGE
|
||||||
$ECHO MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET
|
$ECHO MAKE_IMAGE_TARGET=$MAKE_IMAGE_TARGET
|
||||||
|
@ -289,20 +290,30 @@ set_build_info() {
|
||||||
if [[ $OS == macosx && $ARCH == ppc ]] ; then
|
if [[ $OS == macosx && $ARCH == ppc ]] ; then
|
||||||
MAKE_IMAGE_TARGET=macosx-ppc
|
MAKE_IMAGE_TARGET=macosx-ppc
|
||||||
MAKE_TARGET=macosx-ppc
|
MAKE_TARGET=macosx-ppc
|
||||||
|
CONFIG_TARGET=macosx.ppc
|
||||||
elif [[ $OS == linux && $ARCH == ppc ]] ; then
|
elif [[ $OS == linux && $ARCH == ppc ]] ; then
|
||||||
MAKE_IMAGE_TARGET=linux-ppc
|
MAKE_IMAGE_TARGET=linux-ppc
|
||||||
MAKE_TARGET=linux-ppc
|
MAKE_TARGET=linux-ppc
|
||||||
|
CONFIG_TARGET=linux.ppc
|
||||||
elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then
|
elif [[ $OS == winnt && $ARCH == x86 && $WORD == 64 ]] ; then
|
||||||
MAKE_IMAGE_TARGET=winnt-x86.64
|
MAKE_IMAGE_TARGET=winnt-x86.64
|
||||||
MAKE_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
|
elif [[ $ARCH == x86 && $WORD == 64 ]] ; then
|
||||||
MAKE_IMAGE_TARGET=unix-x86.64
|
MAKE_IMAGE_TARGET=unix-x86.64
|
||||||
MAKE_TARGET=$OS-x86-64
|
MAKE_TARGET=$OS-x86-64
|
||||||
|
CONFIG_TARGET=$OS.x86.64
|
||||||
else
|
else
|
||||||
MAKE_IMAGE_TARGET=$ARCH.$WORD
|
MAKE_IMAGE_TARGET=$ARCH.$WORD
|
||||||
MAKE_TARGET=$OS-$ARCH-$WORD
|
MAKE_TARGET=$OS-$ARCH-$WORD
|
||||||
|
CONFIG_TARGET=$OS.$ARCH.$WORD
|
||||||
fi
|
fi
|
||||||
BOOT_IMAGE=boot.$MAKE_IMAGE_TARGET.image
|
BOOT_IMAGE=boot.$MAKE_IMAGE_TARGET.image
|
||||||
|
CONFIG_TARGET=vm/Config.$CONFIG_TARGET
|
||||||
}
|
}
|
||||||
|
|
||||||
parse_build_info() {
|
parse_build_info() {
|
||||||
|
@ -570,5 +581,6 @@ case "$1" in
|
||||||
dlls) get_config_info; maybe_download_dlls;;
|
dlls) get_config_info; maybe_download_dlls;;
|
||||||
net-bootstrap) get_config_info; update_boot_images; bootstrap ;;
|
net-bootstrap) get_config_info; update_boot_images; bootstrap ;;
|
||||||
make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;;
|
make-target) ECHO=false; find_build_info; echo $MAKE_TARGET ;;
|
||||||
|
config-target) ECHO=false; find_build_info; echo $CONFIG_TARGET ;;
|
||||||
*) usage ;;
|
*) usage ;;
|
||||||
esac
|
esac
|
||||||
|
|
|
@ -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
|
[ 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
|
[ -10 B{ } resize-byte-array ] must-fail
|
||||||
|
|
||||||
|
[ B{ 123 } ] [ 123 1byte-array ] unit-test
|
|
@ -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.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel kernel.private alien.accessors sequences
|
USING: accessors kernel kernel.private alien.accessors sequences
|
||||||
sequences.private math ;
|
sequences.private math ;
|
||||||
|
@ -19,7 +19,7 @@ M: byte-array resize
|
||||||
|
|
||||||
INSTANCE: byte-array sequence
|
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
|
: 2byte-array ( x y -- byte-array ) B{ } 2sequence ; inline
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: alien strings kernel math tools.test io prettyprint
|
USING: alien strings kernel math tools.test io prettyprint
|
||||||
namespaces combinators words classes sequences accessors
|
namespaces combinators words classes sequences accessors
|
||||||
math.functions ;
|
math.functions arrays ;
|
||||||
IN: combinators.tests
|
IN: combinators.tests
|
||||||
|
|
||||||
! Compiled
|
! Compiled
|
||||||
|
@ -314,3 +314,13 @@ IN: combinators.tests
|
||||||
\ test-case-7 must-infer
|
\ test-case-7 must-infer
|
||||||
|
|
||||||
[ "plus" ] [ \ + test-case-7 ] unit-test
|
[ "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
|
|
@ -59,13 +59,13 @@ ERROR: no-case ;
|
||||||
] [
|
] [
|
||||||
dup wrapper? [ wrapped>> ] when
|
dup wrapper? [ wrapped>> ] when
|
||||||
] if =
|
] if =
|
||||||
] [ quotation? ] if
|
] [ callable? ] if
|
||||||
] find nip ;
|
] find nip ;
|
||||||
|
|
||||||
: case ( obj assoc -- )
|
: case ( obj assoc -- )
|
||||||
case-find {
|
case-find {
|
||||||
{ [ dup array? ] [ nip second call ] }
|
{ [ dup array? ] [ nip second call ] }
|
||||||
{ [ dup quotation? ] [ call ] }
|
{ [ dup callable? ] [ call ] }
|
||||||
{ [ dup not ] [ no-case ] }
|
{ [ dup not ] [ no-case ] }
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
|
|
|
@ -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." }
|
{ $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
|
{ $examples
|
||||||
"Try to get a 0 as a random number:"
|
"Try to get a 0 as a random number:"
|
||||||
{ $unchecked-example "USING: continuations math prettyprint ;"
|
{ $unchecked-example "USING: continuations math prettyprint random ;"
|
||||||
"[ 5 random 0 = ] 5 retry t"
|
"[ 5 random 0 = ] 5 retry"
|
||||||
"t"
|
"t"
|
||||||
}
|
}
|
||||||
} ;
|
} ;
|
||||||
|
|
|
@ -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" } }
|
{ $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." } ;
|
{ $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
|
HELP: 2sequence
|
||||||
{ $values { "obj1" object } { "obj2" object } { "exemplar" sequence } { "seq" sequence } }
|
{ $values { "obj1" object } { "obj2" object } { "exemplar" sequence } { "seq" sequence } }
|
||||||
{ $description "Creates a two-element sequence of the same type as " { $snippet "exemplar" } "." } ;
|
{ $description "Creates a two-element sequence of the same type as " { $snippet "exemplar" } "." } ;
|
||||||
|
|
|
@ -137,9 +137,12 @@ INSTANCE: iota immutable-sequence
|
||||||
|
|
||||||
: from-end ( seq n -- seq n' ) [ dup length ] dip - ; inline
|
: 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 )
|
: (2sequence) ( obj1 obj2 seq -- seq )
|
||||||
[ 1 swap set-nth-unsafe ] keep
|
[ 1 swap set-nth-unsafe ] keep
|
||||||
[ 0 swap set-nth-unsafe ] keep ; inline
|
(1sequence) ; inline
|
||||||
|
|
||||||
: (3sequence) ( obj1 obj2 obj3 seq -- seq )
|
: (3sequence) ( obj1 obj2 obj3 seq -- seq )
|
||||||
[ 2 swap set-nth-unsafe ] keep
|
[ 2 swap set-nth-unsafe ] keep
|
||||||
|
@ -151,6 +154,9 @@ INSTANCE: iota immutable-sequence
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
: 1sequence ( obj exemplar -- seq )
|
||||||
|
1 swap [ (1sequence) ] new-like ; inline
|
||||||
|
|
||||||
: 2sequence ( obj1 obj2 exemplar -- seq )
|
: 2sequence ( obj1 obj2 exemplar -- seq )
|
||||||
2 swap [ (2sequence) ] new-like ; inline
|
2 swap [ (2sequence) ] new-like ; inline
|
||||||
|
|
||||||
|
|
|
@ -97,3 +97,5 @@ IN: vectors.tests
|
||||||
[ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test
|
[ fixnum ] [ 1 >bignum V{ } new-sequence length class ] unit-test
|
||||||
|
|
||||||
[ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test
|
[ fixnum ] [ 1 >bignum [ ] V{ } map-as length class ] unit-test
|
||||||
|
|
||||||
|
[ V{ "lulz" } ] [ "lulz" 1vector ] unit-test
|
|
@ -40,7 +40,7 @@ M: sequence new-resizable drop <vector> ;
|
||||||
|
|
||||||
INSTANCE: vector growable
|
INSTANCE: vector growable
|
||||||
|
|
||||||
: 1vector ( x -- vector ) 1array >vector ;
|
: 1vector ( x -- vector ) V{ } 1sequence ;
|
||||||
|
|
||||||
: ?push ( elt seq/f -- seq )
|
: ?push ( elt seq/f -- seq )
|
||||||
[ 1 <vector> ] unless* [ push ] keep ;
|
[ 1 <vector> ] unless* [ push ] keep ;
|
||||||
|
|
|
@ -53,7 +53,6 @@ IN: reports.noise
|
||||||
{ nipd 3 }
|
{ nipd 3 }
|
||||||
{ nkeep 5 }
|
{ nkeep 5 }
|
||||||
{ npick 6 }
|
{ npick 6 }
|
||||||
{ nrev 5 }
|
|
||||||
{ nrot 5 }
|
{ nrot 5 }
|
||||||
{ nslip 5 }
|
{ nslip 5 }
|
||||||
{ ntuck 6 }
|
{ ntuck 6 }
|
||||||
|
|
|
@ -2,6 +2,7 @@ CFLAGS += -DWINDOWS -mno-cygwin
|
||||||
LIBS = -lm
|
LIBS = -lm
|
||||||
PLAF_DLL_OBJS += vm/os-windows.o
|
PLAF_DLL_OBJS += vm/os-windows.o
|
||||||
EXE_EXTENSION=.exe
|
EXE_EXTENSION=.exe
|
||||||
|
CONSOLE_EXTENSION=.com
|
||||||
DLL_EXTENSION=.dll
|
DLL_EXTENSION=.dll
|
||||||
LINKER = $(CC) -shared -mno-cygwin -o
|
LINKER = $(CC) -shared -mno-cygwin -o
|
||||||
LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX)
|
LINK_WITH_ENGINE = -l$(DLL_PREFIX)factor$(DLL_SUFFIX)
|
||||||
|
|
|
@ -6,4 +6,5 @@ PLAF_EXE_OBJS += vm/resources.o
|
||||||
PLAF_EXE_OBJS += vm/main-windows-nt.o
|
PLAF_EXE_OBJS += vm/main-windows-nt.o
|
||||||
CFLAGS += -mwindows
|
CFLAGS += -mwindows
|
||||||
CFLAGS_CONSOLE += -mconsole
|
CFLAGS_CONSOLE += -mconsole
|
||||||
|
CONSOLE_EXTENSION = .com
|
||||||
include vm/Config.windows
|
include vm/Config.windows
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
|
DLL_PATH=http://factorcode.org/dlls
|
||||||
WINDRES=windres
|
WINDRES=windres
|
||||||
include vm/Config.windows.nt
|
include vm/Config.windows.nt
|
||||||
include vm/Config.x86.32
|
include vm/Config.x86.32
|
||||||
|
|
|
@ -1,3 +1,5 @@
|
||||||
|
#error "lol"
|
||||||
|
DLL_PATH=http://factorcode.org/dlls/64
|
||||||
CC=$(WIN64_PATH)-gcc.exe
|
CC=$(WIN64_PATH)-gcc.exe
|
||||||
WINDRES=$(WIN64_PATH)-windres.exe
|
WINDRES=$(WIN64_PATH)-windres.exe
|
||||||
include vm/Config.windows.nt
|
include vm/Config.windows.nt
|
||||||
|
|
|
@ -109,17 +109,6 @@ const F_CHAR *default_image_path(void)
|
||||||
snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
|
snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
|
||||||
temp_path[sizeof(temp_path) - 1] = 0;
|
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);
|
return safe_strdup(temp_path);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue