diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index a93c87611d..543af8dee8 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -164,7 +164,7 @@ GENERIC: stack-size ( type -- size ) foldable M: string stack-size c-type stack-size ; -M: c-type stack-size size>> ; +M: c-type stack-size size>> cell align ; GENERIC: byte-length ( seq -- n ) flushable @@ -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/alien/structs/structs.factor b/basis/alien/structs/structs.factor index ce30a2ee25..adb25aa977 100644 --- a/basis/alien/structs/structs.factor +++ b/basis/alien/structs/structs.factor @@ -1,14 +1,10 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays generic hashtables kernel kernel.private -math namespaces parser sequences strings words libc +math namespaces parser sequences strings words libc fry alien.c-types alien.structs.fields cpu.architecture ; IN: alien.structs -: if-value-structs? ( ctype true false -- ) - value-structs? - [ drop call ] [ >r 2drop "void*" r> call ] if ; inline - TUPLE: struct-type size align fields ; M: struct-type heap-size size>> ; @@ -17,20 +13,26 @@ M: struct-type c-type-align align>> ; M: struct-type c-type-stack-align? drop f ; -M: struct-type unbox-parameter - [ %unbox-struct ] [ unbox-parameter ] if-value-structs? ; +: if-value-struct ( ctype true false -- ) + [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline -M: struct-type unbox-return - f swap %unbox-struct ; +M: struct-type unbox-parameter + [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ; M: struct-type box-parameter - [ %box-struct ] [ box-parameter ] if-value-structs? ; + [ %box-large-struct ] [ box-parameter ] if-value-struct ; + +: if-small-struct ( c-type true false -- ? ) + [ dup struct-small-enough? ] 2dip '[ f swap @ ] if ; inline + +M: struct-type unbox-return + [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ; M: struct-type box-return - f swap %box-struct ; + [ %box-small-struct ] [ %box-large-struct ] if-small-struct ; M: struct-type stack-size - [ heap-size ] [ stack-size ] if-value-structs? ; + [ heap-size ] [ stack-size ] if-value-struct ; : c-struct? ( type -- ? ) (c-type) struct-type? ; @@ -40,7 +42,7 @@ M: struct-type stack-size -rot define-c-type ; : define-struct-early ( name vocab fields -- fields ) - -rot [ rot first2 ] 2curry map ; + [ first2 ] with with map ; : compute-struct-align ( types -- n ) [ c-type-align ] map supremum ; 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/calendar/windows/tags.txt b/basis/calendar/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/basis/calendar/windows/tags.txt +++ b/basis/calendar/windows/tags.txt @@ -1,2 +1 @@ unportable -windows diff --git a/basis/command-line/command-line-docs.factor b/basis/command-line/command-line-docs.factor index d1b18ab5da..65d290df3a 100644 --- a/basis/command-line/command-line-docs.factor +++ b/basis/command-line/command-line-docs.factor @@ -2,10 +2,10 @@ USING: help.markup help.syntax parser vocabs.loader strings ; IN: command-line HELP: run-bootstrap-init -{ $description "Runs the " { $snippet ".factor-boot-rc" } " file in the user's home directory unless the " { $snippet "-no-user-init" } " command line switch was given." } ; +{ $description "Runs the bootstrap initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-boot-rc" } " on Unix and " { $snippet "factor-boot-rc" } " on Windows." } ; HELP: run-user-init -{ $description "Runs the " { $snippet ".factor-rc" } " file in the user's home directory unless the " { $snippet "-no-user-init" } " command line switch was given." } ; +{ $description "Runs the startup initialization file in the user's home directory, unless the " { $snippet "-no-user-init" } " command line switch was given. This file is named " { $snippet ".factor-rc" } " on Unix and " { $snippet "factor-rc" } " on Windows." } ; HELP: cli-param { $values { "param" string } } @@ -57,7 +57,7 @@ ARTICLE: "bootstrap-cli-args" "Command line switches for bootstrap" "A number of command line switches can be passed to a bootstrap image to modify the behavior of the resulting image:" { $table { { $snippet "-output-image=" { $emphasis "image" } } { "Save the result to " { $snippet "image" } ". The default is " { $snippet "factor.image" } "." } } - { { $snippet "-no-user-init" } { "Inhibits the running of the " { $snippet ".factor-boot-rc" } " file in the user's home directory." } } + { { $snippet "-no-user-init" } { "Inhibits the running of user initialization files on startup. See " { $link "rc-files" } "." } } { { $snippet "-include=" { $emphasis "components..." } } "A list of components to include (see below)." } { { $snippet "-exclude=" { $emphasis "components..." } } "A list of components to exclude." } { { $snippet "-ui-backend=" { $emphasis "backend" } } { "One of " { $snippet "x11" } ", " { $snippet "windows" } ", or " { $snippet "cocoa" } ". The default is platform-specific." } } @@ -74,9 +74,9 @@ ARTICLE: "bootstrap-cli-args" "Command line switches for bootstrap" "By default, all optional components are loaded. To load all optional components except for a given list, use the " { $snippet "-exclude=" } " switch; to only load specified optional components, use the " { $snippet "-include=" } "." $nl "For example, to build an image with the compiler but no other components, you could do:" -{ $code "./factor -i=boot.ppc.image -include=compiler" } +{ $code "./factor -i=boot.macosx-ppc.image -include=compiler" } "To build an image with everything except for the user interface and graphical tools," -{ $code "./factor -i=boot.ppc.image -exclude=\"ui ui.tools\"" } +{ $code "./factor -i=boot.macosx-ppc.image -exclude=\"ui ui.tools\"" } "To generate a bootstrap image in the first place, see " { $link "bootstrap.image" } "." ; ARTICLE: "standard-cli-args" "Command line switches for general usage" @@ -84,17 +84,43 @@ ARTICLE: "standard-cli-args" "Command line switches for general usage" { $table { { $snippet "-e=" { $emphasis "code" } } { "This specifies a code snippet to evaluate. If you want Factor to exit immediately after, also specify " { $snippet "-run=none" } "." } } { { $snippet "-run=" { $emphasis "vocab" } } { { $snippet { $emphasis "vocab" } } " is the name of a vocabulary with a " { $link POSTPONE: MAIN: } " hook to run on startup, for example " { $vocab-link "listener" } ", " { $vocab-link "ui" } " or " { $vocab-link "none" } "." } } - { { $snippet "-no-user-init" } { "Inhibits the running of the " { $snippet ".factor-rc" } " file in the user's home directory on startup." } } + { { $snippet "-no-user-init" } { "Inhibits the running of user initialization files on startup. See " { $link "rc-files" } "." } } { { $snippet "-quiet" } { "If set, " { $link run-file } " and " { $link require } " will not print load messages." } } { { $snippet "-script" } { "Equivalent to " { $snippet "-quiet -run=none" } "." $nl "On Unix systems, Factor can be used for scripting - just create an executable text file whose first line is:" { $code "#! /usr/local/bin/factor -script" } "The space after " { $snippet "#!" } " is necessary because of Factor syntax." } } } ; -ARTICLE: "rc-files" "Running code on startup" -"Unless the " { $snippet "-no-user-init" } " command line switch is specified, The startup routine runs the " { $snippet ".factor-rc" } " file in the user's home directory, if it exists. This file can contain initialization and customization for your development environment." +ARTICLE: "factor-boot-rc" "Bootstrap initialization file" +"The botstrap initialization file is named " { $snippet "factor-boot-rc" } " on Windows and " { $snippet ".factor-boot-rc" } " on Unix. This file can contain " { $link require } " calls for vocabularies you use frequently, and other such long-running tasks that you do not want to perform every time Factor starts." $nl -"The " { $snippet ".factor-rc" } " and " { $snippet ".factor-boot-rc" } " files can be run explicitly:" -{ $subsection run-user-init } -{ $subsection run-bootstrap-init } ; +"A word to run this file from an existing Factor session:" +{ $subsection run-bootstrap-init } +"For example, if you changed " { $snippet ".factor-boot-rc" } " and do not want to bootstrap again, you can just invoke " { $link run-bootstrap-init } " in the listener." ; + +ARTICLE: "factor-rc" "Startup initialization file" +"The startup initialization file is named " { $snippet "factor-rc" } " on Windows and " { $snippet ".factor-rc" } " on Unix. If it exists, it is run every time Factor starts." +$nl +"A word to run this file from an existing Factor session:" +{ $subsection run-user-init } ; + +ARTICLE: "rc-files" "Running code on startup" +"Factor looks for two files in your home directory." +{ $subsection "factor-boot-rc" } +{ $subsection "factor-rc" } +"The " { $snippet "-no-user-init" } " command line switch will inhibit the running of these files." +$nl +"If you are unsure where the files should be located, evaluate the following code:" +{ $code + "USE: command-line" + "\"factor-rc\" rc-path print" + "\"factor-boot-rc\" rc-path print" +} +"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration, adds an additional vocabulary root (see " { $link "vocabs.roots" } "), and increases the font size in the UI by setting the DPI (dots-per-inch) variable:" +{ $code + "USING: editors.gvim vocabs.loader ui.freetype namespaces sequences ;" + "\"/opt/local/bin\" \\ gvim-path set-global" + "\"/home/jane/src/\" vocab-roots get push" + "100 dpi set-global" +} ; ARTICLE: "cli" "Command line usage" "Zero or more command line arguments may be passed to the Factor runtime. Command line arguments starting with a dash (" { $snippet "-" } ") is interpreted as switches. All other arguments are taken to be file names to be run by " { $link run-file } "." diff --git a/basis/command-line/command-line.factor b/basis/command-line/command-line.factor index 37dbf9b7a6..7691f6877b 100644 --- a/basis/command-line/command-line.factor +++ b/basis/command-line/command-line.factor @@ -5,14 +5,18 @@ kernel.private namespaces parser sequences strings system splitting io.files eval ; IN: command-line +: rc-path ( name -- path ) + os windows? [ "." prepend ] unless + home prepend-path ; + : run-bootstrap-init ( -- ) "user-init" get [ - home ".factor-boot-rc" append-path ?run-file + "factor-boot-rc" rc-path ?run-file ] when ; : run-user-init ( -- ) "user-init" get [ - home ".factor-rc" append-path ?run-file + "factor-rc" rc-path ?run-file ] when ; : cli-var-param ( name value -- ) swap set-global ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 0d45b28126..9f6e8e9c9b 100644 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -235,7 +235,7 @@ M: float-regs reg-class-variable drop float-regs ; GENERIC: inc-reg-class ( register-class -- ) : ?dummy-stack-params ( reg-class -- ) - dummy-stack-params? [ reg-size stack-params +@ ] [ drop ] if ; + dummy-stack-params? [ reg-size cell align stack-params +@ ] [ drop ] if ; : ?dummy-int-params ( reg-class -- ) dummy-int-params? [ reg-size cell /i 1 max int-regs +@ ] [ drop ] if ; @@ -264,7 +264,7 @@ M: object reg-class-full? : spill-param ( reg-class -- n reg-class ) stack-params get - >r reg-size stack-params +@ r> + >r reg-size cell align stack-params +@ r> stack-params ; : fastcall-param ( reg-class -- n reg-class ) 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/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index d7e82402d5..3ca6fc87f3 100644 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -146,13 +146,21 @@ FUNCTION: void ffi_test_20 double x1, double x2, double x3, ! Make sure XT doesn't get clobbered in stack frame -: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a ptr -- result y ) - "void" +: ffi_test_31 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result y ) + "int" f "ffi_test_31" { "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" "int" } alien-invoke gc 3 ; -[ 3 ] [ 42 [ ] each ffi_test_31 ] unit-test +[ 861 3 ] [ 42 [ ] each ffi_test_31 ] unit-test + +: ffi_test_31_point_5 ( a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a a -- result ) + "float" + f "ffi_test_31_point_5" + { "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" "float" } + alien-invoke ; + +[ 861.0 ] [ 42 [ >float ] each ffi_test_31_point_5 ] unit-test FUNCTION: longlong ffi_test_21 long x long y ; diff --git a/basis/compiler/tree/builder/builder.factor b/basis/compiler/tree/builder/builder.factor index c2ec6552cd..4e79c4cd2d 100644 --- a/basis/compiler/tree/builder/builder.factor +++ b/basis/compiler/tree/builder/builder.factor @@ -34,14 +34,10 @@ IN: compiler.tree.builder if ; : (build-tree-from-word) ( word -- ) - dup - [ "inline" word-prop ] - [ "recursive" word-prop ] bi and [ - 1quotation f initial-recursive-state infer-quot - ] [ - [ specialized-def ] [ initial-recursive-state ] bi - infer-quot - ] if ; + dup initial-recursive-state recursive-state set + dup [ "inline" word-prop ] [ "recursive" word-prop ] bi and + [ 1quotation ] [ specialized-def ] if + infer-quot-here ; : check-cannot-infer ( word -- ) dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ; diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 96dd577c10..d26e7f6ff7 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -141,10 +141,10 @@ HOOK: %loop-entry cpu ( -- ) HOOK: small-enough? cpu ( n -- ? ) ! Is this structure small enough to be returned in registers? -HOOK: struct-small-enough? cpu ( heap-size -- ? ) +HOOK: struct-small-enough? cpu ( c-type -- ? ) -! Do we pass value structs by value or hidden reference? -HOOK: value-structs? cpu ( -- ? ) +! Do we pass this struct by value or hidden reference? +HOOK: value-struct? cpu ( c-type -- ? ) ! If t, all parameters are shadowed by dummy stack parameters HOOK: dummy-stack-params? cpu ( -- ? ) @@ -207,14 +207,3 @@ M: object %callback-return drop %return ; M: stack-params param-reg drop ; M: stack-params param-regs drop f ; - -: if-small-struct ( n size true false -- ? ) - [ 2dup [ not ] [ struct-small-enough? ] bi* and ] 2dip - [ '[ nip @ ] ] dip if ; - inline - -: %unbox-struct ( n c-type -- ) - [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ; - -: %box-struct ( n c-type -- ) - [ %box-small-struct ] [ %box-large-struct ] if-small-struct ; diff --git a/basis/cpu/ppc/linux/linux.factor b/basis/cpu/ppc/linux/linux.factor index 090495aa11..5cfa1391c4 100644 --- a/basis/cpu/ppc/linux/linux.factor +++ b/basis/cpu/ppc/linux/linux.factor @@ -15,7 +15,7 @@ M: linux lr-save 1 cells ; M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 } ; -M: ppc value-structs? f ; +M: ppc value-struct? drop f ; M: ppc dummy-stack-params? f ; diff --git a/basis/cpu/ppc/macosx/macosx.factor b/basis/cpu/ppc/macosx/macosx.factor index 877fb37d31..c742cf2ddc 100644 --- a/basis/cpu/ppc/macosx/macosx.factor +++ b/basis/cpu/ppc/macosx/macosx.factor @@ -16,7 +16,7 @@ M: macosx lr-save 2 cells ; M: float-regs param-regs drop { 1 2 3 4 5 6 7 8 9 10 11 12 13 } ; -M: ppc value-structs? t ; +M: ppc value-struct? drop t ; M: ppc dummy-stack-params? t ; diff --git a/basis/cpu/x86/64/winnt/winnt.factor b/basis/cpu/x86/64/winnt/winnt.factor index 0124c40877..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 @@ -10,8 +10,9 @@ M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ; M: x86.64 reserved-area-size 4 cells ; -M: x86.64 struct-small-enough? ( size -- ? ) - heap-size cell <= ; +M: x86.64 struct-small-enough? heap-size { 1 2 4 8 } member? ; + +M: x86.64 value-struct? heap-size { 1 2 4 8 } member? ; M: x86.64 dummy-stack-params? f ; @@ -21,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/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index dfe3d3e55e..58d95ffcde 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -507,7 +507,7 @@ M: x86 %prepare-alien-invoke temp-reg-1 2 cells [+] ds-reg MOV temp-reg-1 3 cells [+] rs-reg MOV ; -M: x86 value-structs? t ; +M: x86 value-struct? drop t ; M: x86 small-enough? ( n -- ? ) HEX: -80000000 HEX: 7fffffff between? ; diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor index 1550fccc0b..79387f9820 100644 --- a/basis/editors/emacs/emacs.factor +++ b/basis/editors/emacs/emacs.factor @@ -1,11 +1,11 @@ USING: definitions io.launcher kernel parser words sequences math -math.parser namespaces editors make ; +math.parser namespaces editors make system ; IN: editors.emacs : emacsclient ( file line -- ) [ \ emacsclient get "emacsclient" or , - "--no-wait" , + os windows? [ "--no-wait" , ] unless "+" swap number>string append , , ] { } make try-process ; 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/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor index 128ec448b7..0fe80427b9 100644 --- a/basis/furnace/alloy/alloy.factor +++ b/basis/furnace/alloy/alloy.factor @@ -4,7 +4,6 @@ USING: kernel sequences db.tuples alarms calendar db fry furnace.db furnace.cache furnace.asides -furnace.referrer furnace.sessions furnace.conversations furnace.auth.providers @@ -24,8 +23,7 @@ IN: furnace.alloy ] dip - - ; + ; : start-expiring ( db -- ) '[ diff --git a/basis/furnace/auth/features/edit-profile/edit-profile.xml b/basis/furnace/auth/features/edit-profile/edit-profile.xml index 878bdd64fb..f85869e56a 100644 --- a/basis/furnace/auth/features/edit-profile/edit-profile.xml +++ b/basis/furnace/auth/features/edit-profile/edit-profile.xml @@ -61,7 +61,7 @@

- +

diff --git a/basis/furnace/auth/features/recover-password/recover-1.xml b/basis/furnace/auth/features/recover-password/recover-1.xml index a8b67513a4..6dc882538e 100644 --- a/basis/furnace/auth/features/recover-password/recover-1.xml +++ b/basis/furnace/auth/features/recover-password/recover-1.xml @@ -32,7 +32,7 @@ - + diff --git a/basis/furnace/auth/features/recover-password/recover-3.xml b/basis/furnace/auth/features/recover-password/recover-3.xml index 2df400ffe2..ec68e27947 100644 --- a/basis/furnace/auth/features/recover-password/recover-3.xml +++ b/basis/furnace/auth/features/recover-password/recover-3.xml @@ -31,7 +31,7 @@

- +

diff --git a/basis/furnace/auth/features/registration/register.xml b/basis/furnace/auth/features/registration/register.xml index 45c090905e..1e2fec6dd0 100644 --- a/basis/furnace/auth/features/registration/register.xml +++ b/basis/furnace/auth/features/registration/register.xml @@ -62,7 +62,7 @@

- +

diff --git a/basis/furnace/auth/login/login.xml b/basis/furnace/auth/login/login.xml index 917c182fb3..9a37174e95 100644 --- a/basis/furnace/auth/login/login.xml +++ b/basis/furnace/auth/login/login.xml @@ -35,7 +35,7 @@

- +

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 4100a34d72..6b90ba6937 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -10,17 +10,15 @@ IN: help.html : escape-char ( ch -- ) dup H{ - { CHAR: " "__quote__" } + { CHAR: " "__quo__" } { CHAR: * "__star__" } { CHAR: : "__colon__" } { CHAR: < "__lt__" } { CHAR: > "__gt__" } - { CHAR: ? "__question__" } - { CHAR: \\ "__backslash__" } + { CHAR: ? "__que__" } + { CHAR: \\ "__back__" } { CHAR: | "__pipe__" } - { CHAR: _ "__underscore__" } { CHAR: / "__slash__" } - { CHAR: \\ "__backslash__" } { CHAR: , "__comma__" } { CHAR: @ "__at__" } } at [ % ] [ , ] ?if ; @@ -117,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/io/windows/tags.txt b/basis/io/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/basis/io/windows/tags.txt +++ b/basis/io/windows/tags.txt @@ -1,2 +1 @@ unportable -windows 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/functions/functions.factor b/basis/math/functions/functions.factor index 43efc35c27..c582c560a9 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -15,7 +15,7 @@ IN: math.functions PRIVATE> : rect> ( x y -- z ) - over real? over real? and [ + 2dup [ real? ] both? [ (rect>) ] [ "Complex number must have real components" throw @@ -27,10 +27,10 @@ M: real sqrt >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ; : each-bit ( n quot: ( ? -- ) -- ) - over 0 = pick -1 = or [ + over [ 0 = ] [ -1 = ] bi or [ 2drop ] [ - 2dup >r >r >r odd? r> call r> 2/ r> each-bit + 2dup { [ odd? ] [ call ] [ 2/ ] [ each-bit ] } spread ] if ; inline recursive : map-bits ( n quot: ( ? -- obj ) -- seq ) @@ -69,8 +69,7 @@ PRIVATE> >rect [ >float ] bi@ ; inline : >polar ( z -- abs arg ) - >float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; - inline + >float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; inline : cis ( arg -- z ) dup fcos swap fsin rect> ; inline @@ -79,11 +78,10 @@ PRIVATE> r >r >float-rect swap r> swap fpow r> rot * fexp /f ; - inline + [ >float-rect swap ] [ swap fpow ] [ rot * fexp /f ] tri* ; inline : ^theta ( w abs arg -- theta ) - >r >r >float-rect r> flog * swap r> * + ; inline + [ >float-rect ] [ flog * swap ] [ * + ] tri* ; inline : ^complex ( x y -- z ) swap >polar [ ^mag ] [ ^theta ] 3bi polar> ; inline @@ -106,18 +104,18 @@ PRIVATE> : (^mod) ( n x y -- z ) 1 swap [ - [ dupd * pick mod ] when >r sq over mod r> + [ dupd * pick mod ] when [ sq over mod ] dip ] each-bit 2nip ; inline : (gcd) ( b a x y -- a d ) over zero? [ 2nip ] [ - swap [ /mod >r over * swapd - r> ] keep (gcd) + swap [ /mod [ over * swapd - ] dip ] keep (gcd) ] if ; : gcd ( x y -- a d ) - 0 -rot 1 -rot (gcd) dup 0 < [ neg ] when ; foldable + [ 0 1 ] 2dip (gcd) dup 0 < [ neg ] when ; foldable : lcm ( a b -- c ) [ * ] 2keep gcd nip /i ; foldable @@ -131,7 +129,7 @@ PRIVATE> : ^mod ( x y n -- z ) over 0 < [ - [ >r neg r> ^mod ] keep mod-inv + [ [ neg ] dip ^mod ] keep mod-inv ] [ -rot (^mod) ] if ; foldable @@ -141,14 +139,14 @@ GENERIC: absq ( x -- y ) foldable M: real absq sq ; : ~abs ( x y epsilon -- ? ) - >r - abs r> < ; + [ - abs ] dip < ; : ~rel ( x y epsilon -- ? ) - >r [ - abs ] 2keep [ abs ] bi@ + r> * < ; + [ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ; : ~ ( x y epsilon -- ? ) { - { [ pick fp-nan? pick fp-nan? or ] [ 3drop f ] } + { [ 2over [ fp-nan? ] either? ] [ 3drop f ] } { [ dup zero? ] [ drop number= ] } { [ dup 0 < ] [ ~rel ] } [ ~abs ] diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 54ee0ac894..4182d25524 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -12,10 +12,10 @@ SYMBOL: full-interval TUPLE: interval { from read-only } { to read-only } ; : ( from to -- int ) - over first over first { + 2dup [ first ] bi@ { { [ 2dup > ] [ 2drop 2drop empty-interval ] } { [ 2dup = ] [ - 2drop over second over second and + 2drop 2dup [ second ] both? [ interval boa ] [ 2drop empty-interval ] if ] } [ 2drop interval boa ] @@ -26,16 +26,16 @@ TUPLE: interval { from read-only } { to read-only } ; : closed-point ( n -- endpoint ) t 2array ; : [a,b] ( a b -- interval ) - >r closed-point r> closed-point ; foldable + [ closed-point ] dip closed-point ; foldable : (a,b) ( a b -- interval ) - >r open-point r> open-point ; foldable + [ open-point ] dip open-point ; foldable : [a,b) ( a b -- interval ) - >r closed-point r> open-point ; foldable + [ closed-point ] dip open-point ; foldable : (a,b] ( a b -- interval ) - >r open-point r> closed-point ; foldable + [ open-point ] dip closed-point ; foldable : [a,a] ( a -- interval ) closed-point dup ; foldable @@ -51,11 +51,11 @@ TUPLE: interval { from read-only } { to read-only } ; : [-inf,inf] ( -- interval ) full-interval ; inline : compare-endpoints ( p1 p2 quot -- ? ) - >r over first over first r> call [ + [ 2dup [ first ] bi@ ] dip call [ 2drop t ] [ - over first over first = [ - swap second swap second not or + 2dup [ first ] bi@ = [ + [ second ] bi@ not or ] [ 2drop f ] if @@ -86,7 +86,7 @@ TUPLE: interval { from read-only } { to read-only } ; ] if ; : (interval-op) ( p1 p2 quot -- p3 ) - [ [ first ] [ first ] [ ] tri* call ] + [ [ first ] [ first ] [ call ] tri* ] [ drop [ second ] both? ] 3bi 2array ; inline @@ -177,7 +177,7 @@ TUPLE: interval { from read-only } { to read-only } ; drop f ] [ interval>points - 2dup [ second ] bi@ and + 2dup [ second ] both? [ [ first ] bi@ = ] [ 2drop f ] if ] if ; @@ -193,9 +193,9 @@ TUPLE: interval { from read-only } { to read-only } ; dup [ interval>points [ first ] bi@ [a,b] ] when ; : interval-integer-op ( i1 i2 quot -- i3 ) - >r 2dup - [ interval>points [ first integer? ] both? ] both? - r> [ 2drop [-inf,inf] ] if ; inline + [ + 2dup [ interval>points [ first integer? ] both? ] both? + ] dip [ 2drop [-inf,inf] ] if ; inline : interval-shift ( i1 i2 -- i3 ) #! Inaccurate; could be tighter @@ -302,7 +302,7 @@ SYMBOL: incomparable 2tri and and ; : (interval<) ( i1 i2 -- i1 i2 ? ) - over from>> over from>> endpoint< ; + 2dup [ from>> ] bi@ endpoint< ; : interval< ( i1 i2 -- ? ) { @@ -314,10 +314,10 @@ SYMBOL: incomparable } cond 2nip ; : left-endpoint-<= ( i1 i2 -- ? ) - >r from>> r> to>> = ; + [ from>> ] dip to>> = ; : right-endpoint-<= ( i1 i2 -- ? ) - >r to>> r> from>> = ; + [ to>> ] dip from>> = ; : interval<= ( i1 i2 -- ? ) { diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor index fd0e910b37..6874b79d2e 100644 --- a/basis/math/partial-dispatch/partial-dispatch.factor +++ b/basis/math/partial-dispatch/partial-dispatch.factor @@ -126,7 +126,7 @@ SYMBOL: fast-math-ops : math-method* ( word left right -- quot ) 3dup math-op - [ >r 3drop r> 1quotation ] [ drop math-method ] if ; + [ [ 3drop ] dip 1quotation ] [ drop math-method ] if ; : math-both-known? ( word left right -- ? ) 3dup math-op @@ -157,13 +157,13 @@ SYMBOL: fast-math-ops ] bi@ append ; : each-derived-op ( word quot -- ) - >r derived-ops r> each ; inline + [ derived-ops ] dip each ; inline : each-fast-derived-op ( word quot -- ) - >r fast-derived-ops r> each ; inline + [ fast-derived-ops ] dip each ; inline : each-integer-derived-op ( word quot -- ) - >r integer-derived-ops r> each ; inline + [ integer-derived-ops ] dip each ; inline [ [ diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 5acdc43ca3..41fd28e441 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -8,7 +8,7 @@ TUPLE: range { step read-only } ; : ( a b step -- range ) - >r over - r> + [ over - ] dip [ / 1+ 0 max >integer ] keep range boa ; inline diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor index d9dea22b7b..81294d29f7 100644 --- a/basis/math/ratios/ratios.factor +++ b/basis/math/ratios/ratios.factor @@ -12,10 +12,10 @@ IN: math.ratios dup 1 number= [ drop ] [ ] if ; inline : scale ( a/b c/d -- a*d b*c ) - 2>fraction >r * swap r> * swap ; inline + 2>fraction [ * swap ] dip * swap ; inline : ratio+d ( a/b c/d -- b*d ) - denominator swap denominator * ; inline + [ denominator ] bi@ * ; inline PRIVATE> @@ -24,7 +24,7 @@ M: integer / "Division by zero" throw ] [ dup 0 < [ [ neg ] bi@ ] when - 2dup gcd nip tuck /i >r /i r> fraction> + 2dup gcd nip tuck /i [ /i ] dip fraction> ] if ; M: ratio hashcode* @@ -52,7 +52,7 @@ M: ratio >= scale >= ; M: ratio + 2dup scale + -rot ratio+d / ; M: ratio - 2dup scale - -rot ratio+d / ; -M: ratio * 2>fraction * >r * r> / ; +M: ratio * 2>fraction * [ * ] dip / ; M: ratio / scale / ; M: ratio /i scale /i ; M: ratio /f scale /f ; diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor index 140eddb2f6..7ee948be65 100644 --- a/basis/math/vectors/vectors-docs.factor +++ b/basis/math/vectors/vectors-docs.factor @@ -34,7 +34,7 @@ HELP: n*v { $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ; HELP: v*n -{ $values { "n" "a number" } { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } } +{ $values { "u" "a sequence of numbers" } { "n" "a number" } { "v" "a sequence of numbers" } } { $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ; HELP: n/v diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 5316720b2f..01a421b4e7 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -25,7 +25,7 @@ IN: math.vectors : normalize ( u -- v ) dup norm v/n ; : set-axis ( u v axis -- w ) - [ >r zero? 2over ? r> swap nth ] map-index 2nip ; + [ [ zero? 2over ? ] dip swap nth ] map-index 2nip ; HINTS: vneg { array } ; HINTS: norm-sq { array } ; diff --git a/basis/opengl/gl/windows/tags.txt b/basis/opengl/gl/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/basis/opengl/gl/windows/tags.txt +++ b/basis/opengl/gl/windows/tags.txt @@ -1,2 +1 @@ unportable -windows diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 64326f340e..ecb4c4a08c 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -31,7 +31,7 @@ IN: opengl over glEnableClientState dip glDisableClientState ; inline : words>values ( word/value-seq -- value-seq ) - [ dup word? [ execute ] [ ] if ] map ; + [ dup word? [ execute ] when ] map ; : (all-enabled) ( seq quot -- ) over [ glEnable ] each dip [ glDisable ] each ; inline @@ -64,17 +64,18 @@ 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 ; : (rect-vertices) ( dim -- vertices ) { - [ drop 0 1 ] - [ first 1- 1 ] - [ [ first 1- ] [ second ] bi ] - [ second 0 swap ] + [ drop 0.5 0.5 ] + [ 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/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor index 6a4ac71eb8..8eaaab3c1d 100644 --- a/basis/prettyprint/prettyprint-tests.factor +++ b/basis/prettyprint/prettyprint-tests.factor @@ -355,3 +355,13 @@ INTERSECTION: intersection-see-test sequence number ; [ ] [ \ curry see ] unit-test [ "POSTPONE: [" ] [ \ [ unparse ] unit-test + +TUPLE: started-out-hustlin' ; + +GENERIC: ended-up-ballin' + +M: started-out-hustlin' ended-up-ballin' ; inline + +[ "USING: prettyprint.tests ;\nM: started-out-hustlin' ended-up-ballin' ; inline\n" ] [ + [ { started-out-hustlin' ended-up-ballin' } see ] with-string-writer +] unit-test diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index b0293a8759..3befdaff2b 100644 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -253,6 +253,9 @@ M: object see block> ] with-use nl ; +M: method-spec see + first2 method see ; + GENERIC: see-class* ( word -- ) M: union-class see-class* diff --git a/basis/random/windows/tags.txt b/basis/random/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/basis/random/windows/tags.txt +++ b/basis/random/windows/tags.txt @@ -1,2 +1 @@ unportable -windows diff --git a/basis/regexp/backend/backend.factor b/basis/regexp/backend/backend.factor index 1a261fb0af..75a010b705 100644 --- a/basis/regexp/backend/backend.factor +++ b/basis/regexp/backend/backend.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors hashtables kernel math state-tables vars vectors ; +USING: accessors hashtables kernel math state-tables vectors ; IN: regexp.backend TUPLE: regexp diff --git a/basis/regexp/classes/classes.factor b/basis/regexp/classes/classes.factor index a2d91b97fb..240b27a9cc 100644 --- a/basis/regexp/classes/classes.factor +++ b/basis/regexp/classes/classes.factor @@ -30,6 +30,10 @@ M: ascii-class class-member? ( obj class -- ? ) M: digit-class class-member? ( obj class -- ? ) drop digit? ; +M: c-identifier-class class-member? ( obj class -- ? ) + drop + { [ digit? ] [ Letter? ] [ CHAR: _ = ] } 1|| ; + M: alpha-class class-member? ( obj class -- ? ) drop alpha? ; diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index d04016b93a..b5022c602e 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) ( -- ) @@ -294,6 +294,7 @@ ERROR: unrecognized-escape char ; read1 { { CHAR: \ [ CHAR: \ ] } + { CHAR: / [ CHAR: / ] } { CHAR: ^ [ CHAR: ^ ] } { CHAR: $ [ CHAR: $ ] } { CHAR: - [ CHAR: - ] } diff --git a/basis/regexp/regexp-tests.factor b/basis/regexp/regexp-tests.factor index 2339628801..4878b67d0f 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 @@ -43,6 +46,18 @@ IN: regexp-tests [ t ] [ "a" ".+" matches? ] unit-test [ t ] [ "ab" ".+" matches? ] unit-test +[ t ] [ " " "[\\s]" matches? ] unit-test +[ f ] [ "a" "[\\s]" matches? ] unit-test +[ f ] [ " " "[\\S]" matches? ] unit-test +[ t ] [ "a" "[\\S]" matches? ] unit-test +[ f ] [ " " "[\\w]" matches? ] unit-test +[ t ] [ "a" "[\\w]" matches? ] unit-test +[ t ] [ " " "[\\W]" matches? ] unit-test +[ f ] [ "a" "[\\W]" matches? ] unit-test + +[ t ] [ "/" "\\/" matches? ] unit-test + +[ t ] [ "a" R' a'i matches? ] unit-test [ t ] [ "" "a|b*|c+|d?" matches? ] unit-test [ t ] [ "a" "a|b*|c+|d?" matches? ] unit-test @@ -331,3 +346,7 @@ IN: regexp-tests [ { 0 3 } ] [ "abc" "(ab|a)(bc)?" first-match ] unit-test [ { 23 24 } ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" first-match ] unit-test + +[ t ] [ "a:b" ".+:?" matches? ] unit-test + +[ 1 ] [ "hello" ".+?" match length ] unit-test diff --git a/basis/regexp/regexp.factor b/basis/regexp/regexp.factor index 083a48a470..c9a1d2f47d 100644 --- a/basis/regexp/regexp.factor +++ b/basis/regexp/regexp.factor @@ -28,7 +28,7 @@ IN: regexp : match ( string regexp -- pair ) do-match return-match ; -: match* ( string regexp -- pair ) +: match* ( string regexp -- pair captured-groups ) do-match [ return-match ] [ captured-groups>> ] bi ; : matches? ( string regexp -- ? ) @@ -129,8 +129,6 @@ IN: regexp : option? ( option regexp -- ? ) options>> key? ; -USE: multiline -/* M: regexp pprint* [ [ @@ -139,4 +137,3 @@ M: regexp pprint* case-insensitive swap option? [ "i" % ] when ] "" make ] keep present-text ; -*/ 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/stack-checker/errors/errors.factor b/basis/stack-checker/errors/errors.factor index efdc7e23b2..31ae0a6789 100644 --- a/basis/stack-checker/errors/errors.factor +++ b/basis/stack-checker/errors/errors.factor @@ -24,7 +24,7 @@ M: inference-error error-help error>> error-help ; +warning+ (inference-error) ; inline M: inference-error error. - [ "In word: " write word>> . ] [ error>> error. ] bi ; + [ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ; TUPLE: literal-expected ; @@ -108,3 +108,9 @@ M: inconsistent-recursive-call-error error. "The recursive word " write word>> pprint " calls itself with a different set of quotation parameters than were input" print ; + +TUPLE: unknown-primitive-error ; + +M: unknown-primitive-error error. + drop + "Cannot determine stack effect statically" print ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 4aea0f2d28..fdc4b4b35c 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -162,7 +162,7 @@ M: object infer-call* { \ load-locals [ infer-load-locals ] } { \ get-local [ infer-get-local ] } { \ drop-locals [ infer-drop-locals ] } - { \ do-primitive [ \ do-primitive cannot-infer-effect ] } + { \ do-primitive [ unknown-primitive-error inference-warning ] } { \ alien-invoke [ infer-alien-invoke ] } { \ alien-indirect [ infer-alien-indirect ] } { \ alien-callback [ infer-alien-callback ] } diff --git a/basis/stack-checker/recursive-state/recursive-state.factor b/basis/stack-checker/recursive-state/recursive-state.factor index 41d7331230..9abfb1fcd5 100644 --- a/basis/stack-checker/recursive-state/recursive-state.factor +++ b/basis/stack-checker/recursive-state/recursive-state.factor @@ -4,9 +4,7 @@ USING: accessors arrays sequences kernel sequences assocs namespaces stack-checker.recursive-state.tree ; IN: stack-checker.recursive-state -TUPLE: recursive-state words word quotations inline-words ; - -C: recursive-state +TUPLE: recursive-state word words quotations inline-words ; : prepare-recursive-state ( word rstate -- rstate ) swap >>word diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 9bf8ed62f0..defcde53f0 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -580,3 +580,5 @@ DEFER: eee' dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive [ bogus-error ] must-infer + +[ [ clear ] infer. ] [ inference-error? ] must-fail-with diff --git a/extra/state-tables/authors.txt b/basis/state-tables/authors.txt similarity index 100% rename from extra/state-tables/authors.txt rename to basis/state-tables/authors.txt diff --git a/extra/state-tables/state-tables-tests.factor b/basis/state-tables/state-tables-tests.factor similarity index 100% rename from extra/state-tables/state-tables-tests.factor rename to basis/state-tables/state-tables-tests.factor diff --git a/extra/state-tables/state-tables.factor b/basis/state-tables/state-tables.factor similarity index 100% rename from extra/state-tables/state-tables.factor rename to basis/state-tables/state-tables.factor diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index a7332ea9ea..f8f9680c16 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -9,7 +9,7 @@ sorting compiler.units definitions ; QUALIFIED: bootstrap.stage2 QUALIFIED: classes QUALIFIED: command-line -QUALIFIED: compiler.errors.private +QUALIFIED: compiler.errors QUALIFIED: continuations QUALIFIED: definitions QUALIFIED: init @@ -291,7 +291,7 @@ IN: tools.deploy.shaker strip-debugger? [ { - compiler.errors.private:compiler-errors + compiler.errors:compiler-errors continuations:thread-error-hook } % ] when diff --git a/basis/tools/deploy/windows/tags.txt b/basis/tools/deploy/windows/tags.txt old mode 100644 new mode 100755 index b58a515ed8..660d511420 --- a/basis/tools/deploy/windows/tags.txt +++ b/basis/tools/deploy/windows/tags.txt @@ -1,3 +1,2 @@ unportable -windows tools diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor index 5a6118fb00..d2dfe56ed4 100644 --- a/basis/ui/freetype/freetype.factor +++ b/basis/ui/freetype/freetype.factor @@ -196,7 +196,6 @@ M: freetype-renderer string-height ( open-font string -- h ) :: (draw-string) ( open-font sprites string loc -- ) GL_TEXTURE_2D [ loc [ - -0.5 0.5 0.0 glTranslated string open-font string char-widths scan-sums [ [ open-font sprites ] 2dip draw-char ] 2each 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 0d0611f532..2cf6d24154 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -120,7 +120,7 @@ M: editor ungraft* : scroll>caret ( editor -- ) dup graft-state>> second [ - dup caret-loc over caret-dim { 1 0 } v+ + dup caret-loc over caret-dim over scroll>rect ] when drop ; diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor old mode 100644 new mode 100755 index 0356e7fd4d..feca8f7c63 --- a/basis/ui/gadgets/grid-lines/grid-lines.factor +++ b/basis/ui/gadgets/grid-lines/grid-lines.factor @@ -18,15 +18,16 @@ SYMBOL: grid-dim grid-dim get spin set-axis ; : draw-grid-lines ( gaps orientation -- ) - grid get rot grid-positions grid get rect-dim suffix [ - grid-line-from/to gl-line - ] with each ; + [ grid get swap grid-positions grid get rect-dim suffix ] dip + [ [ v- ] curry map ] keep + [ swap grid-line-from/to gl-line ] curry each ; M: grid-lines draw-boundary color>> gl-color [ dup grid set dup rect-dim half-gap v- grid-dim set compute-grid - { 0 1 } draw-grid-lines - { 1 0 } draw-grid-lines + [ { 1 0 } draw-grid-lines ] + [ { 0 1 } draw-grid-lines ] + bi* ] with-scope ; diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor old mode 100644 new mode 100755 index 71304aca0b..1e4c9c34f1 --- a/basis/ui/render/render.factor +++ b/basis/ui/render/render.factor @@ -23,7 +23,7 @@ SYMBOL: viewport-translation [ rect-intersect ] keep dim>> dup { 0 1 } v* viewport-translation set { 0 0 } over gl-viewport - -0.5 swap first2 [ 0.5 - ] [ 0.5 + ] bi* 0.5 gluOrtho2D + 0 swap first2 0 gluOrtho2D clip set do-clip ; 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/validators/validators-tests.factor b/basis/validators/validators-tests.factor index bd24323f20..d4f3487d0b 100644 --- a/basis/validators/validators-tests.factor +++ b/basis/validators/validators-tests.factor @@ -52,3 +52,5 @@ namespaces assocs ; [ "4561_2612_1234_5467" v-credit-card ] must-fail [ "4561-2621-1234-5467" v-credit-card ] must-fail + +[ t ] [ "http://double.co.nz/w?v=foo" dup v-url = ] unit-test diff --git a/basis/validators/validators.factor b/basis/validators/validators.factor index 0ddced63e8..7c41d3efdb 100644 --- a/basis/validators/validators.factor +++ b/basis/validators/validators.factor @@ -62,9 +62,7 @@ IN: validators v-regexp ; : v-url ( str -- str ) - "URL" - R' (ftp|http|https)://(\w+:?\w*@)?(\S+)(:[0-9]+)?(/|/([\w#!:.?+=&%@!\-/]))?' - v-regexp ; + "URL" R' (ftp|http|https)://\S+' v-regexp ; : v-captcha ( str -- str ) dup empty? [ "must remain blank" throw ] unless ; diff --git a/basis/windows/com/syntax/tags.txt b/basis/windows/com/syntax/tags.txt old mode 100644 new mode 100755 index 71c5900baf..2320bdd648 --- a/basis/windows/com/syntax/tags.txt +++ b/basis/windows/com/syntax/tags.txt @@ -1,4 +1,2 @@ unportable -windows -com bindings diff --git a/basis/windows/com/tags.txt b/basis/windows/com/tags.txt old mode 100644 new mode 100755 index 71c5900baf..2320bdd648 --- a/basis/windows/com/tags.txt +++ b/basis/windows/com/tags.txt @@ -1,4 +1,2 @@ unportable -windows -com bindings diff --git a/basis/windows/com/wrapper/tags.txt b/basis/windows/com/wrapper/tags.txt old mode 100644 new mode 100755 index 71c5900baf..2320bdd648 --- a/basis/windows/com/wrapper/tags.txt +++ b/basis/windows/com/wrapper/tags.txt @@ -1,4 +1,2 @@ unportable -windows -com bindings diff --git a/basis/windows/dinput/tags.txt b/basis/windows/dinput/tags.txt index 1431506222..2320bdd648 100755 --- a/basis/windows/dinput/tags.txt +++ b/basis/windows/dinput/tags.txt @@ -1,3 +1,2 @@ unportable -windows bindings 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/tags.txt b/basis/windows/tags.txt old mode 100644 new mode 100755 index 1431506222..2320bdd648 --- a/basis/windows/tags.txt +++ b/basis/windows/tags.txt @@ -1,3 +1,2 @@ unportable -windows bindings 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/compiler/errors/errors-docs.factor b/core/compiler/errors/errors-docs.factor index d86587662b..cb896dbf53 100644 --- a/core/compiler/errors/errors-docs.factor +++ b/core/compiler/errors/errors-docs.factor @@ -1,6 +1,6 @@ IN: compiler.errors USING: help.markup help.syntax vocabs.loader words io -quotations compiler.errors.private ; +quotations ; ARTICLE: "compiler-errors" "Compiler warnings and errors" "The compiler saves various notifications in a global variable:" diff --git a/core/compiler/errors/errors.factor b/core/compiler/errors/errors.factor index 7a28c1fb99..c2452f719d 100644 --- a/core/compiler/errors/errors.factor +++ b/core/compiler/errors/errors.factor @@ -14,8 +14,6 @@ M: object compiler-error-type drop +error+ ; GENERIC# compiler-error. 1 ( error word -- ) - - : :errors ( -- ) +error+ compiler-errors. ; : :warnings ( -- ) +warning+ compiler-errors. ; 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/streams/string/string.factor b/core/io/streams/string/string.factor index 184b5e1c15..10d8f7d947 100644 --- a/core/io/streams/string/string.factor +++ b/core/io/streams/string/string.factor @@ -26,12 +26,12 @@ M: null-encoding decode-char drop stream-read1 ; : map-last ( seq quot -- seq ) >r dup length [ zero? ] r> compose 2map ; inline +PRIVATE> + : format-table ( table -- seq ) flip [ format-column ] map-last flip [ " " join ] map ; -PRIVATE> - M: growable dispose drop ; M: growable stream-write1 push ; 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/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor index ebaf8b3c8f..1325110122 100644 --- a/core/vocabs/loader/loader-docs.factor +++ b/core/vocabs/loader/loader-docs.factor @@ -11,7 +11,7 @@ ARTICLE: "vocabs.roots" "Vocabulary roots" { { $snippet "extra" } " - additional contributed libraries." } { { $snippet "work" } " - a root for vocabularies which are not intended to be contributed back to Factor." } } -"Your own vocabularies should go into " { $snippet "extra" } " or " { $snippet "work" } ", depending on whether or not you intend to contribute them back to the Factor project. If you wish to work on vocabularies outside of the Factor source directory, create a " { $snippet "~/.factor-rc" } " file like the following," +"Your own vocabularies should go into " { $snippet "extra" } " or " { $snippet "work" } ", depending on whether or not you intend to contribute them back to the Factor project. If you wish to work on vocabularies outside of the Factor source directory, create a " { $link "factor-boot-rc" } " file like the following:" { $code "USING: namespaces sequences vocabs.loader ;" "\"/home/jane/sources/\" vocab-roots get push" diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor index 5ba7f7ed88..3f06b9735c 100644 --- a/core/vocabs/loader/loader-tests.factor +++ b/core/vocabs/loader/loader-tests.factor @@ -1,9 +1,9 @@ -! Unit tests for vocabs.loader vocabulary IN: vocabs.loader.tests USING: vocabs.loader tools.test continuations vocabs math kernel arrays sequences namespaces io.streams.string parser source-files words assocs classes.tuple definitions -debugger compiler.units tools.vocabs accessors eval ; +debugger compiler.units tools.vocabs accessors eval +combinators ; ! This vocab should not exist, but just in case... [ ] [ @@ -151,3 +151,8 @@ forget-junk [ "xabbabbja" forget-vocab ] with-compilation-unit forget-junk + +[ ] [ [ "vocabs.loader.test.e" forget-vocab ] with-compilation-unit ] unit-test + +[ "vocabs.loader.test.e" require ] +[ relative-overflow? ] must-fail-with diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index f48a3d1950..690b8b0d92 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -55,7 +55,7 @@ SYMBOL: load-help? f over set-vocab-source-loaded? [ vocab-source-path [ parse-file ] [ [ ] ] if* ] keep t swap set-vocab-source-loaded? - [ % ] [ call ] if-bootstrapping ; + [ % ] [ assert-depth ] if-bootstrapping ; : load-docs ( vocab -- vocab ) load-help? get [ diff --git a/core/vocabs/loader/test/e/e.factor b/core/vocabs/loader/test/e/e.factor new file mode 100644 index 0000000000..b85905ec0b --- /dev/null +++ b/core/vocabs/loader/test/e/e.factor @@ -0,0 +1 @@ +1 2 3 diff --git a/core/vocabs/loader/test/e/tags.txt b/core/vocabs/loader/test/e/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/core/vocabs/loader/test/e/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/automata/automata.factor b/extra/automata/automata.factor index 979a733692..9001521490 100644 --- a/extra/automata/automata.factor +++ b/extra/automata/automata.factor @@ -13,19 +13,19 @@ VAR: rule VAR: rule-number : init-rule ( -- ) 8 >rule ; : rule-keys ( -- array ) -{ { 1 1 1 } - { 1 1 0 } - { 1 0 1 } - { 1 0 0 } - { 0 1 1 } - { 0 1 0 } - { 0 0 1 } - { 0 0 0 } } ; + { { 1 1 1 } + { 1 1 0 } + { 1 0 1 } + { 1 0 0 } + { 0 1 1 } + { 0 1 0 } + { 0 0 1 } + { 0 0 0 } } ; : rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-left string>digits ; : set-rule ( n -- ) -dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; + dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! step-capped-line @@ -37,7 +37,7 @@ dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; : cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ; : wrap-line ( a-line-z -- za-line-za ) -dup peek 1array swap dup first 1array append append ; + dup peek 1array swap dup first 1array append append ; : step-line ( line -- new-line ) 3 [ pattern>state ] map ; @@ -61,8 +61,8 @@ VARS: width height ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : interesting ( -- seq ) -{ 18 22 26 30 41 45 54 60 73 75 82 86 89 90 97 101 102 105 106 107 109 - 110 120 121 122 124 126 129 137 146 147 149 150 151 153 154 161 165 } ; + { 18 22 26 30 41 45 54 60 73 75 82 86 89 90 97 101 102 105 106 107 109 + 110 120 121 122 124 126 129 137 146 147 149 150 151 153 154 161 165 } ; : mild ( -- seq ) { 6 9 11 57 62 74 118 } ; @@ -75,7 +75,7 @@ VAR: bitmap VAR: last-line : run-rule ( -- ) -last-line> height> [ drop step-capped-line dup ] map >bitmap >last-line ; + last-line> height> [ drop step-capped-line dup ] map >bitmap >last-line ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/automata/ui/ui.factor b/extra/automata/ui/ui.factor index cfb0462877..9210097cab 100644 --- a/extra/automata/ui/ui.factor +++ b/extra/automata/ui/ui.factor @@ -39,10 +39,10 @@ VAR: slate ! Call a 'model' quotation with the current 'view'. : with-view ( quot -- ) -slate> rect-dim first >width -slate> rect-dim second >height -call -slate> relayout-1 ; + slate> rect-dim first >width + slate> rect-dim second >height + call + slate> relayout-1 ; ! Create a quotation that is appropriate for buttons and gesture handler. 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 8c045ee270..3d4cd392ca 100644 --- a/extra/boids/boids.factor +++ b/extra/boids/boids.factor @@ -43,19 +43,19 @@ VAR: separation-radius ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : init-variables ( -- ) -1.0 >cohesion-weight -1.0 >alignment-weight -1.0 >separation-weight + 1.0 >cohesion-weight + 1.0 >alignment-weight + 1.0 >separation-weight -75 >cohesion-radius -50 >alignment-radius -25 >separation-radius + 75 >cohesion-radius + 50 >alignment-radius + 25 >separation-radius -180 >cohesion-view-angle -180 >alignment-view-angle -180 >separation-view-angle + 180 >cohesion-view-angle + 180 >alignment-view-angle + 180 >separation-view-angle -10 >time-slice ; + 10 >time-slice ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! random-boid and random-boids @@ -76,14 +76,14 @@ VAR: separation-radius : constrain ( n a b -- n ) rot min max ; : angle-between ( vec vec -- angle ) -2dup v. -rot norm swap norm * / -1 1 constrain acos rad>deg ; + 2dup v. -rot norm swap norm * / -1 1 constrain acos rad>deg ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : 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/cfdg/models/game1-turn6/game1-turn6.factor b/extra/cfdg/models/game1-turn6/game1-turn6.factor index 5e512cd74a..66424acff7 100644 --- a/extra/cfdg/models/game1-turn6/game1-turn6.factor +++ b/extra/cfdg/models/game1-turn6/game1-turn6.factor @@ -1,6 +1,6 @@ USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate - mortar random-weighted cfdg ; + random-weighted cfdg ; IN: cfdg.models.game1-turn6 diff --git a/extra/cfdg/models/sierpinski/sierpinski.factor b/extra/cfdg/models/sierpinski/sierpinski.factor index 2333506f29..8257302a3e 100644 --- a/extra/cfdg/models/sierpinski/sierpinski.factor +++ b/extra/cfdg/models/sierpinski/sierpinski.factor @@ -1,6 +1,6 @@ USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate - mortar random-weighted cfdg ; + random-weighted cfdg ; IN: cfdg.models.sierpinski 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/game-input/backend/dinput/tags.txt b/extra/game-input/backend/dinput/tags.txt index 9098dfdba4..82506ff250 100755 --- a/extra/game-input/backend/dinput/tags.txt +++ b/extra/game-input/backend/dinput/tags.txt @@ -1,5 +1,2 @@ unportable -input -gamepads -joysticks -windows +games diff --git a/extra/game-input/backend/iokit/tags.txt b/extra/game-input/backend/iokit/tags.txt old mode 100644 new mode 100755 index 704b10bc4c..82506ff250 --- a/extra/game-input/backend/iokit/tags.txt +++ b/extra/game-input/backend/iokit/tags.txt @@ -1,5 +1,2 @@ unportable -gamepads -joysticks -mac -input +games diff --git a/extra/game-input/backend/tags.txt b/extra/game-input/backend/tags.txt old mode 100644 new mode 100755 index 48ad1f6141..84d4140a70 --- a/extra/game-input/backend/tags.txt +++ b/extra/game-input/backend/tags.txt @@ -1,3 +1 @@ -gamepads -joysticks -input +games diff --git a/extra/game-input/scancodes/tags.txt b/extra/game-input/scancodes/tags.txt old mode 100644 new mode 100755 index 6f4814c59c..84d4140a70 --- a/extra/game-input/scancodes/tags.txt +++ b/extra/game-input/scancodes/tags.txt @@ -1,2 +1 @@ -keyboard -input +games diff --git a/extra/game-input/tags.txt b/extra/game-input/tags.txt old mode 100644 new mode 100755 index ae360e1776..84d4140a70 --- a/extra/game-input/tags.txt +++ b/extra/game-input/tags.txt @@ -1,3 +1 @@ -joysticks -gamepads -input +games 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/macosx/macosx.factor b/extra/hardware-info/macosx/macosx.factor index fe1fd72a21..e3c604f2fd 100644 --- a/extra/hardware-info/macosx/macosx.factor +++ b/extra/hardware-info/macosx/macosx.factor @@ -12,11 +12,11 @@ FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, voi : make-int-array ( seq -- byte-array ) [ ] map concat ; -: (sysctl-query) ( name namelen oldp oldlenp -- oldp error/f ) - over >r f 0 sysctl io-error r> ; +: (sysctl-query) ( name namelen oldp oldlenp -- oldp ) + over [ f 0 sysctl io-error ] dip ; : sysctl-query ( seq n -- byte-array ) - >r [ make-int-array ] [ length ] bi r> + [ [ make-int-array ] [ length ] bi ] dip [ ] [ ] bi (sysctl-query) ; : sysctl-query-string ( seq -- n ) diff --git a/extra/hardware-info/windows/tags.txt b/extra/hardware-info/windows/tags.txt old mode 100644 new mode 100755 index 02ec70f741..6bf68304bb --- a/extra/hardware-info/windows/tags.txt +++ b/extra/hardware-info/windows/tags.txt @@ -1,2 +1 @@ unportable -windows 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/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 8d7a92b0d9..a18bb31874 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -60,13 +60,13 @@ TUPLE: link attributes clickable ; [ [ [ blank? ] trim ] change-text ] when ] map ; -: find-by-id ( vector id -- vector' ) +: find-by-id ( vector id -- vector' elt/f ) '[ attributes>> "id" at _ = ] find ; -: find-by-class ( vector id -- vector' ) +: find-by-class ( vector id -- vector' elt/f ) '[ attributes>> "class" at _ = ] find ; -: find-by-name ( vector string -- vector ) +: find-by-name ( vector string -- vector elt/f ) >lower '[ name>> _ = ] find ; : find-by-id-between ( vector string -- vector' ) @@ -83,7 +83,7 @@ TUPLE: link attributes clickable ; [ attributes>> "id" swap at _ = ] bi and ] dupd find find-between* ; -: find-by-attribute-key ( vector key -- vector' ) +: find-by-attribute-key ( vector key -- vector' elt/? ) >lower [ attributes>> at _ = ] filter sift ; diff --git a/extra/icfp/2006/tags.txt b/extra/icfp/2006/tags.txt old mode 100644 new mode 100755 index 7102ccb5bb..1e107f52e4 --- a/extra/icfp/2006/tags.txt +++ b/extra/icfp/2006/tags.txt @@ -1 +1 @@ -icfp +examples diff --git a/extra/iokit/hid/tags.txt b/extra/iokit/hid/tags.txt old mode 100644 new mode 100755 index c83070b657..bf2a35f15b --- a/extra/iokit/hid/tags.txt +++ b/extra/iokit/hid/tags.txt @@ -1,3 +1,2 @@ -mac bindings -system +unportable diff --git a/extra/iokit/tags.txt b/extra/iokit/tags.txt old mode 100644 new mode 100755 index c83070b657..bf2a35f15b --- a/extra/iokit/tags.txt +++ b/extra/iokit/tags.txt @@ -1,3 +1,2 @@ -mac bindings -system +unportable diff --git a/extra/joystick-demo/tags.txt b/extra/joystick-demo/tags.txt old mode 100644 new mode 100755 index 4d4417f0b8..84d4140a70 --- a/extra/joystick-demo/tags.txt +++ b/extra/joystick-demo/tags.txt @@ -1,2 +1 @@ -gamepads -joysticks +games diff --git a/extra/key-caps/tags.txt b/extra/key-caps/tags.txt old mode 100644 new mode 100755 index c253983475..cb5fc203e1 --- a/extra/key-caps/tags.txt +++ b/extra/key-caps/tags.txt @@ -1 +1 @@ -keyboard +demos diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index 8b8befce34..35070d8902 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: io.files io.launcher io.encodings.utf8 prettyprint arrays calendar namespaces mason.common mason.child -mason.release mason.report mason.email mason.cleanup ; +mason.release mason.report mason.email mason.cleanup +mason.help ; IN: mason.build : create-build-dir ( -- ) @@ -23,6 +24,7 @@ IN: mason.build clone-builds-factor record-id build-child + upload-help release email-report cleanup ; 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 02085a89b3..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 @@ -61,6 +73,7 @@ IN: mason.child [ load-everything-vocabs-file eval-file empty? ] [ test-all-vocabs-file eval-file empty? ] [ help-lint-vocabs-file eval-file empty? ] + [ compiler-errors-file eval-file empty? ] } 0&& ; : build-child ( -- ) diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index 24a1292be3..fc7149e181 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -75,6 +75,7 @@ SYMBOL: stamp : boot-time-file "boot-time" ; : load-time-file "load-time" ; +: compiler-errors-file "compiler-errors" ; : test-time-file "test-time" ; : help-lint-time-file "help-lint-time" ; : benchmark-time-file "benchmark-time" ; diff --git a/extra/mason/help/help.factor b/extra/mason/help/help.factor index 1e3e1509c9..c9ca50f0c2 100644 --- a/extra/mason/help/help.factor +++ b/extra/mason/help/help.factor @@ -16,8 +16,11 @@ IN: mason.help help-directory get "/docs.tar.gz" append upload-safely ; -: upload-help ( -- ) +: (upload-help) ( -- ) upload-help? get [ make-help-archive upload-help-archive ] when ; + +: upload-help ( -- ) + status get status-clean eq? [ (upload-help) ] when ; diff --git a/extra/mason/report/report.factor b/extra/mason/report/report.factor index 0b5f21540a..1b2697a5d1 100644 --- a/extra/mason/report/report.factor +++ b/extra/mason/report/report.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces debugger fry io io.files io.sockets io.encodings.utf8 prettyprint benchmark mason.common -mason.platform mason.config ; +mason.platform mason.config sequences ; IN: mason.report : time. ( file -- ) @@ -50,18 +50,25 @@ IN: mason.report nl - "Did not pass load-everything:" print - load-everything-vocabs-file cat - load-everything-errors-file cat + load-everything-vocabs-file eval-file [ + "== Did not pass load-everything:" print . + load-everything-errors-file cat + ] unless-empty - "Did not pass test-all:" print - test-all-vocabs-file cat - test-all-errors-file cat + compiler-errors-file eval-file [ + "== Vocabularies with compiler errors:" print . + ] unless-empty - "Did not pass help-lint:" print - help-lint-vocabs-file cat - help-lint-errors-file cat + test-all-vocabs-file eval-file [ + "== Did not pass test-all:" print . + test-all-errors-file cat + ] unless-empty - "Benchmarks:" print + help-lint-vocabs-file eval-file [ + "== Did not pass help-lint:" print . + help-lint-errors-file cat + ] unless-empty + + "== Benchmarks:" print benchmarks-file eval-file benchmarks. ] with-report ; \ No newline at end of file diff --git a/extra/mason/test/test.factor b/extra/mason/test/test.factor index cc83c9db44..0206df7db9 100644 --- a/extra/mason/test/test.factor +++ b/extra/mason/test/test.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces assocs io.files io.encodings.utf8 prettyprint help.lint benchmark tools.time bootstrap.stage2 -tools.test tools.vocabs help.html mason.common ; +tools.test tools.vocabs help.html mason.common words generic +accessors compiler.errors sequences sets sorting ; IN: mason.test : do-load ( -- ) @@ -11,6 +12,19 @@ IN: mason.test [ load-everything-errors-file utf8 [ load-failures. ] with-file-writer ] bi ; +GENERIC: word-vocabulary ( word -- vocabulary ) + +M: word word-vocabulary vocabulary>> ; + +M: method-body word-vocabulary "method-generic" word-prop word-vocabulary ; + +: do-compile-errors ( -- ) + compiler-errors-file utf8 [ + +error+ errors-of-type keys + [ word-vocabulary ] map + prune natural-sort . + ] with-file-writer ; + : do-tests ( -- ) run-all-tests [ keys test-all-vocabs-file to-file ] @@ -29,7 +43,7 @@ IN: mason.test : do-all ( -- ) ".." [ bootstrap-time get boot-time-file to-file - [ do-load ] benchmark load-time-file to-file + [ do-load do-compile-errors ] benchmark load-time-file to-file [ generate-help ] benchmark html-help-time-file to-file [ do-tests ] benchmark test-time-file to-file [ do-help-lint ] benchmark help-lint-time-file to-file diff --git a/extra/math/derivatives/derivatives-docs.factor b/extra/math/derivatives/derivatives-docs.factor index bbb793fe92..1630b2f9de 100644 --- a/extra/math/derivatives/derivatives-docs.factor +++ b/extra/math/derivatives/derivatives-docs.factor @@ -90,7 +90,6 @@ HELP: derivative-func " [ cos ]" " bi - abs" "] map minmax" - } } } ; @@ -100,4 +99,5 @@ ARTICLE: "derivatives" "The Derivative Toolkit" { $subsection derivative } { $subsection derivative-func } { $subsection (derivative) } ; + ABOUT: "derivatives" diff --git a/extra/math/polynomials/polynomials-docs.factor b/extra/math/polynomials/polynomials-docs.factor new file mode 100644 index 0000000000..edffa5377d --- /dev/null +++ b/extra/math/polynomials/polynomials-docs.factor @@ -0,0 +1,99 @@ +USING: help.markup help.syntax math sequences ; +IN: math.polynomials + +ARTICLE: "polynomials" "Polynomials" +"A polynomial is a vector with the highest powers on the right:" +{ $code "{ 1 1 0 1 } -> 1 + x + x^3" "{ } -> 0" } +"Numerous words are defined to help with polynomial arithmetic:" +{ $subsection p= } +{ $subsection p+ } +{ $subsection p- } +{ $subsection p* } +{ $subsection p-sq } +{ $subsection powers } +{ $subsection n*p } +{ $subsection p/mod } +{ $subsection pgcd } +{ $subsection polyval } +{ $subsection pdiff } +{ $subsection pextend-conv } +{ $subsection ptrim } +{ $subsection 2ptrim } ; + +ABOUT: "polynomials" + +HELP: powers +{ $values { "n" integer } { "x" number } { "seq" sequence } } +{ $description "Output a sequence having " { $snippet "n" } " elements in the format: " { $snippet "{ 1 x x^2 x^3 ... }" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "4 2 powers ." "{ 1 2 4 8 }" } } ; + +HELP: p= +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "?" "a boolean" } } +{ $description "Tests if two polynomials are equal." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 } { 0 1 0 } p= ." "t" } } ; + +HELP: ptrim +{ $values { "p" "a polynomial" } { "p" "a polynomial" } } +{ $description "Trims excess zeros from a polynomial." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } ptrim ." "{ 0 1 }" } } ; + +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: 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" } } +{ $description "Adds " { $snippet "p" } " and " { $snippet "q" } " component-wise." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } p+ ." "{ 1 1 1 }" } } ; + +HELP: p- +{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } } +{ $description "Subtracts " { $snippet "q" } " from " { $snippet "p" } " component-wise." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 } { 0 1 } p- ." "{ 1 0 1 }" } } ; + +HELP: n*p +{ $values { "n" number } { "p" "a polynomial" } { "n*p" "a polynomial" } } +{ $description "Multiplies each element of " { $snippet "p" } " by " { $snippet "n" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "4 { 3 0 1 } n*p ." "{ 12 0 4 }" } } ; + +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: 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" } } +{ $description "Multiplies two polynomials." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 2 3 0 0 0 } { 1 2 0 0 } p* ." "{ 1 4 7 6 0 0 0 0 0 }" } } ; + +HELP: p-sq +{ $values { "p" "a polynomial" } { "p^2" "a polynomial" } } +{ $description "Squares a polynomial." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 2 0 } p-sq ." "{ 1 4 4 0 0 }" } } ; + +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: 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: 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" } } +{ $description "Finds the derivative of " { $snippet "p" } "." } ; + +HELP: polyval +{ $values { "p" "a polynomial" } { "x" number } { "p[x]" number } } +{ $description "Evaluate " { $snippet "p" } " with the input " { $snippet "x" } "." } +{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } 2 polyval ." "5" } } ; + diff --git a/extra/math/polynomials/polynomials-tests.factor b/extra/math/polynomials/polynomials-tests.factor index cccf24fbff..cd88d19d13 100644 --- a/extra/math/polynomials/polynomials-tests.factor +++ b/extra/math/polynomials/polynomials-tests.factor @@ -1,7 +1,6 @@ -IN: math.polynomials.tests USING: kernel math math.polynomials tools.test ; +IN: math.polynomials.tests -! Tests [ { 0 1 } ] [ { 0 1 0 0 } ptrim ] unit-test [ { 1 } ] [ { 1 0 0 } ptrim ] unit-test [ { 0 } ] [ { 0 } ptrim ] unit-test diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 47226114d0..13090b6486 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -4,46 +4,38 @@ USING: arrays kernel make math math.order math.vectors sequences shuffle splitting vectors ; IN: math.polynomials -! Polynomials are vectors with the highest powers on the right: -! { 1 1 0 1 } -> 1 + x + x^3 -! { } -> 0 - -: powers ( n x -- seq ) - #! Output sequence has n elements, { 1 x x^2 x^3 ... } - 1 [ * ] accumulate nip ; - -: p= ( p p -- ? ) pextend = ; +: powers ( n x -- seq ) + 1 [ * ] accumulate nip ; + +: p= ( p q -- ? ) pextend = ; : ptrim ( p -- p ) dup length 1 = [ [ zero? ] trim-right ] unless ; -: 2ptrim ( p p -- p p ) [ ptrim ] bi@ ; -: p+ ( p p -- p ) pextend v+ ; -: p- ( p p -- p ) pextend v- ; +: 2ptrim ( p q -- p q ) [ ptrim ] bi@ ; +: p+ ( p q -- r ) pextend v+ ; +: p- ( p q -- r ) pextend v- ; : n*p ( n p -- n*p ) n*v ; -! convolution -: pextend-conv ( p p -- p p ) - #! extend to: p_m + p_n - 1 +: pextend-conv ( p q -- p q ) 2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ; -: p* ( p p -- p ) - #! Multiply two polynomials. +: p* ( p q -- r ) 2unempty pextend-conv dup length [ over length pick pick [ * ] 2map sum ] map 2nip reverse ; -: p-sq ( p -- p-sq ) +: p-sq ( p -- p^2 ) dup p* ; PRIVATE> -: p/mod ( a b -- / mod ) +: p/mod ( p q -- z w ) p/mod-setup [ [ (p/mod) ] times ] V{ } make reverse nip swap 2ptrim pextend ; + tuck p/mod [ pick p* swap [ swapd p- ] dip ] dip (pgcd) ] if ; -: pgcd ( p p -- p q ) +PRIVATE> + +: pgcd ( p q -- a d ) swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] bi@ ; : pdiff ( p -- p' ) - #! Polynomial derivative. dup length v* { 0 } ?head drop ; : polyval ( p x -- p[x] ) - #! Evaluate a polynomial. [ dup length ] dip powers v. ; diff --git a/extra/math/quaternions/quaternions-docs.factor b/extra/math/quaternions/quaternions-docs.factor new file mode 100644 index 0000000000..bb34ec8da2 --- /dev/null +++ b/extra/math/quaternions/quaternions-docs.factor @@ -0,0 +1,46 @@ +USING: help.markup help.syntax math math.vectors vectors ; +IN: math.quaternions + +HELP: q* +{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u*v" "a quaternion" } } +{ $description "Multiply quaternions." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } { 0 1 } q* ." "{ 0 C{ 0 1 } }" } } ; + +HELP: qconjugate +{ $values { "u" "a quaternion" } { "u'" "a quaternion" } } +{ $description "Quaternion conjugate." } ; + +HELP: qrecip +{ $values { "u" "a quaternion" } { "1/u" "a quaternion" } } +{ $description "Quaternion inverse." } ; + +HELP: q/ +{ $values { "u" "a quaternion" } { "v" "a quaternion" } { "u/v" "a quaternion" } } +{ $description "Divide quaternions." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 0 C{ 0 1 } } { 0 1 } q/ ." "{ C{ 0 1 } 0 }" } } ; + +HELP: q*n +{ $values { "q" "a quaternion" } { "n" number } { "q" "a quaternion" } } +{ $description "Multiplies each element of " { $snippet "q" } " by " { $snippet "n" } "." } +{ $notes "You will get the wrong result if you try to multiply a quaternion by a complex number on the right using " { $link v*n } ". Use this word instead." + $nl "Note that " { $link v*n } " with a quaternion and a real is okay." } ; + +HELP: c>q +{ $values { "c" number } { "q" "a quaternion" } } +{ $description "Turn a complex number into a quaternion." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "C{ 0 1 } c>q ." "{ C{ 0 1 } 0 }" } } ; + +HELP: v>q +{ $values { "v" vector } { "q" "a quaternion" } } +{ $description "Turn a 3-vector into a quaternion with real part 0." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ 1 0 0 } v>q ." "{ C{ 0 1 } 0 }" } } ; + +HELP: q>v +{ $values { "q" "a quaternion" } { "v" vector } } +{ $description "Get the vector part of a quaternion, discarding the real part." } +{ $examples { $example "USING: math.quaternions prettyprint ;" "{ C{ 0 1 } 0 } q>v ." "{ 1 0 0 }" } } ; + +HELP: euler +{ $values { "phi" number } { "theta" number } { "psi" number } { "q" "a quaternion" } } +{ $description "Convert a rotation given by Euler angles (phi, theta, and psi) to a quaternion." } ; + diff --git a/extra/math/quaternions/quaternions.factor b/extra/math/quaternions/quaternions.factor index ffc0fcc9f7..bb0d025dc6 100755 --- a/extra/math/quaternions/quaternions.factor +++ b/extra/math/quaternions/quaternions.factor @@ -1,15 +1,13 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. - -! Everybody's favorite non-commutative skew field, the -! quaternions! - -! Quaternions are represented as pairs of complex numbers, -! using the identity: (a+bi)+(c+di)j = a+bi+cj+dk. -USING: arrays kernel math math.vectors math.functions -arrays sequences ; +USING: arrays kernel math math.functions math.vectors sequences ; IN: math.quaternions +! Everybody's favorite non-commutative skew field, the quaternions! + +! Quaternions are represented as pairs of complex numbers, using the +! identity: (a+bi)+(c+di)j = a+bi+cj+dk. + : q* ( u v -- u*v ) - #! Multiply quaternions. [ q*a ] [ q*b ] 2bi 2array ; : qconjugate ( u -- u' ) - #! Quaternion conjugate. first2 [ conjugate ] [ neg ] bi* 2array ; : qrecip ( u -- 1/u ) - #! Quaternion inverse. qconjugate dup norm-sq v/n ; : q/ ( u v -- u/v ) - #! Divide quaternions. qrecip q* ; : q*n ( q n -- q ) - #! Note: you will get the wrong result if you try to - #! multiply a quaternion by a complex number on the right - #! using v*n. Use this word instead. Note that v*n with a - #! quaternion and a real is okay. conjugate v*n ; : c>q ( c -- q ) - #! Turn a complex number into a quaternion. 0 2array ; : v>q ( v -- q ) - #! Turn a 3-vector into a quaternion with real part 0. first3 rect> [ 0 swap rect> ] dip 2array ; : q>v ( q -- v ) - #! Get the vector part of a quaternion, discarding the real - #! part. first2 [ imaginary-part ] dip >rect 3array ; ! Zero @@ -67,11 +53,14 @@ PRIVATE> : qj { 0 1 } ; : qk { 0 C{ 0 1 } } ; -! Euler angles -- see -! http://www.mathworks.com/access/helpdesk/help/toolbox/aeroblks/euleranglestoquaternions.html +! Euler angles + +q swap sin ] dip n*v v- ; + [ -0.5 * [ cos c>q ] [ sin ] bi ] dip n*v v- ; + +PRIVATE> : euler ( phi theta psi -- q ) [ qi (euler) ] [ qj (euler) ] [ qk (euler) ] tri* q* q* ; diff --git a/extra/math/statistics/statistics.factor b/extra/math/statistics/statistics.factor index 267a95c100..7568af5294 100644 --- a/extra/math/statistics/statistics.factor +++ b/extra/math/statistics/statistics.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman, Michael Judge. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays kernel math math.analysis math.functions sequences sequences.lib - sorting ; +USING: arrays combinators kernel math math.analysis math.functions sequences + sequences.lib sorting ; IN: math.statistics : mean ( seq -- n ) @@ -63,7 +63,7 @@ IN: math.statistics r sq ; : least-squares ( {{x,y}...} -- alpha beta ) - [r] >r >r >r >r 2dup r> r> r> r> + [r] { [ 2dup ] [ ] [ ] [ ] [ ] } spread ! stack is mean(x) mean(y) mean(x) mean(y) {x} {y} sx sy [ (r) ] 2keep ! stack is mean(x) mean(y) r sx sy swap / * ! stack is mean(x) mean(y) beta diff --git a/extra/opengl/shaders/tags.txt b/extra/opengl/shaders/tags.txt old mode 100644 new mode 100755 index ce0345edc9..21154b6383 --- a/extra/opengl/shaders/tags.txt +++ b/extra/opengl/shaders/tags.txt @@ -1,3 +1,2 @@ opengl -glsl bindings \ No newline at end of file diff --git a/extra/peg/javascript/ast/tags.txt b/extra/peg/javascript/ast/tags.txt old mode 100644 new mode 100755 index c2aac2932f..a38bf33c3c --- a/extra/peg/javascript/ast/tags.txt +++ b/extra/peg/javascript/ast/tags.txt @@ -1,3 +1,4 @@ text javascript parsing +languages diff --git a/extra/peg/javascript/parser/tags.txt b/extra/peg/javascript/parser/tags.txt old mode 100644 new mode 100755 index c2aac2932f..a38bf33c3c --- a/extra/peg/javascript/parser/tags.txt +++ b/extra/peg/javascript/parser/tags.txt @@ -1,3 +1,4 @@ text javascript parsing +languages diff --git a/extra/peg/javascript/tags.txt b/extra/peg/javascript/tags.txt old mode 100644 new mode 100755 index c2aac2932f..a38bf33c3c --- a/extra/peg/javascript/tags.txt +++ b/extra/peg/javascript/tags.txt @@ -1,3 +1,4 @@ text javascript parsing +languages diff --git a/extra/peg/javascript/tokenizer/tags.txt b/extra/peg/javascript/tokenizer/tags.txt old mode 100644 new mode 100755 index c2aac2932f..a38bf33c3c --- a/extra/peg/javascript/tokenizer/tags.txt +++ b/extra/peg/javascript/tokenizer/tags.txt @@ -1,3 +1,4 @@ text javascript parsing +languages diff --git a/extra/project-euler/047/047.factor b/extra/project-euler/047/047.factor index 30c01d8f61..9caaa8776f 100644 --- a/extra/project-euler/047/047.factor +++ b/extra/project-euler/047/047.factor @@ -32,7 +32,7 @@ IN: project-euler.047 number ] map ] map ; + +: simplify ( seq -- seq ) + #! exponent * log(base) + flip first2 swap [ log ] map v* ; + +: solve ( seq -- index ) + simplify [ supremum ] keep index 1+ ; + +PRIVATE> + +: euler099 ( -- answer ) + source-099 solve ; + +! [ euler099 ] 100 ave-time +! 16 ms ave run timen - 1.67 SD (100 trials) + +MAIN: euler099 diff --git a/extra/project-euler/099/base_exp.txt b/extra/project-euler/099/base_exp.txt new file mode 100644 index 0000000000..92201db6f5 --- /dev/null +++ b/extra/project-euler/099/base_exp.txt @@ -0,0 +1,1000 @@ +519432,525806 +632382,518061 +78864,613712 +466580,530130 +780495,510032 +525895,525320 +15991,714883 +960290,502358 +760018,511029 +166800,575487 +210884,564478 +555151,523163 +681146,515199 +563395,522587 +738250,512126 +923525,503780 +595148,520429 +177108,572629 +750923,511482 +440902,532446 +881418,505504 +422489,534197 +979858,501616 +685893,514935 +747477,511661 +167214,575367 +234140,559696 +940238,503122 +728969,512609 +232083,560102 +900971,504694 +688801,514772 +189664,569402 +891022,505104 +445689,531996 +119570,591871 +821453,508118 +371084,539600 +911745,504251 +623655,518600 +144361,582486 +352442,541775 +420726,534367 +295298,549387 +6530,787777 +468397,529976 +672336,515696 +431861,533289 +84228,610150 +805376,508857 +444409,532117 +33833,663511 +381850,538396 +402931,536157 +92901,604930 +304825,548004 +731917,512452 +753734,511344 +51894,637373 +151578,580103 +295075,549421 +303590,548183 +333594,544123 +683952,515042 +60090,628880 +951420,502692 +28335,674991 +714940,513349 +343858,542826 +549279,523586 +804571,508887 +260653,554881 +291399,549966 +402342,536213 +408889,535550 +40328,652524 +375856,539061 +768907,510590 +165993,575715 +976327,501755 +898500,504795 +360404,540830 +478714,529095 +694144,514472 +488726,528258 +841380,507226 +328012,544839 +22389,690868 +604053,519852 +329514,544641 +772965,510390 +492798,527927 +30125,670983 +895603,504906 +450785,531539 +840237,507276 +380711,538522 +63577,625673 +76801,615157 +502694,527123 +597706,520257 +310484,547206 +944468,502959 +121283,591152 +451131,531507 +566499,522367 +425373,533918 +40240,652665 +39130,654392 +714926,513355 +469219,529903 +806929,508783 +287970,550487 +92189,605332 +103841,599094 +671839,515725 +452048,531421 +987837,501323 +935192,503321 +88585,607450 +613883,519216 +144551,582413 +647359,517155 +213902,563816 +184120,570789 +258126,555322 +502546,527130 +407655,535678 +401528,536306 +477490,529193 +841085,507237 +732831,512408 +833000,507595 +904694,504542 +581435,521348 +455545,531110 +873558,505829 +94916,603796 +720176,513068 +545034,523891 +246348,557409 +556452,523079 +832015,507634 +173663,573564 +502634,527125 +250732,556611 +569786,522139 +216919,563178 +521815,525623 +92304,605270 +164446,576167 +753413,511364 +11410,740712 +448845,531712 +925072,503725 +564888,522477 +7062,780812 +641155,517535 +738878,512100 +636204,517828 +372540,539436 +443162,532237 +571192,522042 +655350,516680 +299741,548735 +581914,521307 +965471,502156 +513441,526277 +808682,508700 +237589,559034 +543300,524025 +804712,508889 +247511,557192 +543486,524008 +504383,526992 +326529,545039 +792493,509458 +86033,609017 +126554,589005 +579379,521481 +948026,502823 +404777,535969 +265767,554022 +266876,553840 +46631,643714 +492397,527958 +856106,506581 +795757,509305 +748946,511584 +294694,549480 +409781,535463 +775887,510253 +543747,523991 +210592,564536 +517119,525990 +520253,525751 +247926,557124 +592141,520626 +346580,542492 +544969,523902 +506501,526817 +244520,557738 +144745,582349 +69274,620858 +292620,549784 +926027,503687 +736320,512225 +515528,526113 +407549,535688 +848089,506927 +24141,685711 +9224,757964 +980684,501586 +175259,573121 +489160,528216 +878970,505604 +969546,502002 +525207,525365 +690461,514675 +156510,578551 +659778,516426 +468739,529945 +765252,510770 +76703,615230 +165151,575959 +29779,671736 +928865,503569 +577538,521605 +927555,503618 +185377,570477 +974756,501809 +800130,509093 +217016,563153 +365709,540216 +774508,510320 +588716,520851 +631673,518104 +954076,502590 +777828,510161 +990659,501222 +597799,520254 +786905,509727 +512547,526348 +756449,511212 +869787,505988 +653747,516779 +84623,609900 +839698,507295 +30159,670909 +797275,509234 +678136,515373 +897144,504851 +989554,501263 +413292,535106 +55297,633667 +788650,509637 +486748,528417 +150724,580377 +56434,632490 +77207,614869 +588631,520859 +611619,519367 +100006,601055 +528924,525093 +190225,569257 +851155,506789 +682593,515114 +613043,519275 +514673,526183 +877634,505655 +878905,505602 +1926,914951 +613245,519259 +152481,579816 +841774,507203 +71060,619442 +865335,506175 +90244,606469 +302156,548388 +399059,536557 +478465,529113 +558601,522925 +69132,620966 +267663,553700 +988276,501310 +378354,538787 +529909,525014 +161733,576968 +758541,511109 +823425,508024 +149821,580667 +269258,553438 +481152,528891 +120871,591322 +972322,501901 +981350,501567 +676129,515483 +950860,502717 +119000,592114 +392252,537272 +191618,568919 +946699,502874 +289555,550247 +799322,509139 +703886,513942 +194812,568143 +261823,554685 +203052,566221 +217330,563093 +734748,512313 +391759,537328 +807052,508777 +564467,522510 +59186,629748 +113447,594545 +518063,525916 +905944,504492 +613922,519213 +439093,532607 +445946,531981 +230530,560399 +297887,549007 +459029,530797 +403692,536075 +855118,506616 +963127,502245 +841711,507208 +407411,535699 +924729,503735 +914823,504132 +333725,544101 +176345,572832 +912507,504225 +411273,535308 +259774,555036 +632853,518038 +119723,591801 +163902,576321 +22691,689944 +402427,536212 +175769,572988 +837260,507402 +603432,519893 +313679,546767 +538165,524394 +549026,523608 +61083,627945 +898345,504798 +992556,501153 +369999,539727 +32847,665404 +891292,505088 +152715,579732 +824104,507997 +234057,559711 +730507,512532 +960529,502340 +388395,537687 +958170,502437 +57105,631806 +186025,570311 +993043,501133 +576770,521664 +215319,563513 +927342,503628 +521353,525666 +39563,653705 +752516,511408 +110755,595770 +309749,547305 +374379,539224 +919184,503952 +990652,501226 +647780,517135 +187177,570017 +168938,574877 +649558,517023 +278126,552016 +162039,576868 +658512,516499 +498115,527486 +896583,504868 +561170,522740 +747772,511647 +775093,510294 +652081,516882 +724905,512824 +499707,527365 +47388,642755 +646668,517204 +571700,522007 +180430,571747 +710015,513617 +435522,532941 +98137,602041 +759176,511070 +486124,528467 +526942,525236 +878921,505604 +408313,535602 +926980,503640 +882353,505459 +566887,522345 +3326,853312 +911981,504248 +416309,534800 +392991,537199 +622829,518651 +148647,581055 +496483,527624 +666314,516044 +48562,641293 +672618,515684 +443676,532187 +274065,552661 +265386,554079 +347668,542358 +31816,667448 +181575,571446 +961289,502320 +365689,540214 +987950,501317 +932299,503440 +27388,677243 +746701,511701 +492258,527969 +147823,581323 +57918,630985 +838849,507333 +678038,515375 +27852,676130 +850241,506828 +818403,508253 +131717,587014 +850216,506834 +904848,504529 +189758,569380 +392845,537217 +470876,529761 +925353,503711 +285431,550877 +454098,531234 +823910,508003 +318493,546112 +766067,510730 +261277,554775 +421530,534289 +694130,514478 +120439,591498 +213308,563949 +854063,506662 +365255,540263 +165437,575872 +662240,516281 +289970,550181 +847977,506933 +546083,523816 +413252,535113 +975829,501767 +361540,540701 +235522,559435 +224643,561577 +736350,512229 +328303,544808 +35022,661330 +307838,547578 +474366,529458 +873755,505819 +73978,617220 +827387,507845 +670830,515791 +326511,545034 +309909,547285 +400970,536363 +884827,505352 +718307,513175 +28462,674699 +599384,520150 +253565,556111 +284009,551093 +343403,542876 +446557,531921 +992372,501160 +961601,502308 +696629,514342 +919537,503945 +894709,504944 +892201,505051 +358160,541097 +448503,531745 +832156,507636 +920045,503924 +926137,503675 +416754,534757 +254422,555966 +92498,605151 +826833,507873 +660716,516371 +689335,514746 +160045,577467 +814642,508425 +969939,501993 +242856,558047 +76302,615517 +472083,529653 +587101,520964 +99066,601543 +498005,527503 +709800,513624 +708000,513716 +20171,698134 +285020,550936 +266564,553891 +981563,501557 +846502,506991 +334,1190800 +209268,564829 +9844,752610 +996519,501007 +410059,535426 +432931,533188 +848012,506929 +966803,502110 +983434,501486 +160700,577267 +504374,526989 +832061,507640 +392825,537214 +443842,532165 +440352,532492 +745125,511776 +13718,726392 +661753,516312 +70500,619875 +436952,532814 +424724,533973 +21954,692224 +262490,554567 +716622,513264 +907584,504425 +60086,628882 +837123,507412 +971345,501940 +947162,502855 +139920,584021 +68330,621624 +666452,516038 +731446,512481 +953350,502619 +183157,571042 +845400,507045 +651548,516910 +20399,697344 +861779,506331 +629771,518229 +801706,509026 +189207,569512 +737501,512168 +719272,513115 +479285,529045 +136046,585401 +896746,504860 +891735,505067 +684771,514999 +865309,506184 +379066,538702 +503117,527090 +621780,518717 +209518,564775 +677135,515423 +987500,501340 +197049,567613 +329315,544673 +236756,559196 +357092,541226 +520440,525733 +213471,563911 +956852,502490 +702223,514032 +404943,535955 +178880,572152 +689477,514734 +691351,514630 +866669,506128 +370561,539656 +739805,512051 +71060,619441 +624861,518534 +261660,554714 +366137,540160 +166054,575698 +601878,519990 +153445,579501 +279899,551729 +379166,538691 +423209,534125 +675310,515526 +145641,582050 +691353,514627 +917468,504026 +284778,550976 +81040,612235 +161699,576978 +616394,519057 +767490,510661 +156896,578431 +427408,533714 +254849,555884 +737217,512182 +897133,504851 +203815,566051 +270822,553189 +135854,585475 +778805,510111 +784373,509847 +305426,547921 +733418,512375 +732087,512448 +540668,524215 +702898,513996 +628057,518328 +640280,517587 +422405,534204 +10604,746569 +746038,511733 +839808,507293 +457417,530938 +479030,529064 +341758,543090 +620223,518824 +251661,556451 +561790,522696 +497733,527521 +724201,512863 +489217,528217 +415623,534867 +624610,518548 +847541,506953 +432295,533249 +400391,536421 +961158,502319 +139173,584284 +421225,534315 +579083,521501 +74274,617000 +701142,514087 +374465,539219 +217814,562985 +358972,540995 +88629,607424 +288597,550389 +285819,550812 +538400,524385 +809930,508645 +738326,512126 +955461,502535 +163829,576343 +826475,507891 +376488,538987 +102234,599905 +114650,594002 +52815,636341 +434037,533082 +804744,508880 +98385,601905 +856620,506559 +220057,562517 +844734,507078 +150677,580387 +558697,522917 +621751,518719 +207067,565321 +135297,585677 +932968,503404 +604456,519822 +579728,521462 +244138,557813 +706487,513800 +711627,513523 +853833,506674 +497220,527562 +59428,629511 +564845,522486 +623621,518603 +242689,558077 +125091,589591 +363819,540432 +686453,514901 +656813,516594 +489901,528155 +386380,537905 +542819,524052 +243987,557841 +693412,514514 +488484,528271 +896331,504881 +336730,543721 +728298,512647 +604215,519840 +153729,579413 +595687,520398 +540360,524240 +245779,557511 +924873,503730 +509628,526577 +528523,525122 +3509,847707 +522756,525555 +895447,504922 +44840,646067 +45860,644715 +463487,530404 +398164,536654 +894483,504959 +619415,518874 +966306,502129 +990922,501212 +835756,507474 +548881,523618 +453578,531282 +474993,529410 +80085,612879 +737091,512193 +50789,638638 +979768,501620 +792018,509483 +665001,516122 +86552,608694 +462772,530469 +589233,520821 +891694,505072 +592605,520594 +209645,564741 +42531,649269 +554376,523226 +803814,508929 +334157,544042 +175836,572970 +868379,506051 +658166,516520 +278203,551995 +966198,502126 +627162,518387 +296774,549165 +311803,547027 +843797,507118 +702304,514032 +563875,522553 +33103,664910 +191932,568841 +543514,524006 +506835,526794 +868368,506052 +847025,506971 +678623,515342 +876139,505726 +571997,521984 +598632,520198 +213590,563892 +625404,518497 +726508,512738 +689426,514738 +332495,544264 +411366,535302 +242546,558110 +315209,546555 +797544,509219 +93889,604371 +858879,506454 +124906,589666 +449072,531693 +235960,559345 +642403,517454 +720567,513047 +705534,513858 +603692,519870 +488137,528302 +157370,578285 +63515,625730 +666326,516041 +619226,518883 +443613,532186 +597717,520257 +96225,603069 +86940,608450 +40725,651929 +460976,530625 +268875,553508 +270671,553214 +363254,540500 +384248,538137 +762889,510892 +377941,538833 +278878,551890 +176615,572755 +860008,506412 +944392,502967 +608395,519571 +225283,561450 +45095,645728 +333798,544090 +625733,518476 +995584,501037 +506135,526853 +238050,558952 +557943,522972 +530978,524938 +634244,517949 +177168,572616 +85200,609541 +953043,502630 +523661,525484 +999295,500902 +840803,507246 +961490,502312 +471747,529685 +380705,538523 +911180,504275 +334149,544046 +478992,529065 +325789,545133 +335884,543826 +426976,533760 +749007,511582 +667067,516000 +607586,519623 +674054,515599 +188534,569675 +565185,522464 +172090,573988 +87592,608052 +907432,504424 +8912,760841 +928318,503590 +757917,511138 +718693,513153 +315141,546566 +728326,512645 +353492,541647 +638429,517695 +628892,518280 +877286,505672 +620895,518778 +385878,537959 +423311,534113 +633501,517997 +884833,505360 +883402,505416 +999665,500894 +708395,513697 +548142,523667 +756491,511205 +987352,501340 +766520,510705 +591775,520647 +833758,507563 +843890,507108 +925551,503698 +74816,616598 +646942,517187 +354923,541481 +256291,555638 +634470,517942 +930904,503494 +134221,586071 +282663,551304 +986070,501394 +123636,590176 +123678,590164 +481717,528841 +423076,534137 +866246,506145 +93313,604697 +783632,509880 +317066,546304 +502977,527103 +141272,583545 +71708,618938 +617748,518975 +581190,521362 +193824,568382 +682368,515131 +352956,541712 +351375,541905 +505362,526909 +905165,504518 +128645,588188 +267143,553787 +158409,577965 +482776,528754 +628896,518282 +485233,528547 +563606,522574 +111001,595655 +115920,593445 +365510,540237 +959724,502374 +938763,503184 +930044,503520 +970959,501956 +913658,504176 +68117,621790 +989729,501253 +567697,522288 +820427,508163 +54236,634794 +291557,549938 +124961,589646 +403177,536130 +405421,535899 +410233,535417 +815111,508403 +213176,563974 +83099,610879 +998588,500934 +513640,526263 +129817,587733 +1820,921851 +287584,550539 +299160,548820 +860621,506386 +529258,525059 +586297,521017 +953406,502616 +441234,532410 +986217,501386 +781938,509957 +461247,530595 +735424,512277 +146623,581722 +839838,507288 +510667,526494 +935085,503327 +737523,512167 +303455,548204 +992779,501145 +60240,628739 +939095,503174 +794368,509370 +501825,527189 +459028,530798 +884641,505363 +512287,526364 +835165,507499 +307723,547590 +160587,577304 +735043,512300 +493289,527887 +110717,595785 +306480,547772 +318593,546089 +179810,571911 +200531,566799 +314999,546580 +197020,567622 +301465,548487 +237808,559000 +131944,586923 +882527,505449 +468117,530003 +711319,513541 +156240,578628 +965452,502162 +992756,501148 +437959,532715 +739938,512046 +614249,519196 +391496,537356 +62746,626418 +688215,514806 +75501,616091 +883573,505412 +558824,522910 +759371,511061 +173913,573489 +891351,505089 +727464,512693 +164833,576051 +812317,508529 +540320,524243 +698061,514257 +69149,620952 +471673,529694 +159092,577753 +428134,533653 +89997,606608 +711061,513557 +779403,510081 +203327,566155 +798176,509187 +667688,515963 +636120,517833 +137410,584913 +217615,563034 +556887,523038 +667229,515991 +672276,515708 +325361,545187 +172115,573985 +13846,725685 \ No newline at end of file diff --git a/extra/project-euler/203/203-tests.factor b/extra/project-euler/203/203-tests.factor index 6c49c2f958..4922f9a8cc 100644 --- a/extra/project-euler/203/203-tests.factor +++ b/extra/project-euler/203/203-tests.factor @@ -1,5 +1,5 @@ -USING: project-euler.203 tools.test ; +USING: project-euler.203 project-euler.203.private tools.test ; IN: project-euler.203.tests [ 105 ] [ 8 solve ] unit-test -[ 34029210557338 ] [ 51 solve ] unit-test +[ 34029210557338 ] [ euler203 ] unit-test diff --git a/extra/project-euler/203/203.factor b/extra/project-euler/203/203.factor index 9a2916649e..f2b5a2e212 100644 --- a/extra/project-euler/203/203.factor +++ b/extra/project-euler/203/203.factor @@ -1,9 +1,64 @@ +! Copyright (c) 2008 Eric Mertens. +! See http://factorcode.org/license.txt for BSD license. USING: fry kernel math math.primes.factors sequences sets ; IN: project-euler.203 -: iterate ( n initial quot -- results ) swapd '[ @ dup ] replicate nip ; inline -: (generate) ( seq -- seq ) [ 0 prefix ] [ 0 suffix ] bi [ + ] 2map ; -: generate ( n -- seq ) 1- { 1 } [ (generate) ] iterate concat prune ; -: squarefree ( n -- ? ) factors duplicates empty? ; -: solve ( n -- n ) generate [ squarefree ] filter sum ; -: euler203 ( -- n ) 51 solve ; +! http://projecteuler.net/index.php?section=problems&id=203 + +! DESCRIPTION +! ----------- + +! The binomial coefficients nCk can be arranged in triangular form, Pascal's +! triangle, like this: + +! 1 +! 1 1 +! 1 2 1 +! 1 3 3 1 +! 1 4 6 4 1 +! 1 5 10 10 5 1 +! 1 6 15 20 15 6 1 +! 1 7 21 35 35 21 7 1 +! ......... + +! It can be seen that the first eight rows of Pascal's triangle contain twelve +! distinct numbers: 1, 2, 3, 4, 5, 6, 7, 10, 15, 20, 21 and 35. + +! A positive integer n is called squarefree if no square of a prime divides n. +! Of the twelve distinct numbers in the first eight rows of Pascal's triangle, +! all except 4 and 20 are squarefree. The sum of the distinct squarefree numbers +! in the first eight rows is 105. + +! Find the sum of the distinct squarefree numbers in the first 51 rows of +! Pascal's triangle. + + +! SOLUTION +! -------- + + + +: euler203 ( -- n ) + 51 solve ; + +! [ euler203 ] 100 ave-time +! 12 ms ave run time - 1.6 SD (100 trials) + +MAIN: euler203 diff --git a/extra/project-euler/215/215.factor b/extra/project-euler/215/215.factor index fc09b37515..82d6a31c66 100644 --- a/extra/project-euler/215/215.factor +++ b/extra/project-euler/215/215.factor @@ -9,7 +9,7 @@ IN: project-euler.215 ! ----------- ! Consider the problem of building a wall out of 2x1 and 3x1 bricks -! (horizontalvertical dimensions) such that, for extra strength, the gaps +! (horizontal x vertical dimensions) such that, for extra strength, the gaps ! between horizontally-adjacent bricks never line up in consecutive layers, ! i.e. never form a "running crack". diff --git a/extra/project-euler/project-euler.factor b/extra/project-euler/project-euler.factor index 9549505bf6..027e8fe50f 100644 --- a/extra/project-euler/project-euler.factor +++ b/extra/project-euler/project-euler.factor @@ -17,10 +17,11 @@ USING: definitions io io.files kernel math math.parser project-euler.052 project-euler.053 project-euler.055 project-euler.056 project-euler.059 project-euler.067 project-euler.071 project-euler.073 project-euler.075 project-euler.076 project-euler.079 project-euler.092 - project-euler.097 project-euler.100 project-euler.116 project-euler.117 - project-euler.134 project-euler.148 project-euler.150 project-euler.151 - project-euler.164 project-euler.169 project-euler.173 project-euler.175 - project-euler.186 project-euler.190 project-euler.215 ; + project-euler.097 project-euler.099 project-euler.100 project-euler.116 + project-euler.117 project-euler.134 project-euler.148 project-euler.150 + project-euler.151 project-euler.164 project-euler.169 project-euler.173 + project-euler.175 project-euler.186 project-euler.190 project-euler.203 + project-euler.215 ; IN: project-euler - 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/spheres/tags.txt b/extra/spheres/tags.txt old mode 100644 new mode 100755 index b9a82374be..36ee50526a --- a/extra/spheres/tags.txt +++ b/extra/spheres/tags.txt @@ -1,3 +1,2 @@ opengl -glsl demos diff --git a/extra/springies/ui/ui.factor b/extra/springies/ui/ui.factor index 07865f38e0..21e97a1827 100644 --- a/extra/springies/ui/ui.factor +++ b/extra/springies/ui/ui.factor @@ -7,7 +7,7 @@ IN: springies.ui ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: draw-node ( node -- ) pos>> { -5 -5 } v+ dup { 10 10 } v+ gl-rect ; +: draw-node ( node -- ) pos>> { -5 -5 } v+ [ { 10 10 } gl-rect ] with-translation ; : draw-spring ( spring -- ) [ node-a>> pos>> ] [ node-b>> pos>> ] bi gl-line ; 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 100755 index 0000000000..bf7b7b4556 --- /dev/null +++ b/extra/ui/render/test/test.factor @@ -0,0 +1,74 @@ +! 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 -- ) +