diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index b4e4d05f2e..543af8dee8 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -436,6 +436,6 @@ M: long-long-type box-return ( type -- ) "double" define-primitive-type "long" "ptrdiff_t" typedef - + "long" "intptr_t" typedef "ulong" "size_t" typedef ] with-compilation-unit diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor index 71aa2e8adc..f9b7b56779 100644 --- a/basis/bootstrap/image/download/download.factor +++ b/basis/bootstrap/image/download/download.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: http.client checksums checksums.openssl splitting assocs +USING: http.client checksums checksums.md5 splitting assocs kernel io.files bootstrap.image sequences io urls ; IN: bootstrap.image.download @@ -13,7 +13,7 @@ IN: bootstrap.image.download : need-new-image? ( image -- ? ) dup exists? [ - [ openssl-md5 checksum-file hex-string ] + [ md5 checksum-file hex-string ] [ download-checksums at ] bi = not ] [ drop t ] if ; diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor index 6cb860d33f..512d26f4bf 100644 --- a/basis/compiler/compiler-docs.factor +++ b/basis/compiler/compiler-docs.factor @@ -6,7 +6,7 @@ HELP: enable-compiler { $description "Enables the optimizing compiler." } ; HELP: disable-compiler -{ $description "Enables the optimizing compiler." } ; +{ $description "Disable the optimizing compiler." } ; ARTICLE: "compiler-usage" "Calling the optimizing compiler" "Normally, new word definitions are recompiled automatically. This can be changed:" diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 92560ef5e9..9108c0e8f7 100644 --- a/basis/cpu/x86/64/winnt/winnt.factor +++ b/basis/cpu/x86/64/winnt/winnt.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel layouts system math alien.c-types +USING: kernel layouts system math alien.c-types sequences compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86 ; IN: cpu.x86.64.winnt @@ -22,6 +22,7 @@ M: x86.64 dummy-fp-params? t ; << "longlong" "ptrdiff_t" typedef +"longlong" "intptr_t" typedef "int" "long" typedef "uint" "ulong" typedef >> diff --git a/basis/freetype/freetype.factor b/basis/freetype/freetype.factor index 8572a8bd91..683169e394 100644 --- a/basis/freetype/freetype.factor +++ b/basis/freetype/freetype.factor @@ -64,7 +64,7 @@ C-STRUCT: glyph { "FT_Pos" "advance-x" } { "FT_Pos" "advance-y" } - { "long" "format" } + { "intptr_t" "format" } { "int" "bitmap-rows" } { "int" "bitmap-width" } diff --git a/basis/furnace/furnace-docs.factor b/basis/furnace/furnace-docs.factor index b86d4c3295..911433d100 100644 --- a/basis/furnace/furnace-docs.factor +++ b/basis/furnace/furnace-docs.factor @@ -97,7 +97,7 @@ HELP: with-exit-continuation { $notes "Furnace actions and authentication realms wrap their execution in this combinator, allowing form validation failures and login requests, respectively, to immediately return an HTTP response to the client without running any more responder code." } ; ARTICLE: "furnace.extension-points" "Furnace extension points" -"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the setateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used." +"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the stateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used." $nl "Responders can implement methods on the following generic words:" { $subsection modify-query } diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index d2d0725a1e..6b90ba6937 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -115,10 +115,10 @@ M: result link-href href>> ; [ [ title>> ] compare ] sort ; : article-apropos ( string -- results ) - "articles.idx" temp-file offline-apropos ; + "articles.idx" offline-apropos ; : word-apropos ( string -- results ) - "words.idx" temp-file offline-apropos ; + "words.idx" offline-apropos ; : vocab-apropos ( string -- results ) - "vocabs.idx" temp-file offline-apropos ; + "vocabs.idx" offline-apropos ; diff --git a/basis/html/templates/fhtml/fhtml-tests.factor b/basis/html/templates/fhtml/fhtml-tests.factor index b863087a92..d314a60124 100644 --- a/basis/html/templates/fhtml/fhtml-tests.factor +++ b/basis/html/templates/fhtml/fhtml-tests.factor @@ -1,6 +1,6 @@ USING: io io.files io.streams.string io.encodings.utf8 html.templates html.templates.fhtml kernel -tools.test sequences parser ; +tools.test sequences parser splitting prettyprint ; IN: html.templates.fhtml.tests : test-template ( path -- ? ) @@ -8,8 +8,10 @@ IN: html.templates.fhtml.tests prepend [ ".fhtml" append [ call-template ] with-string-writer + lines ] keep - ".html" append utf8 file-contents = ; + ".html" append utf8 file-lines + [ . . ] [ = ] 2bi ; [ t ] [ "example" test-template ] unit-test [ t ] [ "bug" test-template ] unit-test diff --git a/basis/io/files/listing/listing-tests.factor b/basis/io/files/listing/listing-tests.factor index a2347c8db9..8c2dc28559 100644 --- a/basis/io/files/listing/listing-tests.factor +++ b/basis/io/files/listing/listing-tests.factor @@ -3,4 +3,6 @@ USING: tools.test io.files.listing strings kernel ; IN: io.files.listing.tests +\ directory. must-infer + [ ] [ "" directory. ] unit-test diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 674ed8803c..942bdb041d 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -114,19 +114,29 @@ M: threaded-server handle-client* handler>> call ; ] when* ] unless ; +: (start-server) ( threaded-server -- ) + init-server + dup threaded-server [ + dup name>> [ + [ listen-on [ start-accept-loop ] parallel-each ] + [ ready>> raise-flag ] + bi + ] with-logging + ] with-variable ; + PRIVATE> : start-server ( threaded-server -- ) - init-server - dup secure-config>> [ - dup threaded-server [ - dup name>> [ - [ listen-on [ start-accept-loop ] parallel-each ] - [ ready>> raise-flag ] - bi - ] with-logging - ] with-variable - ] with-secure-context ; + #! Only create a secure-context if we want to listen on + #! a secure port, otherwise start-server won't work at + #! all if SSL is not available. + dup secure>> [ + dup secure-config>> [ + (start-server) + ] with-secure-context + ] [ + (start-server) + ] if ; : wait-for-server ( threaded-server -- ) ready>> wait-for-flag ; diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor index 949b0a7961..cbae2f5eca 100644 --- a/basis/io/windows/nt/launcher/launcher-tests.factor +++ b/basis/io/windows/nt/launcher/launcher-tests.factor @@ -1,157 +1,157 @@ -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 ; -IN: io.windows.launcher.nt.tests - -[ ] [ - - "notepad" >>command - 1/2 seconds >>timeout - "notepad" set -] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ f ] [ "notepad" get process-started? ] unit-test - -[ ] [ "notepad" [ run-detached ] change ] unit-test - -[ "notepad" get wait-for-process ] must-fail - -[ t ] [ "notepad" get killed>> ] unit-test - -[ f ] [ "notepad" get process-running? ] unit-test - -[ ] [ - - vm "-quiet" "-run=hello-world" 3array >>command - "out.txt" temp-file >>stdout - try-process -] unit-test - -[ "Hello world" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - - vm "-run=listener" 2array >>command - +closed+ >>stdin - try-process -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - "err.txt" temp-file >>stderr - try-process - ] with-directory -] unit-test - -[ "output" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "error" ] [ - "err.txt" temp-file ascii file-lines first -] unit-test - -[ ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "out.txt" temp-file >>stdout - +stdout+ >>stderr - try-process - ] with-directory -] unit-test - -[ "outputerror" ] [ - "out.txt" temp-file ascii file-lines first -] unit-test - -[ "output" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "stderr.factor" 3array >>command - "err2.txt" temp-file >>stderr - ascii lines first - ] with-directory -] unit-test - -[ "error" ] [ - "err2.txt" temp-file ascii file-lines first -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ t ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - +replace-environment+ >>environment-mode - os-envs >>environment - ascii contents - ] with-directory eval - - os-envs = -] unit-test - -[ "B" ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "A" "B" } } >>environment - ascii contents - ] with-directory eval - - "A" swap at -] unit-test - -[ f ] [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "env.factor" 3array >>command - { { "HOME" "XXX" } } >>environment - +prepend-environment+ >>environment-mode - ascii contents - ] with-directory eval - - "HOME" swap at "XXX" = -] unit-test - -2 [ - [ ] [ - - "cmd.exe /c dir" >>command - "dir.txt" temp-file >>stdout - try-process - ] unit-test - - [ ] [ "dir.txt" temp-file delete-file ] unit-test -] times - -[ "append-test" temp-file delete-file ] ignore-errors - -[ "Hello appender\r\nHello appender\r\n" ] [ - 2 [ - "resource:basis/io/windows/nt/launcher/test" [ - - vm "-script" "append.factor" 3array >>command - "append-test" temp-file >>stdout - try-process - ] with-directory - ] times - - "append-test" temp-file ascii file-contents -] unit-test +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 ; +IN: io.windows.launcher.nt.tests + +[ ] [ + + "notepad" >>command + 1/2 seconds >>timeout + "notepad" set +] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ f ] [ "notepad" get process-started? ] unit-test + +[ ] [ "notepad" [ run-detached ] change ] unit-test + +[ "notepad" get wait-for-process ] must-fail + +[ t ] [ "notepad" get killed>> ] unit-test + +[ f ] [ "notepad" get process-running? ] unit-test + +[ ] [ + + vm "-quiet" "-run=hello-world" 3array >>command + "out.txt" temp-file >>stdout + try-process +] unit-test + +[ "Hello world" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + + vm "-run=listener" 2array >>command + +closed+ >>stdin + try-process +] unit-test + +[ ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + "err.txt" temp-file >>stderr + try-process + ] with-directory +] unit-test + +[ "output" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "error" ] [ + "err.txt" temp-file ascii file-lines first +] unit-test + +[ ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "out.txt" temp-file >>stdout + +stdout+ >>stderr + try-process + ] with-directory +] unit-test + +[ "outputerror" ] [ + "out.txt" temp-file ascii file-lines first +] unit-test + +[ "output" ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "stderr.factor" 3array >>command + "err2.txt" temp-file >>stderr + ascii lines first + ] with-directory +] unit-test + +[ "error" ] [ + "err2.txt" temp-file ascii file-lines first +] unit-test + +[ t ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ t ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + +replace-environment+ >>environment-mode + os-envs >>environment + ascii contents + ] with-directory eval + + os-envs = +] unit-test + +[ "B" ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + { { "A" "B" } } >>environment + ascii contents + ] with-directory eval + + "A" swap at +] unit-test + +[ f ] [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "env.factor" 3array >>command + { { "USERPROFILE" "XXX" } } >>environment + +prepend-environment+ >>environment-mode + ascii contents + ] with-directory eval + + "USERPROFILE" swap at "XXX" = +] unit-test + +2 [ + [ ] [ + + "cmd.exe /c dir" >>command + "dir.txt" temp-file >>stdout + try-process + ] unit-test + + [ ] [ "dir.txt" temp-file delete-file ] unit-test +] times + +[ "append-test" temp-file delete-file ] ignore-errors + +[ "Hello appender\r\nHello appender\r\n" ] [ + 2 [ + "resource:basis/io/windows/nt/launcher/test" [ + + vm "-script" "append.factor" 3array >>command + "append-test" temp-file >>stdout + try-process + ] with-directory + ] times + + "append-test" temp-file ascii file-contents +] unit-test diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor index 003ef459e3..ca6697be1c 100644 --- a/basis/locals/locals-tests.factor +++ b/basis/locals/locals-tests.factor @@ -346,7 +346,6 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; { 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as - :: literal-identity-test ( -- a b ) { } V{ } ; @@ -356,6 +355,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ; swapd [ eq? ] [ eq? ] 2bi* ] unit-test +:: mutable-local-in-literal-test ( a! -- b ) a 1 + a! { a } ; + +[ { 4 } ] [ 3 mutable-local-in-literal-test ] unit-test + :: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- ) obj1 obj2 <=> { { +lt+ [ lt-quot call ] } diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index e74ecf3dc9..7de9d10436 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -229,6 +229,8 @@ M: tuple rewrite-element M: local rewrite-element , ; +M: local-reader rewrite-element , ; + M: word rewrite-element literalize , ; M: object rewrite-element , ; diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index ad1907fcb0..afd83d4458 100644 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math math.functions sequences sequences.private words namespaces macros hints -combinators fry ; +combinators fry io.binary ; IN: math.bitwise ! utilities @@ -93,3 +93,11 @@ PRIVATE> : bit-count ( x -- n ) dup 0 < [ bitnot ] when (bit-count) ; inline + +! Signed byte array to integer conversion +: signed-le> ( bytes -- x ) + [ le> ] [ length 8 * 1- on-bits ] bi + 2dup > [ bitnot bitor ] [ drop ] if ; + +: signed-be> ( bytes -- x ) + signed-le> ; diff --git a/basis/math/polynomials/polynomials-docs.factor b/basis/math/polynomials/polynomials-docs.factor index 08b7ca7c4d..edffa5377d 100644 --- a/basis/math/polynomials/polynomials-docs.factor +++ b/basis/math/polynomials/polynomials-docs.factor @@ -40,7 +40,7 @@ HELP: ptrim HELP: 2ptrim { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Trims excess zeros from two polynomials." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim [ . ] bi@" "{ 0 1 }\n{ 1 }" } } ; HELP: p+ { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -60,7 +60,7 @@ HELP: n*p HELP: pextend-conv { $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } } { $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv [ . ] bi@" "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ; HELP: p* { $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } @@ -75,13 +75,18 @@ HELP: p-sq HELP: p/mod { $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } } { $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; +{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod [ . ] bi@" "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ; HELP: pgcd { $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } } { $description "Computes the greatest common divisor " { $snippet "d" } " of " { $snippet "p" } " and " { $snippet "q" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*q = d mod p" } } { $notes "GCD in the case of polynomials is a monic polynomial of the highest possible degree that divides into both " { $snippet "p" } " and " { $snippet "q" } "." } -{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1} { 1 1 } pgcd swap . ." "{ 0 0 }\n{ 1 1 }" } } ; +{ $examples + { $example "USING: kernel math.polynomials prettyprint ;" + "{ 1 1 1 1 } { 1 1 } pgcd [ . ] bi@" + "{ 0 0 }\n{ 1 1 }" + } +} ; HELP: pdiff { $values { "p" "a polynomial" } { "p'" "a polynomial" } } diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index aec7960857..ecb4c4a08c 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -64,7 +64,8 @@ MACRO: all-enabled-client-state ( seq quot -- ) [ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline : line-vertices ( a b -- ) - append >c-float-array gl-vertex-pointer ; + [ first2 [ 0.5 + ] bi@ ] bi@ 4 narray + >c-float-array gl-vertex-pointer ; : gl-line ( a b -- ) line-vertices GL_LINES 0 2 glDrawArrays ; @@ -72,9 +73,9 @@ MACRO: all-enabled-client-state ( seq quot -- ) : (rect-vertices) ( dim -- vertices ) { [ drop 0.5 0.5 ] - [ first 0.5 - 0.5 ] - [ [ first 0.5 - ] [ second 0.5 - ] bi ] - [ second 0.5 - 0.5 swap ] + [ first 0.3 - 0.5 ] + [ [ first 0.3 - ] [ second 0.3 - ] bi ] + [ second 0.3 - 0.5 swap ] } cleave 8 narray >c-float-array ; : rect-vertices ( dim -- ) diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index d04016b93a..b7716d8580 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -137,7 +137,7 @@ ERROR: bad-special-group string ; DEFER: (parse-regexp) : nested-parse-regexp ( token ? -- ) [ push-stack (parse-regexp) pop-stack ] dip - [ ] when pop-stack boa push-stack ; + [ ] when pop-stack new swap >>term push-stack ; ! non-capturing groups : (parse-special-group) ( -- ) diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 2339628801..2a6c0dc16f 100644 --- a/basis/regexp/regexp-tests.factor +++ b/basis/regexp/regexp-tests.factor @@ -2,6 +2,9 @@ USING: regexp tools.test kernel sequences regexp.parser regexp.traversal eval ; IN: regexp-tests +\ must-infer +\ matches? must-infer + [ f ] [ "b" "a*" matches? ] unit-test [ t ] [ "" "a*" matches? ] unit-test [ t ] [ "a" "a*" matches? ] unit-test diff --git a/basis/regexp/traversal/traversal.factor b/basis/regexp/traversal/traversal.factor index 91c7ce16dc..c9e8a54348 100644 --- a/basis/regexp/traversal/traversal.factor +++ b/basis/regexp/traversal/traversal.factor @@ -107,7 +107,8 @@ M: capture-group-off flag-action ( dfa-traverser flag -- ) : increment-state ( dfa-traverser state -- dfa-traverser ) [ dup traverse-forward>> - [ 1+ ] [ 1- ] ? change-current-index + [ [ 1+ ] change-current-index ] + [ [ 1- ] change-current-index ] if dup current-state>> >>last-state ] dip first >>current-state ; diff --git a/basis/regexp/utils/utils-tests.factor b/basis/regexp/utils/utils-tests.factor new file mode 100644 index 0000000000..d048ad4be1 --- /dev/null +++ b/basis/regexp/utils/utils-tests.factor @@ -0,0 +1,4 @@ +USING: regexp.utils tools.test ; +IN: regexp.utils.tests + +[ [ ] [ ] while-changes ] must-infer diff --git a/basis/regexp/utils/utils.factor b/basis/regexp/utils/utils.factor index fb058ecf92..5116dd2b7e 100644 --- a/basis/regexp/utils/utils.factor +++ b/basis/regexp/utils/utils.factor @@ -5,9 +5,7 @@ namespaces regexp.backend sequences unicode.categories math.ranges fry combinators.short-circuit vectors ; IN: regexp.utils -: (while-changes) ( obj quot pred pred-ret -- obj ) - ! quot: ( obj -- obj' ) - ! pred: ( obj -- <=> ) +: (while-changes) ( obj quot: ( obj -- obj' ) pred: ( obj -- <=> ) pred-ret -- obj ) [ [ dup slip ] dip pick over call ] dip dupd = [ 3drop ] [ (while-changes) ] if ; inline recursive diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 11fb69fc7d..c975e64b12 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -111,8 +111,8 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ; : checkmark-points ( dim -- points ) { - [ { 0 0 } v* { 0 1 } v+ ] - [ { 1 1 } v* { 0 1 } v+ ] + [ { 0 0 } v* ] + [ { 1 1 } v* ] [ { 0 1 } v* ] [ { 1 0 } v* ] } cleave 4array ; diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 74647a6afb..2cf6d24154 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -112,7 +112,7 @@ M: editor ungraft* line-height * ; : caret-loc ( editor -- loc ) - [ editor-caret* ] keep 2dup loc>x 1+ + [ editor-caret* ] keep 2dup loc>x rot first rot line>y 2array ; : caret-dim ( editor -- dim ) diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor index d7844e3fa3..adfdd16f69 100644 --- a/basis/ui/gadgets/grid-lines/grid-lines.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines.factor @@ -27,7 +27,7 @@ M: grid-lines draw-boundary dup grid set dup rect-dim half-gap v- grid-dim set compute-grid - [ { 1 0 } draw-grid-lines ] + [ { -0.5 -0.5 } gl-translate { 1 0 } draw-grid-lines ] [ { 0.5 -0.5 } gl-translate { 0 1 } draw-grid-lines diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 68bf765295..d842bf8a68 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -181,8 +181,8 @@ M: stack-display tool-scroller listener-gadget "toolbar" f { { f restart-listener } - { T{ key-down f f "CLEAR" } clear-output } - { T{ key-down f { C+ } "CLEAR" } clear-stack } + { T{ key-down f { A+ } "c" } clear-output } + { T{ key-down f { A+ } "C" } clear-stack } { T{ key-down f { C+ } "d" } com-end } { T{ key-down f f "F1" } listener-help } } define-command-map diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index b8edf7fa36..177949aec9 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -76,9 +76,11 @@ M: integer user-groups ( id -- seq ) : all-groups ( -- seq ) [ getgrent dup ] [ group-struct>group ] [ drop ] produce ; +: ( -- assoc ) + all-groups [ [ id>> ] keep ] H{ } map>assoc ; + : with-group-cache ( quot -- ) - all-groups [ [ id>> ] keep ] H{ } map>assoc - group-cache rot with-variable ; inline + [ group-cache ] dip with-variable ; inline : real-group-id ( -- id ) getgid ; inline diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index f76fbd5388..8487d5adf2 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -41,9 +41,11 @@ PRIVATE> SYMBOL: user-cache +: ( -- assoc ) + all-users [ [ uid>> ] keep ] H{ } map>assoc ; + : with-user-cache ( quot -- ) - all-users [ [ uid>> ] keep ] H{ } map>assoc - user-cache rot with-variable ; inline + [ user-cache ] dip with-variable ; inline GENERIC: user-passwd ( obj -- passwd ) diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor index 462377e85c..96301dbbe4 100644 --- a/basis/windows/kernel32/kernel32.factor +++ b/basis/windows/kernel32/kernel32.factor @@ -199,11 +199,11 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : THREAD_PRIORITY_TIME_CRITICAL 15 ; inline C-STRUCT: OVERLAPPED - { "int" "internal" } - { "int" "internal-high" } - { "int" "offset" } - { "int" "offset-high" } - { "void*" "event" } ; + { "UINT_PTR" "internal" } + { "UINT_PTR" "internal-high" } + { "DWORD" "offset" } + { "DWORD" "offset-high" } + { "HANDLE" "event" } ; C-STRUCT: SYSTEMTIME { "WORD" "wYear" } diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index 0ac8409016..6b1a57a098 100644 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -40,10 +40,11 @@ TYPEDEF: void* LPVOID TYPEDEF: void* LPCVOID TYPEDEF: float FLOAT -TYPEDEF: short HALF_PTR -TYPEDEF: ushort UHALF_PTR -TYPEDEF: int INT_PTR -TYPEDEF: uint UINT_PTR + +TYPEDEF: intptr_t HALF_PTR +TYPEDEF: intptr_t UHALF_PTR +TYPEDEF: intptr_t INT_PTR +TYPEDEF: intptr_t UINT_PTR TYPEDEF: int LONG_PTR TYPEDEF: ulong ULONG_PTR diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor index c38a7c9ebc..18cde1a35c 100644 --- a/core/io/io-tests.factor +++ b/core/io/io-tests.factor @@ -25,6 +25,11 @@ IN: io.tests ! Make sure we use correct to_c_string form when writing [ ] [ "\0" write ] unit-test +[ ] [ + "It seems Jobs has lost his grasp on reality again.\n" + "separator-test.txt" temp-file latin1 set-file-contents +] unit-test + [ { { "It seems " CHAR: J } @@ -33,7 +38,7 @@ IN: io.tests } ] [ [ - "resource:core/io/test/separator-test.txt" + "separator-test.txt" temp-file latin1 [ "J" read-until 2array , "i" read-until 2array , diff --git a/core/io/test/separator-test.txt b/core/io/test/separator-test.txt deleted file mode 100644 index c3568f6ea0..0000000000 --- a/core/io/test/separator-test.txt +++ /dev/null @@ -1 +0,0 @@ -It seems Jobs has lost his grasp on reality again. diff --git a/extra/benchmark/regex-dna/regex-dna-tests.factor b/extra/benchmark/regex-dna/regex-dna-tests.factor index f1d4b7f627..9f64d438c7 100644 --- a/extra/benchmark/regex-dna/regex-dna-tests.factor +++ b/extra/benchmark/regex-dna/regex-dna-tests.factor @@ -1,10 +1,10 @@ USING: benchmark.regex-dna io io.files io.encodings.ascii -io.streams.string kernel tools.test ; +io.streams.string kernel tools.test splitting ; IN: benchmark.regex-dna.tests [ t ] [ "resource:extra/benchmark/regex-dna/regex-dna-test-in.txt" - [ regex-dna ] with-string-writer + [ regex-dna ] with-string-writer lines "resource:extra/benchmark/regex-dna/regex-dna-test-out.txt" - ascii file-contents = + ascii file-lines = ] unit-test diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor index 193582524c..3d4cd392ca 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -83,7 +83,7 @@ VAR: separation-radius : relative-position ( self other -- v ) swap [ pos>> ] bi@ v- ; : relative-angle ( self other -- angle ) -over vel>> -rot relative-position angle-between ; + over vel>> -rot relative-position angle-between ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -189,13 +189,12 @@ boids> [ within-alignment-neighborhood? ] with filter ; : above? ( n a b -- ? ) nip > ; : wrap ( n a b -- n ) -{ { [ 3dup below? ] - [ 2nip ] } - { [ 3dup above? ] - [ drop nip ] } - { [ t ] - [ 2drop ] } } -cond ; + { + { [ 3dup below? ] [ 2nip ] } + { [ 3dup above? ] [ drop nip ] } + { [ t ] [ 2drop ] } + } + cond ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/contributors/contributors.factor b/extra/contributors/contributors.factor index 9f2d5a55fa..f6fcac5297 100755 --- a/extra/contributors/contributors.factor +++ b/extra/contributors/contributors.factor @@ -7,7 +7,7 @@ IN: contributors : changelog ( -- authors ) image parent-directory [ - "git-log --pretty=format:%an" ascii lines + "git log --pretty=format:%an" ascii lines ] with-directory ; : patch-counts ( authors -- assoc ) diff --git a/extra/ftp/server/server.factor b/extra/ftp/server/server.factor index f8ab04ed00..9095dedf35 100644 --- a/extra/ftp/server/server.factor +++ b/extra/ftp/server/server.factor @@ -7,10 +7,11 @@ namespaces make sequences ftp io.unix.launcher.parser unicode.case splitting assocs classes io.servers.connection destructors calendar io.timeouts io.streams.duplex threads continuations math concurrency.promises byte-arrays -io.backend sequences.lib tools.hexdump io.files.listing ; +io.backend sequences.lib tools.hexdump io.files.listing +io.streams.string ; IN: ftp.server -TUPLE: ftp-client url mode state command-promise ; +TUPLE: ftp-client url mode state command-promise user password ; : ( url -- ftp-client ) ftp-client new @@ -140,16 +141,16 @@ ERROR: type-error type ; 150 "Here comes the directory listing." server-response ; : finish-directory ( -- ) - 226 "Opening " server-response ; + 226 "Directory send OK." server-response ; GENERIC: service-command ( stream obj -- ) M: ftp-list service-command ( stream obj -- ) drop - start-directory - [ + start-directory [ utf8 encode-output - directory. [ ftp-send ] each + [ current-directory get directory. ] with-string-writer string-lines + harvest [ ftp-send ] each ] with-output-stream finish-directory ; diff --git a/extra/galois-talk/authors.txt b/extra/galois-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/galois-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/galois-talk/summary.txt b/extra/galois-talk/summary.txt new file mode 100644 index 0000000000..00f30acf8d --- /dev/null +++ b/extra/galois-talk/summary.txt @@ -0,0 +1 @@ +Slides from a talk at Galois by Slava Pestov, October 2008 diff --git a/extra/galois-talk/tags.txt b/extra/galois-talk/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/galois-talk/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/google-tech-talk/authors.txt b/extra/google-tech-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/google-tech-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/google-tech-talk/summary.txt b/extra/google-tech-talk/summary.txt new file mode 100644 index 0000000000..1747a569c9 --- /dev/null +++ b/extra/google-tech-talk/summary.txt @@ -0,0 +1 @@ +Slides from Google Tech Talk by Slava Pestov, October 2008 diff --git a/extra/google-tech-talk/tags.txt b/extra/google-tech-talk/tags.txt new file mode 100644 index 0000000000..cb5fc203e1 --- /dev/null +++ b/extra/google-tech-talk/tags.txt @@ -0,0 +1 @@ +demos diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 4d83300934..4c35e3d7d0 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/extra/graphics/bitmap/bitmap.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays byte-arrays combinators summary -io.backend graphics.viewer io io.binary io.files kernel libc -math math.functions namespaces opengl opengl.gl prettyprint -sequences strings ui ui.gadgets.panes io.encodings.binary -accessors grouping ; +USING: alien arrays byte-arrays combinators summary io.backend +graphics.viewer io io.binary io.files kernel libc math +math.functions math.bitwise namespaces opengl opengl.gl +prettyprint sequences strings ui ui.gadgets.panes +io.encodings.binary accessors grouping ; IN: graphics.bitmap ! Currently can only handle 24bit bitmaps. @@ -56,8 +56,8 @@ M: bitmap-magic summary : parse-bitmap-header ( bitmap -- ) 4 read le> >>header-length - 4 read le> >>width - 4 read le> >>height + 4 read signed-le> >>width + 4 read signed-le> >>height 2 read le> >>planes 2 read le> >>bit-count 4 read le> >>compression diff --git a/extra/hardware-info/windows/windows.factor b/extra/hardware-info/windows/windows.factor index 3162496974..3aa6824ff6 100755 --- a/extra/hardware-info/windows/windows.factor +++ b/extra/hardware-info/windows/windows.factor @@ -18,7 +18,7 @@ IN: hardware-info.windows : processor-architecture ( -- n ) system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ; -: os-version +: os-version ( -- os-version ) "OSVERSIONINFO" "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize [ GetVersionEx ] keep swap zero? [ win32-error ] when ; @@ -67,4 +67,4 @@ IN: hardware-info.windows { { [ os wince? ] [ "hardware-info.windows.ce" ] } { [ os winnt? ] [ "hardware-info.windows.nt" ] } -} cond [ require ] when* >> +} cond require >> diff --git a/extra/mason/child/child-tests.factor b/extra/mason/child/child-tests.factor index 7913d05b26..104360e1fa 100644 --- a/extra/mason/child/child-tests.factor +++ b/extra/mason/child/child-tests.factor @@ -1,7 +1,7 @@ IN: mason.child.tests USING: mason.child mason.config tools.test namespaces ; -[ { "make" "clean" "winnt-x86-32" } ] [ +[ { "make" "winnt-x86-32" } ] [ [ "winnt" target-os set "x86.32" target-cpu set @@ -9,7 +9,7 @@ USING: mason.child mason.config tools.test namespaces ; ] with-scope ] unit-test -[ { "make" "clean" "macosx-x86-32" } ] [ +[ { "make" "macosx-x86-32" } ] [ [ "macosx" target-os set "x86.32" target-cpu set @@ -17,7 +17,7 @@ USING: mason.child mason.config tools.test namespaces ; ] with-scope ] unit-test -[ { "gmake" "clean" "netbsd-ppc" } ] [ +[ { "gmake" "netbsd-ppc" } ] [ [ "netbsd" target-os set "ppc" target-cpu set diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index 2bc6b191c4..0c9669ed5a 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -2,14 +2,26 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces make debugger sequences io.files io.launcher arrays accessors calendar continuations -combinators.short-circuit mason.common mason.report mason.platform ; +combinators.short-circuit mason.common mason.report +mason.platform mason.config http.client ; IN: mason.child : make-cmd ( -- args ) - [ gnu-make , "clean" , platform , ] { } make ; + gnu-make platform 2array ; + +: download-dlls ( -- ) + target-os get "winnt" = [ + "http://factorcode.org/dlls/" + target-cpu get "x86.64" = [ "64/" append ] when + [ "freetype6.dll" append ] + [ "zlib1.dll" append ] bi + [ download ] bi@ + ] when ; : make-vm ( -- ) "factor" [ + download-dlls + make-cmd >>command "../compile-log" >>stdout diff --git a/extra/slides/slides.factor b/extra/slides/slides.factor index 2940bcbfcb..dc8bdd4576 100755 --- a/extra/slides/slides.factor +++ b/extra/slides/slides.factor @@ -48,19 +48,17 @@ IN: slides : $divider ( -- ) [ - T{ gradient f - { - T{ rgba f 0.25 0.25 0.25 1.0 } - T{ rgba f 1.0 1.0 1.0 0.0 } - } - } >>interior + { + T{ rgba f 0.25 0.25 0.25 1.0 } + T{ rgba f 1.0 1.0 1.0 0.0 } + } >>interior { 800 10 } >>dim { 1 0 } >>orientation gadget. ] ($block) ; : page-theme ( gadget -- ) - T{ gradient f { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } } + { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } >>interior drop ; : ( list -- gadget ) diff --git a/extra/ui/render/test/reference.bmp b/extra/ui/render/test/reference.bmp new file mode 100644 index 0000000000..0740fcc817 Binary files /dev/null and b/extra/ui/render/test/reference.bmp differ diff --git a/extra/ui/render/test/test.factor b/extra/ui/render/test/test.factor new file mode 100644 index 0000000000..01b5b65bcf --- /dev/null +++ b/extra/ui/render/test/test.factor @@ -0,0 +1,70 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors colors arrays kernel sequences math byte-arrays +namespaces cap graphics.bitmap +ui.gadgets ui.gadgets.packs ui.gadgets.borders ui.gadgets.grids +ui.gadgets.grid-lines ui.gadgets.labels ui.gadgets.buttons +ui.render ui opengl opengl.gl ; +IN: ui.render.test + +SINGLETON: line-test + +M: line-test draw-interior + 2drop { 0 0 } { 0 10 } gl-line ; + +: ( -- gadget ) + + line-test >>interior + { 1 10 } >>dim ; + +TUPLE: ui-render-test < pack { first-time? initial: t } ; + +: message-window ( text -- ) +