Merge branch 'master' of git://factorcode.org/git/factor
commit
94a81a50c5
|
@ -164,7 +164,7 @@ GENERIC: stack-size ( type -- size ) foldable
|
||||||
|
|
||||||
M: string stack-size c-type stack-size ;
|
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
|
GENERIC: byte-length ( seq -- n ) flushable
|
||||||
|
|
||||||
|
@ -436,6 +436,6 @@ M: long-long-type box-return ( type -- )
|
||||||
"double" define-primitive-type
|
"double" define-primitive-type
|
||||||
|
|
||||||
"long" "ptrdiff_t" typedef
|
"long" "ptrdiff_t" typedef
|
||||||
|
"long" "intptr_t" typedef
|
||||||
"ulong" "size_t" typedef
|
"ulong" "size_t" typedef
|
||||||
] with-compilation-unit
|
] with-compilation-unit
|
||||||
|
|
|
@ -1,14 +1,10 @@
|
||||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays generic hashtables kernel kernel.private
|
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 ;
|
alien.c-types alien.structs.fields cpu.architecture ;
|
||||||
IN: alien.structs
|
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 ;
|
TUPLE: struct-type size align fields ;
|
||||||
|
|
||||||
M: struct-type heap-size size>> ;
|
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 c-type-stack-align? drop f ;
|
||||||
|
|
||||||
M: struct-type unbox-parameter
|
: if-value-struct ( ctype true false -- )
|
||||||
[ %unbox-struct ] [ unbox-parameter ] if-value-structs? ;
|
[ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
|
||||||
|
|
||||||
M: struct-type unbox-return
|
M: struct-type unbox-parameter
|
||||||
f swap %unbox-struct ;
|
[ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
|
||||||
|
|
||||||
M: struct-type box-parameter
|
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
|
M: struct-type box-return
|
||||||
f swap %box-struct ;
|
[ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
|
||||||
|
|
||||||
M: struct-type stack-size
|
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? ;
|
: c-struct? ( type -- ? ) (c-type) struct-type? ;
|
||||||
|
|
||||||
|
@ -40,7 +42,7 @@ M: struct-type stack-size
|
||||||
-rot define-c-type ;
|
-rot define-c-type ;
|
||||||
|
|
||||||
: define-struct-early ( name vocab fields -- fields )
|
: define-struct-early ( name vocab fields -- fields )
|
||||||
-rot [ rot first2 <field-spec> ] 2curry map ;
|
[ first2 <field-spec> ] with with map ;
|
||||||
|
|
||||||
: compute-struct-align ( types -- n )
|
: compute-struct-align ( types -- n )
|
||||||
[ c-type-align ] map supremum ;
|
[ c-type-align ] map supremum ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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 ;
|
kernel io.files bootstrap.image sequences io urls ;
|
||||||
IN: bootstrap.image.download
|
IN: bootstrap.image.download
|
||||||
|
|
||||||
|
@ -13,7 +13,7 @@ IN: bootstrap.image.download
|
||||||
: need-new-image? ( image -- ? )
|
: need-new-image? ( image -- ? )
|
||||||
dup exists?
|
dup exists?
|
||||||
[
|
[
|
||||||
[ openssl-md5 checksum-file hex-string ]
|
[ md5 checksum-file hex-string ]
|
||||||
[ download-checksums at ]
|
[ download-checksums at ]
|
||||||
bi = not
|
bi = not
|
||||||
] [ drop t ] if ;
|
] [ drop t ] if ;
|
||||||
|
|
|
@ -1,2 +1 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
|
|
|
@ -2,10 +2,10 @@ USING: help.markup help.syntax parser vocabs.loader strings ;
|
||||||
IN: command-line
|
IN: command-line
|
||||||
|
|
||||||
HELP: run-bootstrap-init
|
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
|
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
|
HELP: cli-param
|
||||||
{ $values { "param" string } }
|
{ $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:"
|
"A number of command line switches can be passed to a bootstrap image to modify the behavior of the resulting image:"
|
||||||
{ $table
|
{ $table
|
||||||
{ { $snippet "-output-image=" { $emphasis "image" } } { "Save the result to " { $snippet "image" } ". The default is " { $snippet "factor.image" } "." } }
|
{ { $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 "-include=" { $emphasis "components..." } } "A list of components to include (see below)." }
|
||||||
{ { $snippet "-exclude=" { $emphasis "components..." } } "A list of components to exclude." }
|
{ { $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." } }
|
{ { $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=" } "."
|
"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
|
$nl
|
||||||
"For example, to build an image with the compiler but no other components, you could do:"
|
"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,"
|
"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" } "." ;
|
"To generate a bootstrap image in the first place, see " { $link "bootstrap.image" } "." ;
|
||||||
|
|
||||||
ARTICLE: "standard-cli-args" "Command line switches for general usage"
|
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
|
{ $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 "-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 "-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 "-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." } }
|
{ { $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"
|
ARTICLE: "factor-boot-rc" "Bootstrap initialization file"
|
||||||
"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."
|
"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
|
$nl
|
||||||
"The " { $snippet ".factor-rc" } " and " { $snippet ".factor-boot-rc" } " files can be run explicitly:"
|
"A word to run this file from an existing Factor session:"
|
||||||
{ $subsection run-user-init }
|
{ $subsection run-bootstrap-init }
|
||||||
{ $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"
|
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 } "."
|
"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 } "."
|
||||||
|
|
|
@ -5,14 +5,18 @@ kernel.private namespaces parser sequences strings system
|
||||||
splitting io.files eval ;
|
splitting io.files eval ;
|
||||||
IN: command-line
|
IN: command-line
|
||||||
|
|
||||||
|
: rc-path ( name -- path )
|
||||||
|
os windows? [ "." prepend ] unless
|
||||||
|
home prepend-path ;
|
||||||
|
|
||||||
: run-bootstrap-init ( -- )
|
: run-bootstrap-init ( -- )
|
||||||
"user-init" get [
|
"user-init" get [
|
||||||
home ".factor-boot-rc" append-path ?run-file
|
"factor-boot-rc" rc-path ?run-file
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: run-user-init ( -- )
|
: run-user-init ( -- )
|
||||||
"user-init" get [
|
"user-init" get [
|
||||||
home ".factor-rc" append-path ?run-file
|
"factor-rc" rc-path ?run-file
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
: cli-var-param ( name value -- ) swap set-global ;
|
: cli-var-param ( name value -- ) swap set-global ;
|
||||||
|
|
|
@ -235,7 +235,7 @@ M: float-regs reg-class-variable drop float-regs ;
|
||||||
GENERIC: inc-reg-class ( register-class -- )
|
GENERIC: inc-reg-class ( register-class -- )
|
||||||
|
|
||||||
: ?dummy-stack-params ( reg-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-class -- )
|
||||||
dummy-int-params? [ reg-size cell /i 1 max int-regs +@ ] [ drop ] if ;
|
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 )
|
: spill-param ( reg-class -- n reg-class )
|
||||||
stack-params get
|
stack-params get
|
||||||
>r reg-size stack-params +@ r>
|
>r reg-size cell align stack-params +@ r>
|
||||||
stack-params ;
|
stack-params ;
|
||||||
|
|
||||||
: fastcall-param ( reg-class -- n reg-class )
|
: fastcall-param ( reg-class -- n reg-class )
|
||||||
|
|
|
@ -6,7 +6,7 @@ HELP: enable-compiler
|
||||||
{ $description "Enables the optimizing compiler." } ;
|
{ $description "Enables the optimizing compiler." } ;
|
||||||
|
|
||||||
HELP: disable-compiler
|
HELP: disable-compiler
|
||||||
{ $description "Enables the optimizing compiler." } ;
|
{ $description "Disable the optimizing compiler." } ;
|
||||||
|
|
||||||
ARTICLE: "compiler-usage" "Calling the optimizing compiler"
|
ARTICLE: "compiler-usage" "Calling the optimizing compiler"
|
||||||
"Normally, new word definitions are recompiled automatically. This can be changed:"
|
"Normally, new word definitions are recompiled automatically. This can be changed:"
|
||||||
|
|
|
@ -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
|
! 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 )
|
: 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 )
|
||||||
"void"
|
"int"
|
||||||
f "ffi_test_31"
|
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" }
|
{ "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 ;
|
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 ;
|
FUNCTION: longlong ffi_test_21 long x long y ;
|
||||||
|
|
||||||
|
|
|
@ -34,14 +34,10 @@ IN: compiler.tree.builder
|
||||||
if ;
|
if ;
|
||||||
|
|
||||||
: (build-tree-from-word) ( word -- )
|
: (build-tree-from-word) ( word -- )
|
||||||
dup
|
dup initial-recursive-state recursive-state set
|
||||||
[ "inline" word-prop ]
|
dup [ "inline" word-prop ] [ "recursive" word-prop ] bi and
|
||||||
[ "recursive" word-prop ] bi and [
|
[ 1quotation ] [ specialized-def ] if
|
||||||
1quotation f initial-recursive-state infer-quot
|
infer-quot-here ;
|
||||||
] [
|
|
||||||
[ specialized-def ] [ initial-recursive-state ] bi
|
|
||||||
infer-quot
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: check-cannot-infer ( word -- )
|
: check-cannot-infer ( word -- )
|
||||||
dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ;
|
dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ;
|
||||||
|
|
|
@ -141,10 +141,10 @@ HOOK: %loop-entry cpu ( -- )
|
||||||
HOOK: small-enough? cpu ( n -- ? )
|
HOOK: small-enough? cpu ( n -- ? )
|
||||||
|
|
||||||
! Is this structure small enough to be returned in registers?
|
! 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?
|
! Do we pass this struct by value or hidden reference?
|
||||||
HOOK: value-structs? cpu ( -- ? )
|
HOOK: value-struct? cpu ( c-type -- ? )
|
||||||
|
|
||||||
! If t, all parameters are shadowed by dummy stack parameters
|
! If t, all parameters are shadowed by dummy stack parameters
|
||||||
HOOK: dummy-stack-params? cpu ( -- ? )
|
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-reg drop ;
|
||||||
|
|
||||||
M: stack-params param-regs drop f ;
|
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 ;
|
|
||||||
|
|
|
@ -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: 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 ;
|
M: ppc dummy-stack-params? f ;
|
||||||
|
|
||||||
|
|
|
@ -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: 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 ;
|
M: ppc dummy-stack-params? t ;
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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 ;
|
compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86 ;
|
||||||
IN: cpu.x86.64.winnt
|
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 reserved-area-size 4 cells ;
|
||||||
|
|
||||||
M: x86.64 struct-small-enough? ( size -- ? )
|
M: x86.64 struct-small-enough? heap-size { 1 2 4 8 } member? ;
|
||||||
heap-size cell <= ;
|
|
||||||
|
M: x86.64 value-struct? heap-size { 1 2 4 8 } member? ;
|
||||||
|
|
||||||
M: x86.64 dummy-stack-params? f ;
|
M: x86.64 dummy-stack-params? f ;
|
||||||
|
|
||||||
|
@ -21,6 +22,7 @@ M: x86.64 dummy-fp-params? t ;
|
||||||
|
|
||||||
<<
|
<<
|
||||||
"longlong" "ptrdiff_t" typedef
|
"longlong" "ptrdiff_t" typedef
|
||||||
|
"longlong" "intptr_t" typedef
|
||||||
"int" "long" typedef
|
"int" "long" typedef
|
||||||
"uint" "ulong" typedef
|
"uint" "ulong" typedef
|
||||||
>>
|
>>
|
||||||
|
|
|
@ -507,7 +507,7 @@ M: x86 %prepare-alien-invoke
|
||||||
temp-reg-1 2 cells [+] ds-reg MOV
|
temp-reg-1 2 cells [+] ds-reg MOV
|
||||||
temp-reg-1 3 cells [+] rs-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 -- ? )
|
M: x86 small-enough? ( n -- ? )
|
||||||
HEX: -80000000 HEX: 7fffffff between? ;
|
HEX: -80000000 HEX: 7fffffff between? ;
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
USING: definitions io.launcher kernel parser words sequences math
|
USING: definitions io.launcher kernel parser words sequences math
|
||||||
math.parser namespaces editors make ;
|
math.parser namespaces editors make system ;
|
||||||
IN: editors.emacs
|
IN: editors.emacs
|
||||||
|
|
||||||
: emacsclient ( file line -- )
|
: emacsclient ( file line -- )
|
||||||
[
|
[
|
||||||
\ emacsclient get "emacsclient" or ,
|
\ emacsclient get "emacsclient" or ,
|
||||||
"--no-wait" ,
|
os windows? [ "--no-wait" , ] unless
|
||||||
"+" swap number>string append ,
|
"+" swap number>string append ,
|
||||||
,
|
,
|
||||||
] { } make try-process ;
|
] { } make try-process ;
|
||||||
|
|
|
@ -64,7 +64,7 @@ C-STRUCT: glyph
|
||||||
{ "FT_Pos" "advance-x" }
|
{ "FT_Pos" "advance-x" }
|
||||||
{ "FT_Pos" "advance-y" }
|
{ "FT_Pos" "advance-y" }
|
||||||
|
|
||||||
{ "long" "format" }
|
{ "intptr_t" "format" }
|
||||||
|
|
||||||
{ "int" "bitmap-rows" }
|
{ "int" "bitmap-rows" }
|
||||||
{ "int" "bitmap-width" }
|
{ "int" "bitmap-width" }
|
||||||
|
|
|
@ -4,7 +4,6 @@ USING: kernel sequences db.tuples alarms calendar db fry
|
||||||
furnace.db
|
furnace.db
|
||||||
furnace.cache
|
furnace.cache
|
||||||
furnace.asides
|
furnace.asides
|
||||||
furnace.referrer
|
|
||||||
furnace.sessions
|
furnace.sessions
|
||||||
furnace.conversations
|
furnace.conversations
|
||||||
furnace.auth.providers
|
furnace.auth.providers
|
||||||
|
@ -24,8 +23,7 @@ IN: furnace.alloy
|
||||||
<conversations>
|
<conversations>
|
||||||
<sessions>
|
<sessions>
|
||||||
] dip
|
] dip
|
||||||
<db-persistence>
|
<db-persistence> ;
|
||||||
<check-form-submissions> ;
|
|
||||||
|
|
||||||
: start-expiring ( db -- )
|
: start-expiring ( db -- )
|
||||||
'[
|
'[
|
||||||
|
|
|
@ -61,7 +61,7 @@
|
||||||
</table>
|
</table>
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
<button>Update</button>
|
<button type="submit">Update</button>
|
||||||
<t:validation-errors />
|
<t:validation-errors />
|
||||||
</p>
|
</p>
|
||||||
|
|
||||||
|
|
|
@ -32,7 +32,7 @@
|
||||||
|
|
||||||
</table>
|
</table>
|
||||||
|
|
||||||
<button>Recover password</button>
|
<button type="submit">Recover password</button>
|
||||||
|
|
||||||
</t:form>
|
</t:form>
|
||||||
|
|
||||||
|
|
|
@ -31,7 +31,7 @@
|
||||||
</table>
|
</table>
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
<button>Set password</button>
|
<button type="submit">Set password</button>
|
||||||
<t:validation-errors />
|
<t:validation-errors />
|
||||||
</p>
|
</p>
|
||||||
|
|
||||||
|
|
|
@ -62,7 +62,7 @@
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
|
|
||||||
<button>Register</button>
|
<button type="submit">Register</button>
|
||||||
<t:validation-errors />
|
<t:validation-errors />
|
||||||
|
|
||||||
</p>
|
</p>
|
||||||
|
|
|
@ -35,7 +35,7 @@
|
||||||
|
|
||||||
<p>
|
<p>
|
||||||
|
|
||||||
<button>Log in</button>
|
<button type="submit">Log in</button>
|
||||||
<t:validation-errors />
|
<t:validation-errors />
|
||||||
|
|
||||||
</p>
|
</p>
|
||||||
|
|
|
@ -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." } ;
|
{ $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"
|
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
|
$nl
|
||||||
"Responders can implement methods on the following generic words:"
|
"Responders can implement methods on the following generic words:"
|
||||||
{ $subsection modify-query }
|
{ $subsection modify-query }
|
||||||
|
|
|
@ -10,17 +10,15 @@ IN: help.html
|
||||||
|
|
||||||
: escape-char ( ch -- )
|
: escape-char ( ch -- )
|
||||||
dup H{
|
dup H{
|
||||||
{ CHAR: " "__quote__" }
|
{ CHAR: " "__quo__" }
|
||||||
{ CHAR: * "__star__" }
|
{ CHAR: * "__star__" }
|
||||||
{ CHAR: : "__colon__" }
|
{ CHAR: : "__colon__" }
|
||||||
{ CHAR: < "__lt__" }
|
{ CHAR: < "__lt__" }
|
||||||
{ CHAR: > "__gt__" }
|
{ CHAR: > "__gt__" }
|
||||||
{ CHAR: ? "__question__" }
|
{ CHAR: ? "__que__" }
|
||||||
{ CHAR: \\ "__backslash__" }
|
{ CHAR: \\ "__back__" }
|
||||||
{ CHAR: | "__pipe__" }
|
{ CHAR: | "__pipe__" }
|
||||||
{ CHAR: _ "__underscore__" }
|
|
||||||
{ CHAR: / "__slash__" }
|
{ CHAR: / "__slash__" }
|
||||||
{ CHAR: \\ "__backslash__" }
|
|
||||||
{ CHAR: , "__comma__" }
|
{ CHAR: , "__comma__" }
|
||||||
{ CHAR: @ "__at__" }
|
{ CHAR: @ "__at__" }
|
||||||
} at [ % ] [ , ] ?if ;
|
} at [ % ] [ , ] ?if ;
|
||||||
|
@ -117,10 +115,10 @@ M: result link-href href>> ;
|
||||||
[ [ title>> ] compare ] sort ;
|
[ [ title>> ] compare ] sort ;
|
||||||
|
|
||||||
: article-apropos ( string -- results )
|
: article-apropos ( string -- results )
|
||||||
"articles.idx" temp-file offline-apropos ;
|
"articles.idx" offline-apropos ;
|
||||||
|
|
||||||
: word-apropos ( string -- results )
|
: word-apropos ( string -- results )
|
||||||
"words.idx" temp-file offline-apropos ;
|
"words.idx" offline-apropos ;
|
||||||
|
|
||||||
: vocab-apropos ( string -- results )
|
: vocab-apropos ( string -- results )
|
||||||
"vocabs.idx" temp-file offline-apropos ;
|
"vocabs.idx" offline-apropos ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: io io.files io.streams.string io.encodings.utf8
|
USING: io io.files io.streams.string io.encodings.utf8
|
||||||
html.templates html.templates.fhtml kernel
|
html.templates html.templates.fhtml kernel
|
||||||
tools.test sequences parser ;
|
tools.test sequences parser splitting prettyprint ;
|
||||||
IN: html.templates.fhtml.tests
|
IN: html.templates.fhtml.tests
|
||||||
|
|
||||||
: test-template ( path -- ? )
|
: test-template ( path -- ? )
|
||||||
|
@ -8,8 +8,10 @@ IN: html.templates.fhtml.tests
|
||||||
prepend
|
prepend
|
||||||
[
|
[
|
||||||
".fhtml" append <fhtml> [ call-template ] with-string-writer
|
".fhtml" append <fhtml> [ call-template ] with-string-writer
|
||||||
|
<string-reader> lines
|
||||||
] keep
|
] keep
|
||||||
".html" append utf8 file-contents = ;
|
".html" append utf8 file-lines
|
||||||
|
[ . . ] [ = ] 2bi ;
|
||||||
|
|
||||||
[ t ] [ "example" test-template ] unit-test
|
[ t ] [ "example" test-template ] unit-test
|
||||||
[ t ] [ "bug" test-template ] unit-test
|
[ t ] [ "bug" test-template ] unit-test
|
||||||
|
|
|
@ -3,4 +3,6 @@
|
||||||
USING: tools.test io.files.listing strings kernel ;
|
USING: tools.test io.files.listing strings kernel ;
|
||||||
IN: io.files.listing.tests
|
IN: io.files.listing.tests
|
||||||
|
|
||||||
|
\ directory. must-infer
|
||||||
|
|
||||||
[ ] [ "" directory. ] unit-test
|
[ ] [ "" directory. ] unit-test
|
||||||
|
|
|
@ -114,19 +114,29 @@ M: threaded-server handle-client* handler>> call ;
|
||||||
] when*
|
] when*
|
||||||
] unless ;
|
] 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>
|
PRIVATE>
|
||||||
|
|
||||||
: start-server ( threaded-server -- )
|
: start-server ( threaded-server -- )
|
||||||
init-server
|
#! Only create a secure-context if we want to listen on
|
||||||
dup secure-config>> [
|
#! a secure port, otherwise start-server won't work at
|
||||||
dup threaded-server [
|
#! all if SSL is not available.
|
||||||
dup name>> [
|
dup secure>> [
|
||||||
[ listen-on [ start-accept-loop ] parallel-each ]
|
dup secure-config>> [
|
||||||
[ ready>> raise-flag ]
|
(start-server)
|
||||||
bi
|
] with-secure-context
|
||||||
] with-logging
|
] [
|
||||||
] with-variable
|
(start-server)
|
||||||
] with-secure-context ;
|
] if ;
|
||||||
|
|
||||||
: wait-for-server ( threaded-server -- )
|
: wait-for-server ( threaded-server -- )
|
||||||
ready>> wait-for-flag ;
|
ready>> wait-for-flag ;
|
||||||
|
|
|
@ -1,157 +1,157 @@
|
||||||
USING: io.launcher tools.test calendar accessors environment
|
USING: io.launcher tools.test calendar accessors environment
|
||||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||||
sequences parser assocs hashtables math continuations eval ;
|
sequences parser assocs hashtables math continuations eval ;
|
||||||
IN: io.windows.launcher.nt.tests
|
IN: io.windows.launcher.nt.tests
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
<process>
|
<process>
|
||||||
"notepad" >>command
|
"notepad" >>command
|
||||||
1/2 seconds >>timeout
|
1/2 seconds >>timeout
|
||||||
"notepad" set
|
"notepad" set
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [ "notepad" get process-running? ] unit-test
|
[ f ] [ "notepad" get process-running? ] unit-test
|
||||||
|
|
||||||
[ f ] [ "notepad" get process-started? ] unit-test
|
[ f ] [ "notepad" get process-started? ] unit-test
|
||||||
|
|
||||||
[ ] [ "notepad" [ run-detached ] change ] unit-test
|
[ ] [ "notepad" [ run-detached ] change ] unit-test
|
||||||
|
|
||||||
[ "notepad" get wait-for-process ] must-fail
|
[ "notepad" get wait-for-process ] must-fail
|
||||||
|
|
||||||
[ t ] [ "notepad" get killed>> ] unit-test
|
[ t ] [ "notepad" get killed>> ] unit-test
|
||||||
|
|
||||||
[ f ] [ "notepad" get process-running? ] unit-test
|
[ f ] [ "notepad" get process-running? ] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
<process>
|
<process>
|
||||||
vm "-quiet" "-run=hello-world" 3array >>command
|
vm "-quiet" "-run=hello-world" 3array >>command
|
||||||
"out.txt" temp-file >>stdout
|
"out.txt" temp-file >>stdout
|
||||||
try-process
|
try-process
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "Hello world" ] [
|
[ "Hello world" ] [
|
||||||
"out.txt" temp-file ascii file-lines first
|
"out.txt" temp-file ascii file-lines first
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
<process>
|
<process>
|
||||||
vm "-run=listener" 2array >>command
|
vm "-run=listener" 2array >>command
|
||||||
+closed+ >>stdin
|
+closed+ >>stdin
|
||||||
try-process
|
try-process
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"resource:basis/io/windows/nt/launcher/test" [
|
"resource:basis/io/windows/nt/launcher/test" [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "stderr.factor" 3array >>command
|
vm "-script" "stderr.factor" 3array >>command
|
||||||
"out.txt" temp-file >>stdout
|
"out.txt" temp-file >>stdout
|
||||||
"err.txt" temp-file >>stderr
|
"err.txt" temp-file >>stderr
|
||||||
try-process
|
try-process
|
||||||
] with-directory
|
] with-directory
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "output" ] [
|
[ "output" ] [
|
||||||
"out.txt" temp-file ascii file-lines first
|
"out.txt" temp-file ascii file-lines first
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "error" ] [
|
[ "error" ] [
|
||||||
"err.txt" temp-file ascii file-lines first
|
"err.txt" temp-file ascii file-lines first
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"resource:basis/io/windows/nt/launcher/test" [
|
"resource:basis/io/windows/nt/launcher/test" [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "stderr.factor" 3array >>command
|
vm "-script" "stderr.factor" 3array >>command
|
||||||
"out.txt" temp-file >>stdout
|
"out.txt" temp-file >>stdout
|
||||||
+stdout+ >>stderr
|
+stdout+ >>stderr
|
||||||
try-process
|
try-process
|
||||||
] with-directory
|
] with-directory
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "outputerror" ] [
|
[ "outputerror" ] [
|
||||||
"out.txt" temp-file ascii file-lines first
|
"out.txt" temp-file ascii file-lines first
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "output" ] [
|
[ "output" ] [
|
||||||
"resource:basis/io/windows/nt/launcher/test" [
|
"resource:basis/io/windows/nt/launcher/test" [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "stderr.factor" 3array >>command
|
vm "-script" "stderr.factor" 3array >>command
|
||||||
"err2.txt" temp-file >>stderr
|
"err2.txt" temp-file >>stderr
|
||||||
ascii <process-reader> lines first
|
ascii <process-reader> lines first
|
||||||
] with-directory
|
] with-directory
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "error" ] [
|
[ "error" ] [
|
||||||
"err2.txt" temp-file ascii file-lines first
|
"err2.txt" temp-file ascii file-lines first
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
"resource:basis/io/windows/nt/launcher/test" [
|
"resource:basis/io/windows/nt/launcher/test" [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "env.factor" 3array >>command
|
vm "-script" "env.factor" 3array >>command
|
||||||
ascii <process-reader> contents
|
ascii <process-reader> contents
|
||||||
] with-directory eval
|
] with-directory eval
|
||||||
|
|
||||||
os-envs =
|
os-envs =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
"resource:basis/io/windows/nt/launcher/test" [
|
"resource:basis/io/windows/nt/launcher/test" [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "env.factor" 3array >>command
|
vm "-script" "env.factor" 3array >>command
|
||||||
+replace-environment+ >>environment-mode
|
+replace-environment+ >>environment-mode
|
||||||
os-envs >>environment
|
os-envs >>environment
|
||||||
ascii <process-reader> contents
|
ascii <process-reader> contents
|
||||||
] with-directory eval
|
] with-directory eval
|
||||||
|
|
||||||
os-envs =
|
os-envs =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ "B" ] [
|
[ "B" ] [
|
||||||
"resource:basis/io/windows/nt/launcher/test" [
|
"resource:basis/io/windows/nt/launcher/test" [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "env.factor" 3array >>command
|
vm "-script" "env.factor" 3array >>command
|
||||||
{ { "A" "B" } } >>environment
|
{ { "A" "B" } } >>environment
|
||||||
ascii <process-reader> contents
|
ascii <process-reader> contents
|
||||||
] with-directory eval
|
] with-directory eval
|
||||||
|
|
||||||
"A" swap at
|
"A" swap at
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [
|
[ f ] [
|
||||||
"resource:basis/io/windows/nt/launcher/test" [
|
"resource:basis/io/windows/nt/launcher/test" [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "env.factor" 3array >>command
|
vm "-script" "env.factor" 3array >>command
|
||||||
{ { "HOME" "XXX" } } >>environment
|
{ { "USERPROFILE" "XXX" } } >>environment
|
||||||
+prepend-environment+ >>environment-mode
|
+prepend-environment+ >>environment-mode
|
||||||
ascii <process-reader> contents
|
ascii <process-reader> contents
|
||||||
] with-directory eval
|
] with-directory eval
|
||||||
|
|
||||||
"HOME" swap at "XXX" =
|
"USERPROFILE" swap at "XXX" =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
2 [
|
2 [
|
||||||
[ ] [
|
[ ] [
|
||||||
<process>
|
<process>
|
||||||
"cmd.exe /c dir" >>command
|
"cmd.exe /c dir" >>command
|
||||||
"dir.txt" temp-file >>stdout
|
"dir.txt" temp-file >>stdout
|
||||||
try-process
|
try-process
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [ "dir.txt" temp-file delete-file ] unit-test
|
[ ] [ "dir.txt" temp-file delete-file ] unit-test
|
||||||
] times
|
] times
|
||||||
|
|
||||||
[ "append-test" temp-file delete-file ] ignore-errors
|
[ "append-test" temp-file delete-file ] ignore-errors
|
||||||
|
|
||||||
[ "Hello appender\r\nHello appender\r\n" ] [
|
[ "Hello appender\r\nHello appender\r\n" ] [
|
||||||
2 [
|
2 [
|
||||||
"resource:basis/io/windows/nt/launcher/test" [
|
"resource:basis/io/windows/nt/launcher/test" [
|
||||||
<process>
|
<process>
|
||||||
vm "-script" "append.factor" 3array >>command
|
vm "-script" "append.factor" 3array >>command
|
||||||
"append-test" temp-file <appender> >>stdout
|
"append-test" temp-file <appender> >>stdout
|
||||||
try-process
|
try-process
|
||||||
] with-directory
|
] with-directory
|
||||||
] times
|
] times
|
||||||
|
|
||||||
"append-test" temp-file ascii file-contents
|
"append-test" temp-file ascii file-contents
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -1,2 +1 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
|
|
|
@ -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
|
{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
|
||||||
|
|
||||||
|
|
||||||
:: literal-identity-test ( -- a b )
|
:: literal-identity-test ( -- a b )
|
||||||
{ } V{ } ;
|
{ } V{ } ;
|
||||||
|
|
||||||
|
@ -356,6 +355,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
||||||
swapd [ eq? ] [ eq? ] 2bi*
|
swapd [ eq? ] [ eq? ] 2bi*
|
||||||
] unit-test
|
] 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 -- )
|
:: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- )
|
||||||
obj1 obj2 <=> {
|
obj1 obj2 <=> {
|
||||||
{ +lt+ [ lt-quot call ] }
|
{ +lt+ [ lt-quot call ] }
|
||||||
|
|
|
@ -229,6 +229,8 @@ M: tuple rewrite-element
|
||||||
|
|
||||||
M: local rewrite-element , ;
|
M: local rewrite-element , ;
|
||||||
|
|
||||||
|
M: local-reader rewrite-element , ;
|
||||||
|
|
||||||
M: word rewrite-element literalize , ;
|
M: word rewrite-element literalize , ;
|
||||||
|
|
||||||
M: object rewrite-element , ;
|
M: object rewrite-element , ;
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays kernel math math.functions sequences
|
USING: arrays kernel math math.functions sequences
|
||||||
sequences.private words namespaces macros hints
|
sequences.private words namespaces macros hints
|
||||||
combinators fry ;
|
combinators fry io.binary ;
|
||||||
IN: math.bitwise
|
IN: math.bitwise
|
||||||
|
|
||||||
! utilities
|
! utilities
|
||||||
|
@ -93,3 +93,11 @@ PRIVATE>
|
||||||
|
|
||||||
: bit-count ( x -- n )
|
: bit-count ( x -- n )
|
||||||
dup 0 < [ bitnot ] when (bit-count) ; inline
|
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 )
|
||||||
|
<reversed> signed-le> ;
|
||||||
|
|
|
@ -15,7 +15,7 @@ IN: math.functions
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: rect> ( x y -- z )
|
: rect> ( x y -- z )
|
||||||
over real? over real? and [
|
2dup [ real? ] both? [
|
||||||
(rect>)
|
(rect>)
|
||||||
] [
|
] [
|
||||||
"Complex number must have real components" throw
|
"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 ;
|
>float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
|
||||||
|
|
||||||
: each-bit ( n quot: ( ? -- ) -- )
|
: each-bit ( n quot: ( ? -- ) -- )
|
||||||
over 0 = pick -1 = or [
|
over [ 0 = ] [ -1 = ] bi or [
|
||||||
2drop
|
2drop
|
||||||
] [
|
] [
|
||||||
2dup >r >r >r odd? r> call r> 2/ r> each-bit
|
2dup { [ odd? ] [ call ] [ 2/ ] [ each-bit ] } spread
|
||||||
] if ; inline recursive
|
] if ; inline recursive
|
||||||
|
|
||||||
: map-bits ( n quot: ( ? -- obj ) -- seq )
|
: map-bits ( n quot: ( ? -- obj ) -- seq )
|
||||||
|
@ -69,8 +69,7 @@ PRIVATE>
|
||||||
>rect [ >float ] bi@ ; inline
|
>rect [ >float ] bi@ ; inline
|
||||||
|
|
||||||
: >polar ( z -- abs arg )
|
: >polar ( z -- abs arg )
|
||||||
>float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ;
|
>float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; inline
|
||||||
inline
|
|
||||||
|
|
||||||
: cis ( arg -- z ) dup fcos swap fsin rect> ; inline
|
: cis ( arg -- z ) dup fcos swap fsin rect> ; inline
|
||||||
|
|
||||||
|
@ -79,11 +78,10 @@ PRIVATE>
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: ^mag ( w abs arg -- magnitude )
|
: ^mag ( w abs arg -- magnitude )
|
||||||
>r >r >float-rect swap r> swap fpow r> rot * fexp /f ;
|
[ >float-rect swap ] [ swap fpow ] [ rot * fexp /f ] tri* ; inline
|
||||||
inline
|
|
||||||
|
|
||||||
: ^theta ( w abs arg -- theta )
|
: ^theta ( w abs arg -- theta )
|
||||||
>r >r >float-rect r> flog * swap r> * + ; inline
|
[ >float-rect ] [ flog * swap ] [ * + ] tri* ; inline
|
||||||
|
|
||||||
: ^complex ( x y -- z )
|
: ^complex ( x y -- z )
|
||||||
swap >polar [ ^mag ] [ ^theta ] 3bi polar> ; inline
|
swap >polar [ ^mag ] [ ^theta ] 3bi polar> ; inline
|
||||||
|
@ -106,18 +104,18 @@ PRIVATE>
|
||||||
|
|
||||||
: (^mod) ( n x y -- z )
|
: (^mod) ( n x y -- z )
|
||||||
1 swap [
|
1 swap [
|
||||||
[ dupd * pick mod ] when >r sq over mod r>
|
[ dupd * pick mod ] when [ sq over mod ] dip
|
||||||
] each-bit 2nip ; inline
|
] each-bit 2nip ; inline
|
||||||
|
|
||||||
: (gcd) ( b a x y -- a d )
|
: (gcd) ( b a x y -- a d )
|
||||||
over zero? [
|
over zero? [
|
||||||
2nip
|
2nip
|
||||||
] [
|
] [
|
||||||
swap [ /mod >r over * swapd - r> ] keep (gcd)
|
swap [ /mod [ over * swapd - ] dip ] keep (gcd)
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: gcd ( x y -- a d )
|
: 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 )
|
: lcm ( a b -- c )
|
||||||
[ * ] 2keep gcd nip /i ; foldable
|
[ * ] 2keep gcd nip /i ; foldable
|
||||||
|
@ -131,7 +129,7 @@ PRIVATE>
|
||||||
|
|
||||||
: ^mod ( x y n -- z )
|
: ^mod ( x y n -- z )
|
||||||
over 0 < [
|
over 0 < [
|
||||||
[ >r neg r> ^mod ] keep mod-inv
|
[ [ neg ] dip ^mod ] keep mod-inv
|
||||||
] [
|
] [
|
||||||
-rot (^mod)
|
-rot (^mod)
|
||||||
] if ; foldable
|
] if ; foldable
|
||||||
|
@ -141,14 +139,14 @@ GENERIC: absq ( x -- y ) foldable
|
||||||
M: real absq sq ;
|
M: real absq sq ;
|
||||||
|
|
||||||
: ~abs ( x y epsilon -- ? )
|
: ~abs ( x y epsilon -- ? )
|
||||||
>r - abs r> < ;
|
[ - abs ] dip < ;
|
||||||
|
|
||||||
: ~rel ( x y epsilon -- ? )
|
: ~rel ( x y epsilon -- ? )
|
||||||
>r [ - abs ] 2keep [ abs ] bi@ + r> * < ;
|
[ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ;
|
||||||
|
|
||||||
: ~ ( x y epsilon -- ? )
|
: ~ ( x y epsilon -- ? )
|
||||||
{
|
{
|
||||||
{ [ pick fp-nan? pick fp-nan? or ] [ 3drop f ] }
|
{ [ 2over [ fp-nan? ] either? ] [ 3drop f ] }
|
||||||
{ [ dup zero? ] [ drop number= ] }
|
{ [ dup zero? ] [ drop number= ] }
|
||||||
{ [ dup 0 < ] [ ~rel ] }
|
{ [ dup 0 < ] [ ~rel ] }
|
||||||
[ ~abs ]
|
[ ~abs ]
|
||||||
|
|
|
@ -12,10 +12,10 @@ SYMBOL: full-interval
|
||||||
TUPLE: interval { from read-only } { to read-only } ;
|
TUPLE: interval { from read-only } { to read-only } ;
|
||||||
|
|
||||||
: <interval> ( from to -- int )
|
: <interval> ( from to -- int )
|
||||||
over first over first {
|
2dup [ first ] bi@ {
|
||||||
{ [ 2dup > ] [ 2drop 2drop empty-interval ] }
|
{ [ 2dup > ] [ 2drop 2drop empty-interval ] }
|
||||||
{ [ 2dup = ] [
|
{ [ 2dup = ] [
|
||||||
2drop over second over second and
|
2drop 2dup [ second ] both?
|
||||||
[ interval boa ] [ 2drop empty-interval ] if
|
[ interval boa ] [ 2drop empty-interval ] if
|
||||||
] }
|
] }
|
||||||
[ 2drop interval boa ]
|
[ 2drop interval boa ]
|
||||||
|
@ -26,16 +26,16 @@ TUPLE: interval { from read-only } { to read-only } ;
|
||||||
: closed-point ( n -- endpoint ) t 2array ;
|
: closed-point ( n -- endpoint ) t 2array ;
|
||||||
|
|
||||||
: [a,b] ( a b -- interval )
|
: [a,b] ( a b -- interval )
|
||||||
>r closed-point r> closed-point <interval> ; foldable
|
[ closed-point ] dip closed-point <interval> ; foldable
|
||||||
|
|
||||||
: (a,b) ( a b -- interval )
|
: (a,b) ( a b -- interval )
|
||||||
>r open-point r> open-point <interval> ; foldable
|
[ open-point ] dip open-point <interval> ; foldable
|
||||||
|
|
||||||
: [a,b) ( a b -- interval )
|
: [a,b) ( a b -- interval )
|
||||||
>r closed-point r> open-point <interval> ; foldable
|
[ closed-point ] dip open-point <interval> ; foldable
|
||||||
|
|
||||||
: (a,b] ( a b -- interval )
|
: (a,b] ( a b -- interval )
|
||||||
>r open-point r> closed-point <interval> ; foldable
|
[ open-point ] dip closed-point <interval> ; foldable
|
||||||
|
|
||||||
: [a,a] ( a -- interval )
|
: [a,a] ( a -- interval )
|
||||||
closed-point dup <interval> ; foldable
|
closed-point dup <interval> ; foldable
|
||||||
|
@ -51,11 +51,11 @@ TUPLE: interval { from read-only } { to read-only } ;
|
||||||
: [-inf,inf] ( -- interval ) full-interval ; inline
|
: [-inf,inf] ( -- interval ) full-interval ; inline
|
||||||
|
|
||||||
: compare-endpoints ( p1 p2 quot -- ? )
|
: compare-endpoints ( p1 p2 quot -- ? )
|
||||||
>r over first over first r> call [
|
[ 2dup [ first ] bi@ ] dip call [
|
||||||
2drop t
|
2drop t
|
||||||
] [
|
] [
|
||||||
over first over first = [
|
2dup [ first ] bi@ = [
|
||||||
swap second swap second not or
|
[ second ] bi@ not or
|
||||||
] [
|
] [
|
||||||
2drop f
|
2drop f
|
||||||
] if
|
] if
|
||||||
|
@ -86,7 +86,7 @@ TUPLE: interval { from read-only } { to read-only } ;
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: (interval-op) ( p1 p2 quot -- p3 )
|
: (interval-op) ( p1 p2 quot -- p3 )
|
||||||
[ [ first ] [ first ] [ ] tri* call ]
|
[ [ first ] [ first ] [ call ] tri* ]
|
||||||
[ drop [ second ] both? ]
|
[ drop [ second ] both? ]
|
||||||
3bi 2array ; inline
|
3bi 2array ; inline
|
||||||
|
|
||||||
|
@ -177,7 +177,7 @@ TUPLE: interval { from read-only } { to read-only } ;
|
||||||
drop f
|
drop f
|
||||||
] [
|
] [
|
||||||
interval>points
|
interval>points
|
||||||
2dup [ second ] bi@ and
|
2dup [ second ] both?
|
||||||
[ [ first ] bi@ = ]
|
[ [ first ] bi@ = ]
|
||||||
[ 2drop f ] if
|
[ 2drop f ] if
|
||||||
] if ;
|
] if ;
|
||||||
|
@ -193,9 +193,9 @@ TUPLE: interval { from read-only } { to read-only } ;
|
||||||
dup [ interval>points [ first ] bi@ [a,b] ] when ;
|
dup [ interval>points [ first ] bi@ [a,b] ] when ;
|
||||||
|
|
||||||
: interval-integer-op ( i1 i2 quot -- i3 )
|
: interval-integer-op ( i1 i2 quot -- i3 )
|
||||||
>r 2dup
|
[
|
||||||
[ interval>points [ first integer? ] both? ] both?
|
2dup [ interval>points [ first integer? ] both? ] both?
|
||||||
r> [ 2drop [-inf,inf] ] if ; inline
|
] dip [ 2drop [-inf,inf] ] if ; inline
|
||||||
|
|
||||||
: interval-shift ( i1 i2 -- i3 )
|
: interval-shift ( i1 i2 -- i3 )
|
||||||
#! Inaccurate; could be tighter
|
#! Inaccurate; could be tighter
|
||||||
|
@ -302,7 +302,7 @@ SYMBOL: incomparable
|
||||||
2tri and and ;
|
2tri and and ;
|
||||||
|
|
||||||
: (interval<) ( i1 i2 -- i1 i2 ? )
|
: (interval<) ( i1 i2 -- i1 i2 ? )
|
||||||
over from>> over from>> endpoint< ;
|
2dup [ from>> ] bi@ endpoint< ;
|
||||||
|
|
||||||
: interval< ( i1 i2 -- ? )
|
: interval< ( i1 i2 -- ? )
|
||||||
{
|
{
|
||||||
|
@ -314,10 +314,10 @@ SYMBOL: incomparable
|
||||||
} cond 2nip ;
|
} cond 2nip ;
|
||||||
|
|
||||||
: left-endpoint-<= ( i1 i2 -- ? )
|
: left-endpoint-<= ( i1 i2 -- ? )
|
||||||
>r from>> r> to>> = ;
|
[ from>> ] dip to>> = ;
|
||||||
|
|
||||||
: right-endpoint-<= ( i1 i2 -- ? )
|
: right-endpoint-<= ( i1 i2 -- ? )
|
||||||
>r to>> r> from>> = ;
|
[ to>> ] dip from>> = ;
|
||||||
|
|
||||||
: interval<= ( i1 i2 -- ? )
|
: interval<= ( i1 i2 -- ? )
|
||||||
{
|
{
|
||||||
|
|
|
@ -126,7 +126,7 @@ SYMBOL: fast-math-ops
|
||||||
|
|
||||||
: math-method* ( word left right -- quot )
|
: math-method* ( word left right -- quot )
|
||||||
3dup math-op
|
3dup math-op
|
||||||
[ >r 3drop r> 1quotation ] [ drop math-method ] if ;
|
[ [ 3drop ] dip 1quotation ] [ drop math-method ] if ;
|
||||||
|
|
||||||
: math-both-known? ( word left right -- ? )
|
: math-both-known? ( word left right -- ? )
|
||||||
3dup math-op
|
3dup math-op
|
||||||
|
@ -157,13 +157,13 @@ SYMBOL: fast-math-ops
|
||||||
] bi@ append ;
|
] bi@ append ;
|
||||||
|
|
||||||
: each-derived-op ( word quot -- )
|
: each-derived-op ( word quot -- )
|
||||||
>r derived-ops r> each ; inline
|
[ derived-ops ] dip each ; inline
|
||||||
|
|
||||||
: each-fast-derived-op ( word quot -- )
|
: 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 -- )
|
: each-integer-derived-op ( word quot -- )
|
||||||
>r integer-derived-ops r> each ; inline
|
[ integer-derived-ops ] dip each ; inline
|
||||||
|
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
|
|
|
@ -8,7 +8,7 @@ TUPLE: range
|
||||||
{ step read-only } ;
|
{ step read-only } ;
|
||||||
|
|
||||||
: <range> ( a b step -- range )
|
: <range> ( a b step -- range )
|
||||||
>r over - r>
|
[ over - ] dip
|
||||||
[ / 1+ 0 max >integer ] keep
|
[ / 1+ 0 max >integer ] keep
|
||||||
range boa ; inline
|
range boa ; inline
|
||||||
|
|
||||||
|
|
|
@ -12,10 +12,10 @@ IN: math.ratios
|
||||||
dup 1 number= [ drop ] [ <ratio> ] if ; inline
|
dup 1 number= [ drop ] [ <ratio> ] if ; inline
|
||||||
|
|
||||||
: scale ( a/b c/d -- a*d b*c )
|
: 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 )
|
: ratio+d ( a/b c/d -- b*d )
|
||||||
denominator swap denominator * ; inline
|
[ denominator ] bi@ * ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -24,7 +24,7 @@ M: integer /
|
||||||
"Division by zero" throw
|
"Division by zero" throw
|
||||||
] [
|
] [
|
||||||
dup 0 < [ [ neg ] bi@ ] when
|
dup 0 < [ [ neg ] bi@ ] when
|
||||||
2dup gcd nip tuck /i >r /i r> fraction>
|
2dup gcd nip tuck /i [ /i ] dip fraction>
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
M: ratio hashcode*
|
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 - 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 / scale / ;
|
||||||
M: ratio /i scale /i ;
|
M: ratio /i scale /i ;
|
||||||
M: ratio /f scale /f ;
|
M: ratio /f scale /f ;
|
||||||
|
|
|
@ -34,7 +34,7 @@ HELP: n*v
|
||||||
{ $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ;
|
{ $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ;
|
||||||
|
|
||||||
HELP: v*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" } "." } ;
|
{ $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ;
|
||||||
|
|
||||||
HELP: n/v
|
HELP: n/v
|
||||||
|
|
|
@ -25,7 +25,7 @@ IN: math.vectors
|
||||||
: normalize ( u -- v ) dup norm v/n ;
|
: normalize ( u -- v ) dup norm v/n ;
|
||||||
|
|
||||||
: set-axis ( u v axis -- w )
|
: 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: vneg { array } ;
|
||||||
HINTS: norm-sq { array } ;
|
HINTS: norm-sq { array } ;
|
||||||
|
|
|
@ -1,2 +1 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
|
|
|
@ -31,7 +31,7 @@ IN: opengl
|
||||||
over glEnableClientState dip glDisableClientState ; inline
|
over glEnableClientState dip glDisableClientState ; inline
|
||||||
|
|
||||||
: words>values ( word/value-seq -- value-seq )
|
: words>values ( word/value-seq -- value-seq )
|
||||||
[ dup word? [ execute ] [ ] if ] map ;
|
[ dup word? [ execute ] when ] map ;
|
||||||
|
|
||||||
: (all-enabled) ( seq quot -- )
|
: (all-enabled) ( seq quot -- )
|
||||||
over [ glEnable ] each dip [ glDisable ] each ; inline
|
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
|
[ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline
|
||||||
|
|
||||||
: line-vertices ( a b -- )
|
: 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 -- )
|
: gl-line ( a b -- )
|
||||||
line-vertices GL_LINES 0 2 glDrawArrays ;
|
line-vertices GL_LINES 0 2 glDrawArrays ;
|
||||||
|
|
||||||
: (rect-vertices) ( dim -- vertices )
|
: (rect-vertices) ( dim -- vertices )
|
||||||
{
|
{
|
||||||
[ drop 0 1 ]
|
[ drop 0.5 0.5 ]
|
||||||
[ first 1- 1 ]
|
[ first 0.3 - 0.5 ]
|
||||||
[ [ first 1- ] [ second ] bi ]
|
[ [ first 0.3 - ] [ second 0.3 - ] bi ]
|
||||||
[ second 0 swap ]
|
[ second 0.3 - 0.5 swap ]
|
||||||
} cleave 8 narray >c-float-array ;
|
} cleave 8 narray >c-float-array ;
|
||||||
|
|
||||||
: rect-vertices ( dim -- )
|
: rect-vertices ( dim -- )
|
||||||
|
|
|
@ -355,3 +355,13 @@ INTERSECTION: intersection-see-test sequence number ;
|
||||||
[ ] [ \ curry see ] unit-test
|
[ ] [ \ curry see ] unit-test
|
||||||
|
|
||||||
[ "POSTPONE: [" ] [ \ [ unparse ] 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
|
||||||
|
|
|
@ -253,6 +253,9 @@ M: object see
|
||||||
block>
|
block>
|
||||||
] with-use nl ;
|
] with-use nl ;
|
||||||
|
|
||||||
|
M: method-spec see
|
||||||
|
first2 method see ;
|
||||||
|
|
||||||
GENERIC: see-class* ( word -- )
|
GENERIC: see-class* ( word -- )
|
||||||
|
|
||||||
M: union-class see-class*
|
M: union-class see-class*
|
||||||
|
|
|
@ -1,2 +1 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2008 Doug Coleman.
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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
|
IN: regexp.backend
|
||||||
|
|
||||||
TUPLE: regexp
|
TUPLE: regexp
|
||||||
|
|
|
@ -30,6 +30,10 @@ M: ascii-class class-member? ( obj class -- ? )
|
||||||
M: digit-class class-member? ( obj class -- ? )
|
M: digit-class class-member? ( obj class -- ? )
|
||||||
drop digit? ;
|
drop digit? ;
|
||||||
|
|
||||||
|
M: c-identifier-class class-member? ( obj class -- ? )
|
||||||
|
drop
|
||||||
|
{ [ digit? ] [ Letter? ] [ CHAR: _ = ] } 1|| ;
|
||||||
|
|
||||||
M: alpha-class class-member? ( obj class -- ? )
|
M: alpha-class class-member? ( obj class -- ? )
|
||||||
drop alpha? ;
|
drop alpha? ;
|
||||||
|
|
||||||
|
|
|
@ -137,7 +137,7 @@ ERROR: bad-special-group string ;
|
||||||
DEFER: (parse-regexp)
|
DEFER: (parse-regexp)
|
||||||
: nested-parse-regexp ( token ? -- )
|
: nested-parse-regexp ( token ? -- )
|
||||||
[ push-stack (parse-regexp) pop-stack ] dip
|
[ push-stack (parse-regexp) pop-stack ] dip
|
||||||
[ <negation> ] when pop-stack boa push-stack ;
|
[ <negation> ] when pop-stack new swap >>term push-stack ;
|
||||||
|
|
||||||
! non-capturing groups
|
! non-capturing groups
|
||||||
: (parse-special-group) ( -- )
|
: (parse-special-group) ( -- )
|
||||||
|
@ -294,6 +294,7 @@ ERROR: unrecognized-escape char ;
|
||||||
read1
|
read1
|
||||||
{
|
{
|
||||||
{ CHAR: \ [ CHAR: \ <constant> ] }
|
{ CHAR: \ [ CHAR: \ <constant> ] }
|
||||||
|
{ CHAR: / [ CHAR: / <constant> ] }
|
||||||
{ CHAR: ^ [ CHAR: ^ <constant> ] }
|
{ CHAR: ^ [ CHAR: ^ <constant> ] }
|
||||||
{ CHAR: $ [ CHAR: $ <constant> ] }
|
{ CHAR: $ [ CHAR: $ <constant> ] }
|
||||||
{ CHAR: - [ CHAR: - <constant> ] }
|
{ CHAR: - [ CHAR: - <constant> ] }
|
||||||
|
|
|
@ -2,6 +2,9 @@ USING: regexp tools.test kernel sequences regexp.parser
|
||||||
regexp.traversal eval ;
|
regexp.traversal eval ;
|
||||||
IN: regexp-tests
|
IN: regexp-tests
|
||||||
|
|
||||||
|
\ <regexp> must-infer
|
||||||
|
\ matches? must-infer
|
||||||
|
|
||||||
[ f ] [ "b" "a*" <regexp> matches? ] unit-test
|
[ f ] [ "b" "a*" <regexp> matches? ] unit-test
|
||||||
[ t ] [ "" "a*" <regexp> matches? ] unit-test
|
[ t ] [ "" "a*" <regexp> matches? ] unit-test
|
||||||
[ t ] [ "a" "a*" <regexp> matches? ] unit-test
|
[ t ] [ "a" "a*" <regexp> matches? ] unit-test
|
||||||
|
@ -43,6 +46,18 @@ IN: regexp-tests
|
||||||
[ t ] [ "a" ".+" <regexp> matches? ] unit-test
|
[ t ] [ "a" ".+" <regexp> matches? ] unit-test
|
||||||
[ t ] [ "ab" ".+" <regexp> matches? ] unit-test
|
[ t ] [ "ab" ".+" <regexp> matches? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ " " "[\\s]" <regexp> matches? ] unit-test
|
||||||
|
[ f ] [ "a" "[\\s]" <regexp> matches? ] unit-test
|
||||||
|
[ f ] [ " " "[\\S]" <regexp> matches? ] unit-test
|
||||||
|
[ t ] [ "a" "[\\S]" <regexp> matches? ] unit-test
|
||||||
|
[ f ] [ " " "[\\w]" <regexp> matches? ] unit-test
|
||||||
|
[ t ] [ "a" "[\\w]" <regexp> matches? ] unit-test
|
||||||
|
[ t ] [ " " "[\\W]" <regexp> matches? ] unit-test
|
||||||
|
[ f ] [ "a" "[\\W]" <regexp> matches? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ "/" "\\/" <regexp> matches? ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ "a" R' a'i matches? ] unit-test
|
||||||
|
|
||||||
[ t ] [ "" "a|b*|c+|d?" <regexp> matches? ] unit-test
|
[ t ] [ "" "a|b*|c+|d?" <regexp> matches? ] unit-test
|
||||||
[ t ] [ "a" "a|b*|c+|d?" <regexp> matches? ] unit-test
|
[ t ] [ "a" "a|b*|c+|d?" <regexp> matches? ] unit-test
|
||||||
|
@ -331,3 +346,7 @@ IN: regexp-tests
|
||||||
[ { 0 3 } ] [ "abc" "(ab|a)(bc)?" <regexp> first-match ] unit-test
|
[ { 0 3 } ] [ "abc" "(ab|a)(bc)?" <regexp> first-match ] unit-test
|
||||||
|
|
||||||
[ { 23 24 } ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match ] unit-test
|
[ { 23 24 } ] [ "aaaaaaaaaaaaaaaaaaaaaaab" "((a*)*b)*b" <regexp> first-match ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ "a:b" ".+:?" <regexp> matches? ] unit-test
|
||||||
|
|
||||||
|
[ 1 ] [ "hello" ".+?" <regexp> match length ] unit-test
|
||||||
|
|
|
@ -28,7 +28,7 @@ IN: regexp
|
||||||
: match ( string regexp -- pair )
|
: match ( string regexp -- pair )
|
||||||
<dfa-traverser> do-match return-match ;
|
<dfa-traverser> do-match return-match ;
|
||||||
|
|
||||||
: match* ( string regexp -- pair )
|
: match* ( string regexp -- pair captured-groups )
|
||||||
<dfa-traverser> do-match [ return-match ] [ captured-groups>> ] bi ;
|
<dfa-traverser> do-match [ return-match ] [ captured-groups>> ] bi ;
|
||||||
|
|
||||||
: matches? ( string regexp -- ? )
|
: matches? ( string regexp -- ? )
|
||||||
|
@ -129,8 +129,6 @@ IN: regexp
|
||||||
: option? ( option regexp -- ? )
|
: option? ( option regexp -- ? )
|
||||||
options>> key? ;
|
options>> key? ;
|
||||||
|
|
||||||
USE: multiline
|
|
||||||
/*
|
|
||||||
M: regexp pprint*
|
M: regexp pprint*
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
|
@ -139,4 +137,3 @@ M: regexp pprint*
|
||||||
case-insensitive swap option? [ "i" % ] when
|
case-insensitive swap option? [ "i" % ] when
|
||||||
] "" make
|
] "" make
|
||||||
] keep present-text ;
|
] keep present-text ;
|
||||||
*/
|
|
||||||
|
|
|
@ -107,7 +107,8 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
|
||||||
: increment-state ( dfa-traverser state -- dfa-traverser )
|
: increment-state ( dfa-traverser state -- dfa-traverser )
|
||||||
[
|
[
|
||||||
dup traverse-forward>>
|
dup traverse-forward>>
|
||||||
[ 1+ ] [ 1- ] ? change-current-index
|
[ [ 1+ ] change-current-index ]
|
||||||
|
[ [ 1- ] change-current-index ] if
|
||||||
dup current-state>> >>last-state
|
dup current-state>> >>last-state
|
||||||
] dip
|
] dip
|
||||||
first >>current-state ;
|
first >>current-state ;
|
||||||
|
|
|
@ -0,0 +1,4 @@
|
||||||
|
USING: regexp.utils tools.test ;
|
||||||
|
IN: regexp.utils.tests
|
||||||
|
|
||||||
|
[ [ ] [ ] while-changes ] must-infer
|
|
@ -5,9 +5,7 @@ namespaces regexp.backend sequences unicode.categories
|
||||||
math.ranges fry combinators.short-circuit vectors ;
|
math.ranges fry combinators.short-circuit vectors ;
|
||||||
IN: regexp.utils
|
IN: regexp.utils
|
||||||
|
|
||||||
: (while-changes) ( obj quot pred pred-ret -- obj )
|
: (while-changes) ( obj quot: ( obj -- obj' ) pred: ( obj -- <=> ) pred-ret -- obj )
|
||||||
! quot: ( obj -- obj' )
|
|
||||||
! pred: ( obj -- <=> )
|
|
||||||
[ [ dup slip ] dip pick over call ] dip dupd =
|
[ [ dup slip ] dip pick over call ] dip dupd =
|
||||||
[ 3drop ] [ (while-changes) ] if ; inline recursive
|
[ 3drop ] [ (while-changes) ] if ; inline recursive
|
||||||
|
|
||||||
|
|
|
@ -24,7 +24,7 @@ M: inference-error error-help error>> error-help ;
|
||||||
+warning+ (inference-error) ; inline
|
+warning+ (inference-error) ; inline
|
||||||
|
|
||||||
M: inference-error error.
|
M: inference-error error.
|
||||||
[ "In word: " write word>> . ] [ error>> error. ] bi ;
|
[ word>> [ "In word: " write . ] when* ] [ error>> error. ] bi ;
|
||||||
|
|
||||||
TUPLE: literal-expected ;
|
TUPLE: literal-expected ;
|
||||||
|
|
||||||
|
@ -108,3 +108,9 @@ M: inconsistent-recursive-call-error error.
|
||||||
"The recursive word " write
|
"The recursive word " write
|
||||||
word>> pprint
|
word>> pprint
|
||||||
" calls itself with a different set of quotation parameters than were input" print ;
|
" 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 ;
|
||||||
|
|
|
@ -162,7 +162,7 @@ M: object infer-call*
|
||||||
{ \ load-locals [ infer-load-locals ] }
|
{ \ load-locals [ infer-load-locals ] }
|
||||||
{ \ get-local [ infer-get-local ] }
|
{ \ get-local [ infer-get-local ] }
|
||||||
{ \ drop-locals [ infer-drop-locals ] }
|
{ \ 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-invoke [ infer-alien-invoke ] }
|
||||||
{ \ alien-indirect [ infer-alien-indirect ] }
|
{ \ alien-indirect [ infer-alien-indirect ] }
|
||||||
{ \ alien-callback [ infer-alien-callback ] }
|
{ \ alien-callback [ infer-alien-callback ] }
|
||||||
|
|
|
@ -4,9 +4,7 @@ USING: accessors arrays sequences kernel sequences assocs
|
||||||
namespaces stack-checker.recursive-state.tree ;
|
namespaces stack-checker.recursive-state.tree ;
|
||||||
IN: stack-checker.recursive-state
|
IN: stack-checker.recursive-state
|
||||||
|
|
||||||
TUPLE: recursive-state words word quotations inline-words ;
|
TUPLE: recursive-state word words quotations inline-words ;
|
||||||
|
|
||||||
C: <recursive-state> recursive-state
|
|
||||||
|
|
||||||
: prepare-recursive-state ( word rstate -- rstate )
|
: prepare-recursive-state ( word rstate -- rstate )
|
||||||
swap >>word
|
swap >>word
|
||||||
|
|
|
@ -580,3 +580,5 @@ DEFER: eee'
|
||||||
dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive
|
dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive
|
||||||
|
|
||||||
[ bogus-error ] must-infer
|
[ bogus-error ] must-infer
|
||||||
|
|
||||||
|
[ [ clear ] infer. ] [ inference-error? ] must-fail-with
|
||||||
|
|
|
@ -9,7 +9,7 @@ sorting compiler.units definitions ;
|
||||||
QUALIFIED: bootstrap.stage2
|
QUALIFIED: bootstrap.stage2
|
||||||
QUALIFIED: classes
|
QUALIFIED: classes
|
||||||
QUALIFIED: command-line
|
QUALIFIED: command-line
|
||||||
QUALIFIED: compiler.errors.private
|
QUALIFIED: compiler.errors
|
||||||
QUALIFIED: continuations
|
QUALIFIED: continuations
|
||||||
QUALIFIED: definitions
|
QUALIFIED: definitions
|
||||||
QUALIFIED: init
|
QUALIFIED: init
|
||||||
|
@ -291,7 +291,7 @@ IN: tools.deploy.shaker
|
||||||
|
|
||||||
strip-debugger? [
|
strip-debugger? [
|
||||||
{
|
{
|
||||||
compiler.errors.private:compiler-errors
|
compiler.errors:compiler-errors
|
||||||
continuations:thread-error-hook
|
continuations:thread-error-hook
|
||||||
} %
|
} %
|
||||||
] when
|
] when
|
||||||
|
|
|
@ -1,3 +1,2 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
tools
|
tools
|
||||||
|
|
|
@ -196,7 +196,6 @@ M: freetype-renderer string-height ( open-font string -- h )
|
||||||
:: (draw-string) ( open-font sprites string loc -- )
|
:: (draw-string) ( open-font sprites string loc -- )
|
||||||
GL_TEXTURE_2D [
|
GL_TEXTURE_2D [
|
||||||
loc [
|
loc [
|
||||||
-0.5 0.5 0.0 glTranslated
|
|
||||||
string open-font string char-widths scan-sums [
|
string open-font string char-widths scan-sums [
|
||||||
[ open-font sprites ] 2dip draw-char
|
[ open-font sprites ] 2dip draw-char
|
||||||
] 2each
|
] 2each
|
||||||
|
|
|
@ -111,8 +111,8 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ;
|
||||||
|
|
||||||
: checkmark-points ( dim -- points )
|
: checkmark-points ( dim -- points )
|
||||||
{
|
{
|
||||||
[ { 0 0 } v* { 0 1 } v+ ]
|
[ { 0 0 } v* ]
|
||||||
[ { 1 1 } v* { 0 1 } v+ ]
|
[ { 1 1 } v* ]
|
||||||
[ { 0 1 } v* ]
|
[ { 0 1 } v* ]
|
||||||
[ { 1 0 } v* ]
|
[ { 1 0 } v* ]
|
||||||
} cleave 4array ;
|
} cleave 4array ;
|
||||||
|
|
|
@ -120,7 +120,7 @@ M: editor ungraft*
|
||||||
|
|
||||||
: scroll>caret ( editor -- )
|
: scroll>caret ( editor -- )
|
||||||
dup graft-state>> second [
|
dup graft-state>> second [
|
||||||
dup caret-loc over caret-dim { 1 0 } v+ <rect>
|
dup caret-loc over caret-dim <rect>
|
||||||
over scroll>rect
|
over scroll>rect
|
||||||
] when drop ;
|
] when drop ;
|
||||||
|
|
||||||
|
|
|
@ -18,15 +18,16 @@ SYMBOL: grid-dim
|
||||||
grid-dim get spin set-axis ;
|
grid-dim get spin set-axis ;
|
||||||
|
|
||||||
: draw-grid-lines ( gaps orientation -- )
|
: draw-grid-lines ( gaps orientation -- )
|
||||||
grid get rot grid-positions grid get rect-dim suffix [
|
[ grid get swap grid-positions grid get rect-dim suffix ] dip
|
||||||
grid-line-from/to gl-line
|
[ [ v- ] curry map ] keep
|
||||||
] with each ;
|
[ swap grid-line-from/to gl-line ] curry each ;
|
||||||
|
|
||||||
M: grid-lines draw-boundary
|
M: grid-lines draw-boundary
|
||||||
color>> gl-color [
|
color>> gl-color [
|
||||||
dup grid set
|
dup grid set
|
||||||
dup rect-dim half-gap v- grid-dim set
|
dup rect-dim half-gap v- grid-dim set
|
||||||
compute-grid
|
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 ;
|
] with-scope ;
|
||||||
|
|
|
@ -23,7 +23,7 @@ SYMBOL: viewport-translation
|
||||||
[ rect-intersect ] keep
|
[ rect-intersect ] keep
|
||||||
dim>> dup { 0 1 } v* viewport-translation set
|
dim>> dup { 0 1 } v* viewport-translation set
|
||||||
{ 0 0 } over gl-viewport
|
{ 0 0 } over gl-viewport
|
||||||
-0.5 swap first2 [ 0.5 - ] [ 0.5 + ] bi* 0.5 gluOrtho2D
|
0 swap first2 0 gluOrtho2D
|
||||||
clip set
|
clip set
|
||||||
do-clip ;
|
do-clip ;
|
||||||
|
|
||||||
|
|
|
@ -181,8 +181,8 @@ M: stack-display tool-scroller
|
||||||
|
|
||||||
listener-gadget "toolbar" f {
|
listener-gadget "toolbar" f {
|
||||||
{ f restart-listener }
|
{ f restart-listener }
|
||||||
{ T{ key-down f f "CLEAR" } clear-output }
|
{ T{ key-down f { A+ } "c" } clear-output }
|
||||||
{ T{ key-down f { C+ } "CLEAR" } clear-stack }
|
{ T{ key-down f { A+ } "C" } clear-stack }
|
||||||
{ T{ key-down f { C+ } "d" } com-end }
|
{ T{ key-down f { C+ } "d" } com-end }
|
||||||
{ T{ key-down f f "F1" } listener-help }
|
{ T{ key-down f f "F1" } listener-help }
|
||||||
} define-command-map
|
} define-command-map
|
||||||
|
|
|
@ -76,9 +76,11 @@ M: integer user-groups ( id -- seq )
|
||||||
: all-groups ( -- seq )
|
: all-groups ( -- seq )
|
||||||
[ getgrent dup ] [ group-struct>group ] [ drop ] produce ;
|
[ getgrent dup ] [ group-struct>group ] [ drop ] produce ;
|
||||||
|
|
||||||
|
: <group-cache> ( -- assoc )
|
||||||
|
all-groups [ [ id>> ] keep ] H{ } map>assoc ;
|
||||||
|
|
||||||
: with-group-cache ( quot -- )
|
: with-group-cache ( quot -- )
|
||||||
all-groups [ [ id>> ] keep ] H{ } map>assoc
|
[ <group-cache> group-cache ] dip with-variable ; inline
|
||||||
group-cache rot with-variable ; inline
|
|
||||||
|
|
||||||
: real-group-id ( -- id )
|
: real-group-id ( -- id )
|
||||||
getgid ; inline
|
getgid ; inline
|
||||||
|
|
|
@ -41,9 +41,11 @@ PRIVATE>
|
||||||
|
|
||||||
SYMBOL: user-cache
|
SYMBOL: user-cache
|
||||||
|
|
||||||
|
: <user-cache> ( -- assoc )
|
||||||
|
all-users [ [ uid>> ] keep ] H{ } map>assoc ;
|
||||||
|
|
||||||
: with-user-cache ( quot -- )
|
: with-user-cache ( quot -- )
|
||||||
all-users [ [ uid>> ] keep ] H{ } map>assoc
|
[ <user-cache> user-cache ] dip with-variable ; inline
|
||||||
user-cache rot with-variable ; inline
|
|
||||||
|
|
||||||
GENERIC: user-passwd ( obj -- passwd )
|
GENERIC: user-passwd ( obj -- passwd )
|
||||||
|
|
||||||
|
|
|
@ -52,3 +52,5 @@ namespaces assocs ;
|
||||||
[ "4561_2612_1234_5467" v-credit-card ] must-fail
|
[ "4561_2612_1234_5467" v-credit-card ] must-fail
|
||||||
|
|
||||||
[ "4561-2621-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
|
||||||
|
|
|
@ -62,9 +62,7 @@ IN: validators
|
||||||
v-regexp ;
|
v-regexp ;
|
||||||
|
|
||||||
: v-url ( str -- str )
|
: v-url ( str -- str )
|
||||||
"URL"
|
"URL" R' (ftp|http|https)://\S+' v-regexp ;
|
||||||
R' (ftp|http|https)://(\w+:?\w*@)?(\S+)(:[0-9]+)?(/|/([\w#!:.?+=&%@!\-/]))?'
|
|
||||||
v-regexp ;
|
|
||||||
|
|
||||||
: v-captcha ( str -- str )
|
: v-captcha ( str -- str )
|
||||||
dup empty? [ "must remain blank" throw ] unless ;
|
dup empty? [ "must remain blank" throw ] unless ;
|
||||||
|
|
|
@ -1,4 +1,2 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
com
|
|
||||||
bindings
|
bindings
|
||||||
|
|
|
@ -1,4 +1,2 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
com
|
|
||||||
bindings
|
bindings
|
||||||
|
|
|
@ -1,4 +1,2 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
com
|
|
||||||
bindings
|
bindings
|
||||||
|
|
|
@ -1,3 +1,2 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
bindings
|
bindings
|
||||||
|
|
|
@ -199,11 +199,11 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
|
||||||
: THREAD_PRIORITY_TIME_CRITICAL 15 ; inline
|
: THREAD_PRIORITY_TIME_CRITICAL 15 ; inline
|
||||||
|
|
||||||
C-STRUCT: OVERLAPPED
|
C-STRUCT: OVERLAPPED
|
||||||
{ "int" "internal" }
|
{ "UINT_PTR" "internal" }
|
||||||
{ "int" "internal-high" }
|
{ "UINT_PTR" "internal-high" }
|
||||||
{ "int" "offset" }
|
{ "DWORD" "offset" }
|
||||||
{ "int" "offset-high" }
|
{ "DWORD" "offset-high" }
|
||||||
{ "void*" "event" } ;
|
{ "HANDLE" "event" } ;
|
||||||
|
|
||||||
C-STRUCT: SYSTEMTIME
|
C-STRUCT: SYSTEMTIME
|
||||||
{ "WORD" "wYear" }
|
{ "WORD" "wYear" }
|
||||||
|
|
|
@ -1,3 +1,2 @@
|
||||||
unportable
|
unportable
|
||||||
windows
|
|
||||||
bindings
|
bindings
|
||||||
|
|
|
@ -40,10 +40,11 @@ TYPEDEF: void* LPVOID
|
||||||
TYPEDEF: void* LPCVOID
|
TYPEDEF: void* LPCVOID
|
||||||
|
|
||||||
TYPEDEF: float FLOAT
|
TYPEDEF: float FLOAT
|
||||||
TYPEDEF: short HALF_PTR
|
|
||||||
TYPEDEF: ushort UHALF_PTR
|
TYPEDEF: intptr_t HALF_PTR
|
||||||
TYPEDEF: int INT_PTR
|
TYPEDEF: intptr_t UHALF_PTR
|
||||||
TYPEDEF: uint UINT_PTR
|
TYPEDEF: intptr_t INT_PTR
|
||||||
|
TYPEDEF: intptr_t UINT_PTR
|
||||||
|
|
||||||
TYPEDEF: int LONG_PTR
|
TYPEDEF: int LONG_PTR
|
||||||
TYPEDEF: ulong ULONG_PTR
|
TYPEDEF: ulong ULONG_PTR
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
IN: compiler.errors
|
IN: compiler.errors
|
||||||
USING: help.markup help.syntax vocabs.loader words io
|
USING: help.markup help.syntax vocabs.loader words io
|
||||||
quotations compiler.errors.private ;
|
quotations ;
|
||||||
|
|
||||||
ARTICLE: "compiler-errors" "Compiler warnings and errors"
|
ARTICLE: "compiler-errors" "Compiler warnings and errors"
|
||||||
"The compiler saves various notifications in a global variable:"
|
"The compiler saves various notifications in a global variable:"
|
||||||
|
|
|
@ -14,8 +14,6 @@ M: object compiler-error-type drop +error+ ;
|
||||||
|
|
||||||
GENERIC# compiler-error. 1 ( error word -- )
|
GENERIC# compiler-error. 1 ( error word -- )
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
|
|
||||||
SYMBOL: compiler-errors
|
SYMBOL: compiler-errors
|
||||||
|
|
||||||
SYMBOL: with-compiler-errors?
|
SYMBOL: with-compiler-errors?
|
||||||
|
@ -47,8 +45,6 @@ SYMBOL: with-compiler-errors?
|
||||||
"semantic warnings" +warning+ "warnings" (compiler-report)
|
"semantic warnings" +warning+ "warnings" (compiler-report)
|
||||||
"linkage errors" +linkage+ "linkage" (compiler-report) ;
|
"linkage errors" +linkage+ "linkage" (compiler-report) ;
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
: :errors ( -- ) +error+ compiler-errors. ;
|
: :errors ( -- ) +error+ compiler-errors. ;
|
||||||
|
|
||||||
: :warnings ( -- ) +warning+ compiler-errors. ;
|
: :warnings ( -- ) +warning+ compiler-errors. ;
|
||||||
|
|
|
@ -25,6 +25,11 @@ IN: io.tests
|
||||||
! Make sure we use correct to_c_string form when writing
|
! Make sure we use correct to_c_string form when writing
|
||||||
[ ] [ "\0" write ] unit-test
|
[ ] [ "\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 }
|
{ "It seems " CHAR: J }
|
||||||
|
@ -33,7 +38,7 @@ IN: io.tests
|
||||||
}
|
}
|
||||||
] [
|
] [
|
||||||
[
|
[
|
||||||
"resource:core/io/test/separator-test.txt"
|
"separator-test.txt" temp-file
|
||||||
latin1 <file-reader> [
|
latin1 <file-reader> [
|
||||||
"J" read-until 2array ,
|
"J" read-until 2array ,
|
||||||
"i" read-until 2array ,
|
"i" read-until 2array ,
|
||||||
|
|
|
@ -26,12 +26,12 @@ M: null-encoding decode-char drop stream-read1 ;
|
||||||
: map-last ( seq quot -- seq )
|
: map-last ( seq quot -- seq )
|
||||||
>r dup length <reversed> [ zero? ] r> compose 2map ; inline
|
>r dup length <reversed> [ zero? ] r> compose 2map ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: format-table ( table -- seq )
|
: format-table ( table -- seq )
|
||||||
flip [ format-column ] map-last
|
flip [ format-column ] map-last
|
||||||
flip [ " " join ] map ;
|
flip [ " " join ] map ;
|
||||||
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
M: growable dispose drop ;
|
M: growable dispose drop ;
|
||||||
|
|
||||||
M: growable stream-write1 push ;
|
M: growable stream-write1 push ;
|
||||||
|
|
|
@ -1 +0,0 @@
|
||||||
It seems Jobs has lost his grasp on reality again.
|
|
|
@ -11,7 +11,7 @@ ARTICLE: "vocabs.roots" "Vocabulary roots"
|
||||||
{ { $snippet "extra" } " - additional contributed libraries." }
|
{ { $snippet "extra" } " - additional contributed libraries." }
|
||||||
{ { $snippet "work" } " - a root for vocabularies which are not intended to be contributed back to Factor." }
|
{ { $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
|
{ $code
|
||||||
"USING: namespaces sequences vocabs.loader ;"
|
"USING: namespaces sequences vocabs.loader ;"
|
||||||
"\"/home/jane/sources/\" vocab-roots get push"
|
"\"/home/jane/sources/\" vocab-roots get push"
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
! Unit tests for vocabs.loader vocabulary
|
|
||||||
IN: vocabs.loader.tests
|
IN: vocabs.loader.tests
|
||||||
USING: vocabs.loader tools.test continuations vocabs math
|
USING: vocabs.loader tools.test continuations vocabs math
|
||||||
kernel arrays sequences namespaces io.streams.string
|
kernel arrays sequences namespaces io.streams.string
|
||||||
parser source-files words assocs classes.tuple definitions
|
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...
|
! This vocab should not exist, but just in case...
|
||||||
[ ] [
|
[ ] [
|
||||||
|
@ -151,3 +151,8 @@ forget-junk
|
||||||
[ "xabbabbja" forget-vocab ] with-compilation-unit
|
[ "xabbabbja" forget-vocab ] with-compilation-unit
|
||||||
|
|
||||||
forget-junk
|
forget-junk
|
||||||
|
|
||||||
|
[ ] [ [ "vocabs.loader.test.e" forget-vocab ] with-compilation-unit ] unit-test
|
||||||
|
|
||||||
|
[ "vocabs.loader.test.e" require ]
|
||||||
|
[ relative-overflow? ] must-fail-with
|
||||||
|
|
|
@ -55,7 +55,7 @@ SYMBOL: load-help?
|
||||||
f over set-vocab-source-loaded?
|
f over set-vocab-source-loaded?
|
||||||
[ vocab-source-path [ parse-file ] [ [ ] ] if* ] keep
|
[ vocab-source-path [ parse-file ] [ [ ] ] if* ] keep
|
||||||
t swap set-vocab-source-loaded?
|
t swap set-vocab-source-loaded?
|
||||||
[ % ] [ call ] if-bootstrapping ;
|
[ % ] [ assert-depth ] if-bootstrapping ;
|
||||||
|
|
||||||
: load-docs ( vocab -- vocab )
|
: load-docs ( vocab -- vocab )
|
||||||
load-help? get [
|
load-help? get [
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
1 2 3
|
|
@ -0,0 +1 @@
|
||||||
|
unportable
|
|
@ -13,19 +13,19 @@ VAR: rule VAR: rule-number
|
||||||
: init-rule ( -- ) 8 <hashtable> >rule ;
|
: init-rule ( -- ) 8 <hashtable> >rule ;
|
||||||
|
|
||||||
: rule-keys ( -- array )
|
: rule-keys ( -- array )
|
||||||
{ { 1 1 1 }
|
{ { 1 1 1 }
|
||||||
{ 1 1 0 }
|
{ 1 1 0 }
|
||||||
{ 1 0 1 }
|
{ 1 0 1 }
|
||||||
{ 1 0 0 }
|
{ 1 0 0 }
|
||||||
{ 0 1 1 }
|
{ 0 1 1 }
|
||||||
{ 0 1 0 }
|
{ 0 1 0 }
|
||||||
{ 0 0 1 }
|
{ 0 0 1 }
|
||||||
{ 0 0 0 } } ;
|
{ 0 0 0 } } ;
|
||||||
|
|
||||||
: rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-left string>digits ;
|
: rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-left string>digits ;
|
||||||
|
|
||||||
: set-rule ( n -- )
|
: 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
|
! 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 ;
|
: cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ;
|
||||||
|
|
||||||
: wrap-line ( a-line-z -- za-line-za )
|
: 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 <clumps> [ pattern>state ] map ;
|
: step-line ( line -- new-line ) 3 <clumps> [ pattern>state ] map ;
|
||||||
|
|
||||||
|
@ -61,8 +61,8 @@ VARS: width height ;
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: interesting ( -- seq )
|
: interesting ( -- seq )
|
||||||
{ 18 22 26 30 41 45 54 60 73 75 82 86 89 90 97 101 102 105 106 107 109
|
{ 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 } ;
|
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 } ;
|
: mild ( -- seq ) { 6 9 11 57 62 74 118 } ;
|
||||||
|
|
||||||
|
@ -75,7 +75,7 @@ VAR: bitmap
|
||||||
VAR: last-line
|
VAR: last-line
|
||||||
|
|
||||||
: run-rule ( -- )
|
: 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 ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -39,10 +39,10 @@ VAR: slate
|
||||||
! Call a 'model' quotation with the current 'view'.
|
! Call a 'model' quotation with the current 'view'.
|
||||||
|
|
||||||
: with-view ( quot -- )
|
: with-view ( quot -- )
|
||||||
slate> rect-dim first >width
|
slate> rect-dim first >width
|
||||||
slate> rect-dim second >height
|
slate> rect-dim second >height
|
||||||
call
|
call
|
||||||
slate> relayout-1 ;
|
slate> relayout-1 ;
|
||||||
|
|
||||||
! Create a quotation that is appropriate for buttons and gesture handler.
|
! Create a quotation that is appropriate for buttons and gesture handler.
|
||||||
|
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
USING: benchmark.regex-dna io io.files io.encodings.ascii
|
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
|
IN: benchmark.regex-dna.tests
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt"
|
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt"
|
||||||
[ regex-dna ] with-string-writer
|
[ regex-dna ] with-string-writer <string-reader> lines
|
||||||
"resource:extra/benchmark/regex-dna/regex-dna-test-out.txt"
|
"resource:extra/benchmark/regex-dna/regex-dna-test-out.txt"
|
||||||
ascii file-contents =
|
ascii file-lines =
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -43,19 +43,19 @@ VAR: separation-radius
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
: init-variables ( -- )
|
: init-variables ( -- )
|
||||||
1.0 >cohesion-weight
|
1.0 >cohesion-weight
|
||||||
1.0 >alignment-weight
|
1.0 >alignment-weight
|
||||||
1.0 >separation-weight
|
1.0 >separation-weight
|
||||||
|
|
||||||
75 >cohesion-radius
|
75 >cohesion-radius
|
||||||
50 >alignment-radius
|
50 >alignment-radius
|
||||||
25 >separation-radius
|
25 >separation-radius
|
||||||
|
|
||||||
180 >cohesion-view-angle
|
180 >cohesion-view-angle
|
||||||
180 >alignment-view-angle
|
180 >alignment-view-angle
|
||||||
180 >separation-view-angle
|
180 >separation-view-angle
|
||||||
|
|
||||||
10 >time-slice ;
|
10 >time-slice ;
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
! random-boid and random-boids
|
! random-boid and random-boids
|
||||||
|
@ -76,14 +76,14 @@ VAR: separation-radius
|
||||||
: constrain ( n a b -- n ) rot min max ;
|
: constrain ( n a b -- n ) rot min max ;
|
||||||
|
|
||||||
: angle-between ( vec vec -- angle )
|
: 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-position ( self other -- v ) swap [ pos>> ] bi@ v- ;
|
||||||
|
|
||||||
: relative-angle ( self other -- angle )
|
: 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 > ;
|
: above? ( n a b -- ? ) nip > ;
|
||||||
|
|
||||||
: wrap ( n a b -- n )
|
: wrap ( n a b -- n )
|
||||||
{ { [ 3dup below? ]
|
{
|
||||||
[ 2nip ] }
|
{ [ 3dup below? ] [ 2nip ] }
|
||||||
{ [ 3dup above? ]
|
{ [ 3dup above? ] [ drop nip ] }
|
||||||
[ drop nip ] }
|
{ [ t ] [ 2drop ] }
|
||||||
{ [ t ]
|
}
|
||||||
[ 2drop ] } }
|
cond ;
|
||||||
cond ;
|
|
||||||
|
|
||||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
|
USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
|
||||||
mortar random-weighted cfdg ;
|
random-weighted cfdg ;
|
||||||
|
|
||||||
IN: cfdg.models.game1-turn6
|
IN: cfdg.models.game1-turn6
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
|
USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate
|
||||||
mortar random-weighted cfdg ;
|
random-weighted cfdg ;
|
||||||
|
|
||||||
IN: cfdg.models.sierpinski
|
IN: cfdg.models.sierpinski
|
||||||
|
|
||||||
|
|
|
@ -7,7 +7,7 @@ IN: contributors
|
||||||
|
|
||||||
: changelog ( -- authors )
|
: changelog ( -- authors )
|
||||||
image parent-directory [
|
image parent-directory [
|
||||||
"git-log --pretty=format:%an" ascii <process-reader> lines
|
"git log --pretty=format:%an" ascii <process-reader> lines
|
||||||
] with-directory ;
|
] with-directory ;
|
||||||
|
|
||||||
: patch-counts ( authors -- assoc )
|
: patch-counts ( authors -- assoc )
|
||||||
|
|
|
@ -7,10 +7,11 @@ namespaces make sequences ftp io.unix.launcher.parser
|
||||||
unicode.case splitting assocs classes io.servers.connection
|
unicode.case splitting assocs classes io.servers.connection
|
||||||
destructors calendar io.timeouts io.streams.duplex threads
|
destructors calendar io.timeouts io.streams.duplex threads
|
||||||
continuations math concurrency.promises byte-arrays
|
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
|
IN: ftp.server
|
||||||
|
|
||||||
TUPLE: ftp-client url mode state command-promise ;
|
TUPLE: ftp-client url mode state command-promise user password ;
|
||||||
|
|
||||||
: <ftp-client> ( url -- ftp-client )
|
: <ftp-client> ( url -- ftp-client )
|
||||||
ftp-client new
|
ftp-client new
|
||||||
|
@ -140,16 +141,16 @@ ERROR: type-error type ;
|
||||||
150 "Here comes the directory listing." server-response ;
|
150 "Here comes the directory listing." server-response ;
|
||||||
|
|
||||||
: finish-directory ( -- )
|
: finish-directory ( -- )
|
||||||
226 "Opening " server-response ;
|
226 "Directory send OK." server-response ;
|
||||||
|
|
||||||
GENERIC: service-command ( stream obj -- )
|
GENERIC: service-command ( stream obj -- )
|
||||||
|
|
||||||
M: ftp-list service-command ( stream obj -- )
|
M: ftp-list service-command ( stream obj -- )
|
||||||
drop
|
drop
|
||||||
start-directory
|
start-directory [
|
||||||
[
|
|
||||||
utf8 encode-output
|
utf8 encode-output
|
||||||
directory. [ ftp-send ] each
|
[ current-directory get directory. ] with-string-writer string-lines
|
||||||
|
harvest [ ftp-send ] each
|
||||||
] with-output-stream
|
] with-output-stream
|
||||||
finish-directory ;
|
finish-directory ;
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
|
@ -0,0 +1 @@
|
||||||
|
Slides from a talk at Galois by Slava Pestov, October 2008
|
|
@ -0,0 +1 @@
|
||||||
|
demos
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue