Merge branch 'master' of git://factorcode.org/git/factor
Aaron Schaefer
commit
a1a79aac16
|
|
@ -436,6 +436,6 @@ M: long-long-type box-return ( type -- )
|
|||
"double" define-primitive-type
|
||||
|
||||
"long" "ptrdiff_t" typedef
|
||||
|
||||
"long" "intptr_t" typedef
|
||||
"ulong" "size_t" typedef
|
||||
] with-compilation-unit
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: http.client checksums checksums.openssl splitting assocs
|
||||
USING: http.client checksums checksums.md5 splitting assocs
|
||||
kernel io.files bootstrap.image sequences io urls ;
|
||||
IN: bootstrap.image.download
|
||||
|
||||
|
|
@ -13,7 +13,7 @@ IN: bootstrap.image.download
|
|||
: need-new-image? ( image -- ? )
|
||||
dup exists?
|
||||
[
|
||||
[ openssl-md5 checksum-file hex-string ]
|
||||
[ md5 checksum-file hex-string ]
|
||||
[ download-checksums at ]
|
||||
bi = not
|
||||
] [ drop t ] if ;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ HELP: enable-compiler
|
|||
{ $description "Enables the optimizing compiler." } ;
|
||||
|
||||
HELP: disable-compiler
|
||||
{ $description "Enables the optimizing compiler." } ;
|
||||
{ $description "Disable the optimizing compiler." } ;
|
||||
|
||||
ARTICLE: "compiler-usage" "Calling the optimizing compiler"
|
||||
"Normally, new word definitions are recompiled automatically. This can be changed:"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel layouts system math alien.c-types
|
||||
USING: kernel layouts system math alien.c-types sequences
|
||||
compiler.cfg.registers cpu.architecture cpu.x86.assembler cpu.x86 ;
|
||||
IN: cpu.x86.64.winnt
|
||||
|
||||
|
|
@ -22,6 +22,7 @@ M: x86.64 dummy-fp-params? t ;
|
|||
|
||||
<<
|
||||
"longlong" "ptrdiff_t" typedef
|
||||
"longlong" "intptr_t" typedef
|
||||
"int" "long" typedef
|
||||
"uint" "ulong" typedef
|
||||
>>
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ C-STRUCT: glyph
|
|||
{ "FT_Pos" "advance-x" }
|
||||
{ "FT_Pos" "advance-y" }
|
||||
|
||||
{ "long" "format" }
|
||||
{ "intptr_t" "format" }
|
||||
|
||||
{ "int" "bitmap-rows" }
|
||||
{ "int" "bitmap-width" }
|
||||
|
|
|
|||
|
|
@ -97,7 +97,7 @@ HELP: with-exit-continuation
|
|||
{ $notes "Furnace actions and authentication realms wrap their execution in this combinator, allowing form validation failures and login requests, respectively, to immediately return an HTTP response to the client without running any more responder code." } ;
|
||||
|
||||
ARTICLE: "furnace.extension-points" "Furnace extension points"
|
||||
"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the setateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used."
|
||||
"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the stateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used."
|
||||
$nl
|
||||
"Responders can implement methods on the following generic words:"
|
||||
{ $subsection modify-query }
|
||||
|
|
|
|||
|
|
@ -115,10 +115,10 @@ M: result link-href href>> ;
|
|||
[ [ title>> ] compare ] sort ;
|
||||
|
||||
: article-apropos ( string -- results )
|
||||
"articles.idx" temp-file offline-apropos ;
|
||||
"articles.idx" offline-apropos ;
|
||||
|
||||
: word-apropos ( string -- results )
|
||||
"words.idx" temp-file offline-apropos ;
|
||||
"words.idx" offline-apropos ;
|
||||
|
||||
: vocab-apropos ( string -- results )
|
||||
"vocabs.idx" temp-file offline-apropos ;
|
||||
"vocabs.idx" offline-apropos ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: io io.files io.streams.string io.encodings.utf8
|
||||
html.templates html.templates.fhtml kernel
|
||||
tools.test sequences parser ;
|
||||
tools.test sequences parser splitting prettyprint ;
|
||||
IN: html.templates.fhtml.tests
|
||||
|
||||
: test-template ( path -- ? )
|
||||
|
|
@ -8,8 +8,10 @@ IN: html.templates.fhtml.tests
|
|||
prepend
|
||||
[
|
||||
".fhtml" append <fhtml> [ call-template ] with-string-writer
|
||||
<string-reader> lines
|
||||
] keep
|
||||
".html" append utf8 file-contents = ;
|
||||
".html" append utf8 file-lines
|
||||
[ . . ] [ = ] 2bi ;
|
||||
|
||||
[ t ] [ "example" test-template ] unit-test
|
||||
[ t ] [ "bug" test-template ] unit-test
|
||||
|
|
|
|||
|
|
@ -3,4 +3,6 @@
|
|||
USING: tools.test io.files.listing strings kernel ;
|
||||
IN: io.files.listing.tests
|
||||
|
||||
\ directory. must-infer
|
||||
|
||||
[ ] [ "" directory. ] unit-test
|
||||
|
|
|
|||
|
|
@ -114,19 +114,29 @@ M: threaded-server handle-client* handler>> call ;
|
|||
] when*
|
||||
] unless ;
|
||||
|
||||
: (start-server) ( threaded-server -- )
|
||||
init-server
|
||||
dup threaded-server [
|
||||
dup name>> [
|
||||
[ listen-on [ start-accept-loop ] parallel-each ]
|
||||
[ ready>> raise-flag ]
|
||||
bi
|
||||
] with-logging
|
||||
] with-variable ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: start-server ( threaded-server -- )
|
||||
init-server
|
||||
dup secure-config>> [
|
||||
dup threaded-server [
|
||||
dup name>> [
|
||||
[ listen-on [ start-accept-loop ] parallel-each ]
|
||||
[ ready>> raise-flag ]
|
||||
bi
|
||||
] with-logging
|
||||
] with-variable
|
||||
] with-secure-context ;
|
||||
#! Only create a secure-context if we want to listen on
|
||||
#! a secure port, otherwise start-server won't work at
|
||||
#! all if SSL is not available.
|
||||
dup secure>> [
|
||||
dup secure-config>> [
|
||||
(start-server)
|
||||
] with-secure-context
|
||||
] [
|
||||
(start-server)
|
||||
] if ;
|
||||
|
||||
: wait-for-server ( threaded-server -- )
|
||||
ready>> wait-for-flag ;
|
||||
|
|
|
|||
|
|
@ -1,157 +1,157 @@
|
|||
USING: io.launcher tools.test calendar accessors environment
|
||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||
sequences parser assocs hashtables math continuations eval ;
|
||||
IN: io.windows.launcher.nt.tests
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
"notepad" >>command
|
||||
1/2 seconds >>timeout
|
||||
"notepad" set
|
||||
] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-started? ] unit-test
|
||||
|
||||
[ ] [ "notepad" [ run-detached ] change ] unit-test
|
||||
|
||||
[ "notepad" get wait-for-process ] must-fail
|
||||
|
||||
[ t ] [ "notepad" get killed>> ] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-quiet" "-run=hello-world" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ "Hello world" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-run=listener" 2array >>command
|
||||
+closed+ >>stdin
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
"err.txt" temp-file >>stderr
|
||||
try-process
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ "error" ] [
|
||||
"err.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
+stdout+ >>stderr
|
||||
try-process
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "outputerror" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"err2.txt" temp-file >>stderr
|
||||
ascii <process-reader> lines first
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "error" ] [
|
||||
"err2.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
os-envs =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
+replace-environment+ >>environment-mode
|
||||
os-envs >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
os-envs =
|
||||
] unit-test
|
||||
|
||||
[ "B" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "A" "B" } } >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
"A" swap at
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "HOME" "XXX" } } >>environment
|
||||
+prepend-environment+ >>environment-mode
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
"HOME" swap at "XXX" =
|
||||
] unit-test
|
||||
|
||||
2 [
|
||||
[ ] [
|
||||
<process>
|
||||
"cmd.exe /c dir" >>command
|
||||
"dir.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ ] [ "dir.txt" temp-file delete-file ] unit-test
|
||||
] times
|
||||
|
||||
[ "append-test" temp-file delete-file ] ignore-errors
|
||||
|
||||
[ "Hello appender\r\nHello appender\r\n" ] [
|
||||
2 [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "append.factor" 3array >>command
|
||||
"append-test" temp-file <appender> >>stdout
|
||||
try-process
|
||||
] with-directory
|
||||
] times
|
||||
|
||||
"append-test" temp-file ascii file-contents
|
||||
] unit-test
|
||||
USING: io.launcher tools.test calendar accessors environment
|
||||
namespaces kernel system arrays io io.files io.encodings.ascii
|
||||
sequences parser assocs hashtables math continuations eval ;
|
||||
IN: io.windows.launcher.nt.tests
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
"notepad" >>command
|
||||
1/2 seconds >>timeout
|
||||
"notepad" set
|
||||
] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-started? ] unit-test
|
||||
|
||||
[ ] [ "notepad" [ run-detached ] change ] unit-test
|
||||
|
||||
[ "notepad" get wait-for-process ] must-fail
|
||||
|
||||
[ t ] [ "notepad" get killed>> ] unit-test
|
||||
|
||||
[ f ] [ "notepad" get process-running? ] unit-test
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-quiet" "-run=hello-world" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ "Hello world" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
<process>
|
||||
vm "-run=listener" 2array >>command
|
||||
+closed+ >>stdin
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
"err.txt" temp-file >>stderr
|
||||
try-process
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ "error" ] [
|
||||
"err.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"out.txt" temp-file >>stdout
|
||||
+stdout+ >>stderr
|
||||
try-process
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "outputerror" ] [
|
||||
"out.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ "output" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "stderr.factor" 3array >>command
|
||||
"err2.txt" temp-file >>stderr
|
||||
ascii <process-reader> lines first
|
||||
] with-directory
|
||||
] unit-test
|
||||
|
||||
[ "error" ] [
|
||||
"err2.txt" temp-file ascii file-lines first
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
os-envs =
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
+replace-environment+ >>environment-mode
|
||||
os-envs >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
os-envs =
|
||||
] unit-test
|
||||
|
||||
[ "B" ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "A" "B" } } >>environment
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
"A" swap at
|
||||
] unit-test
|
||||
|
||||
[ f ] [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "env.factor" 3array >>command
|
||||
{ { "USERPROFILE" "XXX" } } >>environment
|
||||
+prepend-environment+ >>environment-mode
|
||||
ascii <process-reader> contents
|
||||
] with-directory eval
|
||||
|
||||
"USERPROFILE" swap at "XXX" =
|
||||
] unit-test
|
||||
|
||||
2 [
|
||||
[ ] [
|
||||
<process>
|
||||
"cmd.exe /c dir" >>command
|
||||
"dir.txt" temp-file >>stdout
|
||||
try-process
|
||||
] unit-test
|
||||
|
||||
[ ] [ "dir.txt" temp-file delete-file ] unit-test
|
||||
] times
|
||||
|
||||
[ "append-test" temp-file delete-file ] ignore-errors
|
||||
|
||||
[ "Hello appender\r\nHello appender\r\n" ] [
|
||||
2 [
|
||||
"resource:basis/io/windows/nt/launcher/test" [
|
||||
<process>
|
||||
vm "-script" "append.factor" 3array >>command
|
||||
"append-test" temp-file <appender> >>stdout
|
||||
try-process
|
||||
] with-directory
|
||||
] times
|
||||
|
||||
"append-test" temp-file ascii file-contents
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -346,7 +346,6 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
|
||||
{ 3 1 } [| from to seq | T{ slice f from to seq } ] must-infer-as
|
||||
|
||||
|
||||
:: literal-identity-test ( -- a b )
|
||||
{ } V{ } ;
|
||||
|
||||
|
|
@ -356,6 +355,10 @@ M:: sequence method-with-locals ( a -- y ) a reverse ;
|
|||
swapd [ eq? ] [ eq? ] 2bi*
|
||||
] unit-test
|
||||
|
||||
:: mutable-local-in-literal-test ( a! -- b ) a 1 + a! { a } ;
|
||||
|
||||
[ { 4 } ] [ 3 mutable-local-in-literal-test ] unit-test
|
||||
|
||||
:: compare-case ( obj1 obj2 lt-quot eq-quot gt-quot -- )
|
||||
obj1 obj2 <=> {
|
||||
{ +lt+ [ lt-quot call ] }
|
||||
|
|
|
|||
|
|
@ -229,6 +229,8 @@ M: tuple rewrite-element
|
|||
|
||||
M: local rewrite-element , ;
|
||||
|
||||
M: local-reader rewrite-element , ;
|
||||
|
||||
M: word rewrite-element literalize , ;
|
||||
|
||||
M: object rewrite-element , ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math math.functions sequences
|
||||
sequences.private words namespaces macros hints
|
||||
combinators fry ;
|
||||
combinators fry io.binary ;
|
||||
IN: math.bitwise
|
||||
|
||||
! utilities
|
||||
|
|
@ -93,3 +93,11 @@ PRIVATE>
|
|||
|
||||
: bit-count ( x -- n )
|
||||
dup 0 < [ bitnot ] when (bit-count) ; inline
|
||||
|
||||
! Signed byte array to integer conversion
|
||||
: signed-le> ( bytes -- x )
|
||||
[ le> ] [ length 8 * 1- on-bits ] bi
|
||||
2dup > [ bitnot bitor ] [ drop ] if ;
|
||||
|
||||
: signed-be> ( bytes -- x )
|
||||
<reversed> signed-le> ;
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ HELP: ptrim
|
|||
HELP: 2ptrim
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } }
|
||||
{ $description "Trims excess zeros from two polynomials." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim swap . ." "{ 0 1 }\n{ 1 }" } } ;
|
||||
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 0 1 0 0 } { 1 0 0 } 2ptrim [ . ] bi@" "{ 0 1 }\n{ 1 }" } } ;
|
||||
|
||||
HELP: p+
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } }
|
||||
|
|
@ -60,7 +60,7 @@ HELP: n*p
|
|||
HELP: pextend-conv
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "p" "a polynomial" } { "q" "a polynomial" } }
|
||||
{ $description "Convulution, extending to " { $snippet "p_m + q_n - 1" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv swap . ." "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ;
|
||||
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 0 1 } { 0 1 } pextend-conv [ . ] bi@" "V{ 1 0 1 0 }\nV{ 0 1 0 0 }" } } ;
|
||||
|
||||
HELP: p*
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "r" "a polynomial" } }
|
||||
|
|
@ -75,13 +75,18 @@ HELP: p-sq
|
|||
HELP: p/mod
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "z" "a polynomial" } { "w" "a polynomial" } }
|
||||
{ $description "Computes to quotient " { $snippet "z" } " and remainder " { $snippet "w" } " of dividing " { $snippet "p" } " by " { $snippet "q" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod swap . ." "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ;
|
||||
{ $examples { $example "USING: kernel math.polynomials prettyprint ;" "{ 1 1 1 1 } { 3 1 } p/mod [ . ] bi@" "V{ 7 -2 1 }\nV{ -20 0 0 }" } } ;
|
||||
|
||||
HELP: pgcd
|
||||
{ $values { "p" "a polynomial" } { "q" "a polynomial" } { "a" "a polynomial" } { "d" "a polynomial" } }
|
||||
{ $description "Computes the greatest common divisor " { $snippet "d" } " of " { $snippet "p" } " and " { $snippet "q" } ", and another value " { $snippet "a" } " satisfying:" { $code "a*q = d mod p" } }
|
||||
{ $notes "GCD in the case of polynomials is a monic polynomial of the highest possible degree that divides into both " { $snippet "p" } " and " { $snippet "q" } "." }
|
||||
{ $examples { $example "USING: math.polynomials prettyprint ;" "{ 1 1 1 1} { 1 1 } pgcd swap . ." "{ 0 0 }\n{ 1 1 }" } } ;
|
||||
{ $examples
|
||||
{ $example "USING: kernel math.polynomials prettyprint ;"
|
||||
"{ 1 1 1 1 } { 1 1 } pgcd [ . ] bi@"
|
||||
"{ 0 0 }\n{ 1 1 }"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: pdiff
|
||||
{ $values { "p" "a polynomial" } { "p'" "a polynomial" } }
|
||||
|
|
|
|||
|
|
@ -64,7 +64,8 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
|||
[ 2 GL_FLOAT 0 ] dip glTexCoordPointer ; inline
|
||||
|
||||
: line-vertices ( a b -- )
|
||||
append >c-float-array gl-vertex-pointer ;
|
||||
[ first2 [ 0.5 + ] bi@ ] bi@ 4 narray
|
||||
>c-float-array gl-vertex-pointer ;
|
||||
|
||||
: gl-line ( a b -- )
|
||||
line-vertices GL_LINES 0 2 glDrawArrays ;
|
||||
|
|
@ -72,9 +73,9 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
|||
: (rect-vertices) ( dim -- vertices )
|
||||
{
|
||||
[ drop 0.5 0.5 ]
|
||||
[ first 0.5 - 0.5 ]
|
||||
[ [ first 0.5 - ] [ second 0.5 - ] bi ]
|
||||
[ second 0.5 - 0.5 swap ]
|
||||
[ first 0.3 - 0.5 ]
|
||||
[ [ first 0.3 - ] [ second 0.3 - ] bi ]
|
||||
[ second 0.3 - 0.5 swap ]
|
||||
} cleave 8 narray >c-float-array ;
|
||||
|
||||
: rect-vertices ( dim -- )
|
||||
|
|
|
|||
|
|
@ -137,7 +137,7 @@ ERROR: bad-special-group string ;
|
|||
DEFER: (parse-regexp)
|
||||
: nested-parse-regexp ( token ? -- )
|
||||
[ 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
|
||||
: (parse-special-group) ( -- )
|
||||
|
|
|
|||
|
|
@ -2,6 +2,9 @@ USING: regexp tools.test kernel sequences regexp.parser
|
|||
regexp.traversal eval ;
|
||||
IN: regexp-tests
|
||||
|
||||
\ <regexp> must-infer
|
||||
\ matches? must-infer
|
||||
|
||||
[ f ] [ "b" "a*" <regexp> matches? ] unit-test
|
||||
[ t ] [ "" "a*" <regexp> matches? ] unit-test
|
||||
[ t ] [ "a" "a*" <regexp> matches? ] unit-test
|
||||
|
|
|
|||
|
|
@ -107,7 +107,8 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
|
|||
: increment-state ( dfa-traverser state -- dfa-traverser )
|
||||
[
|
||||
dup traverse-forward>>
|
||||
[ 1+ ] [ 1- ] ? change-current-index
|
||||
[ [ 1+ ] change-current-index ]
|
||||
[ [ 1- ] change-current-index ] if
|
||||
dup current-state>> >>last-state
|
||||
] dip
|
||||
first >>current-state ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
IN: regexp.utils
|
||||
|
||||
: (while-changes) ( obj quot pred pred-ret -- obj )
|
||||
! quot: ( obj -- obj' )
|
||||
! pred: ( obj -- <=> )
|
||||
: (while-changes) ( obj quot: ( obj -- obj' ) pred: ( obj -- <=> ) pred-ret -- obj )
|
||||
[ [ dup slip ] dip pick over call ] dip dupd =
|
||||
[ 3drop ] [ (while-changes) ] if ; inline recursive
|
||||
|
||||
|
|
|
|||
|
|
@ -111,8 +111,8 @@ TUPLE: checkmark-paint < caching-pen color last-vertices ;
|
|||
|
||||
: checkmark-points ( dim -- points )
|
||||
{
|
||||
[ { 0 0 } v* { 0 1 } v+ ]
|
||||
[ { 1 1 } v* { 0 1 } v+ ]
|
||||
[ { 0 0 } v* ]
|
||||
[ { 1 1 } v* ]
|
||||
[ { 0 1 } v* ]
|
||||
[ { 1 0 } v* ]
|
||||
} cleave 4array ;
|
||||
|
|
|
|||
|
|
@ -112,7 +112,7 @@ M: editor ungraft*
|
|||
line-height * ;
|
||||
|
||||
: caret-loc ( editor -- loc )
|
||||
[ editor-caret* ] keep 2dup loc>x 1+
|
||||
[ editor-caret* ] keep 2dup loc>x
|
||||
rot first rot line>y 2array ;
|
||||
|
||||
: caret-dim ( editor -- dim )
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ M: grid-lines draw-boundary
|
|||
dup grid set
|
||||
dup rect-dim half-gap v- grid-dim set
|
||||
compute-grid
|
||||
[ { 1 0 } draw-grid-lines ]
|
||||
[ { -0.5 -0.5 } gl-translate { 1 0 } draw-grid-lines ]
|
||||
[
|
||||
{ 0.5 -0.5 } gl-translate
|
||||
{ 0 1 } draw-grid-lines
|
||||
|
|
|
|||
|
|
@ -181,8 +181,8 @@ M: stack-display tool-scroller
|
|||
|
||||
listener-gadget "toolbar" f {
|
||||
{ f restart-listener }
|
||||
{ T{ key-down f f "CLEAR" } clear-output }
|
||||
{ T{ key-down f { C+ } "CLEAR" } clear-stack }
|
||||
{ T{ key-down f { A+ } "c" } clear-output }
|
||||
{ T{ key-down f { A+ } "C" } clear-stack }
|
||||
{ T{ key-down f { C+ } "d" } com-end }
|
||||
{ T{ key-down f f "F1" } listener-help }
|
||||
} define-command-map
|
||||
|
|
|
|||
|
|
@ -76,9 +76,11 @@ M: integer user-groups ( id -- seq )
|
|||
: all-groups ( -- seq )
|
||||
[ getgrent dup ] [ group-struct>group ] [ drop ] produce ;
|
||||
|
||||
: <group-cache> ( -- assoc )
|
||||
all-groups [ [ id>> ] keep ] H{ } map>assoc ;
|
||||
|
||||
: with-group-cache ( quot -- )
|
||||
all-groups [ [ id>> ] keep ] H{ } map>assoc
|
||||
group-cache rot with-variable ; inline
|
||||
[ <group-cache> group-cache ] dip with-variable ; inline
|
||||
|
||||
: real-group-id ( -- id )
|
||||
getgid ; inline
|
||||
|
|
|
|||
|
|
@ -41,9 +41,11 @@ PRIVATE>
|
|||
|
||||
SYMBOL: user-cache
|
||||
|
||||
: <user-cache> ( -- assoc )
|
||||
all-users [ [ uid>> ] keep ] H{ } map>assoc ;
|
||||
|
||||
: with-user-cache ( quot -- )
|
||||
all-users [ [ uid>> ] keep ] H{ } map>assoc
|
||||
user-cache rot with-variable ; inline
|
||||
[ <user-cache> user-cache ] dip with-variable ; inline
|
||||
|
||||
GENERIC: user-passwd ( obj -- passwd )
|
||||
|
||||
|
|
|
|||
|
|
@ -199,11 +199,11 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
|
|||
: THREAD_PRIORITY_TIME_CRITICAL 15 ; inline
|
||||
|
||||
C-STRUCT: OVERLAPPED
|
||||
{ "int" "internal" }
|
||||
{ "int" "internal-high" }
|
||||
{ "int" "offset" }
|
||||
{ "int" "offset-high" }
|
||||
{ "void*" "event" } ;
|
||||
{ "UINT_PTR" "internal" }
|
||||
{ "UINT_PTR" "internal-high" }
|
||||
{ "DWORD" "offset" }
|
||||
{ "DWORD" "offset-high" }
|
||||
{ "HANDLE" "event" } ;
|
||||
|
||||
C-STRUCT: SYSTEMTIME
|
||||
{ "WORD" "wYear" }
|
||||
|
|
|
|||
|
|
@ -40,10 +40,11 @@ TYPEDEF: void* LPVOID
|
|||
TYPEDEF: void* LPCVOID
|
||||
|
||||
TYPEDEF: float FLOAT
|
||||
TYPEDEF: short HALF_PTR
|
||||
TYPEDEF: ushort UHALF_PTR
|
||||
TYPEDEF: int INT_PTR
|
||||
TYPEDEF: uint UINT_PTR
|
||||
|
||||
TYPEDEF: intptr_t HALF_PTR
|
||||
TYPEDEF: intptr_t UHALF_PTR
|
||||
TYPEDEF: intptr_t INT_PTR
|
||||
TYPEDEF: intptr_t UINT_PTR
|
||||
|
||||
TYPEDEF: int LONG_PTR
|
||||
TYPEDEF: ulong ULONG_PTR
|
||||
|
|
|
|||
|
|
@ -25,6 +25,11 @@ IN: io.tests
|
|||
! Make sure we use correct to_c_string form when writing
|
||||
[ ] [ "\0" write ] unit-test
|
||||
|
||||
[ ] [
|
||||
"It seems Jobs has lost his grasp on reality again.\n"
|
||||
"separator-test.txt" temp-file latin1 set-file-contents
|
||||
] unit-test
|
||||
|
||||
[
|
||||
{
|
||||
{ "It seems " CHAR: J }
|
||||
|
|
@ -33,7 +38,7 @@ IN: io.tests
|
|||
}
|
||||
] [
|
||||
[
|
||||
"resource:core/io/test/separator-test.txt"
|
||||
"separator-test.txt" temp-file
|
||||
latin1 <file-reader> [
|
||||
"J" read-until 2array ,
|
||||
"i" read-until 2array ,
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
It seems Jobs has lost his grasp on reality again.
|
||||
|
|
@ -1,10 +1,10 @@
|
|||
USING: benchmark.regex-dna io io.files io.encodings.ascii
|
||||
io.streams.string kernel tools.test ;
|
||||
io.streams.string kernel tools.test splitting ;
|
||||
IN: benchmark.regex-dna.tests
|
||||
|
||||
[ t ] [
|
||||
"resource:extra/benchmark/regex-dna/regex-dna-test-in.txt"
|
||||
[ regex-dna ] with-string-writer
|
||||
[ regex-dna ] with-string-writer <string-reader> lines
|
||||
"resource:extra/benchmark/regex-dna/regex-dna-test-out.txt"
|
||||
ascii file-contents =
|
||||
ascii file-lines =
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@ VAR: separation-radius
|
|||
: relative-position ( self other -- v ) swap [ pos>> ] bi@ v- ;
|
||||
|
||||
: relative-angle ( self other -- angle )
|
||||
over vel>> -rot relative-position angle-between ;
|
||||
over vel>> -rot relative-position angle-between ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -189,13 +189,12 @@ boids> [ within-alignment-neighborhood? ] with filter ;
|
|||
: above? ( n a b -- ? ) nip > ;
|
||||
|
||||
: wrap ( n a b -- n )
|
||||
{ { [ 3dup below? ]
|
||||
[ 2nip ] }
|
||||
{ [ 3dup above? ]
|
||||
[ drop nip ] }
|
||||
{ [ t ]
|
||||
[ 2drop ] } }
|
||||
cond ;
|
||||
{
|
||||
{ [ 3dup below? ] [ 2nip ] }
|
||||
{ [ 3dup above? ] [ drop nip ] }
|
||||
{ [ t ] [ 2drop ] }
|
||||
}
|
||||
cond ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@ IN: contributors
|
|||
|
||||
: changelog ( -- authors )
|
||||
image parent-directory [
|
||||
"git-log --pretty=format:%an" ascii <process-reader> lines
|
||||
"git log --pretty=format:%an" ascii <process-reader> lines
|
||||
] with-directory ;
|
||||
|
||||
: patch-counts ( authors -- assoc )
|
||||
|
|
|
|||
|
|
@ -7,10 +7,11 @@ namespaces make sequences ftp io.unix.launcher.parser
|
|||
unicode.case splitting assocs classes io.servers.connection
|
||||
destructors calendar io.timeouts io.streams.duplex threads
|
||||
continuations math concurrency.promises byte-arrays
|
||||
io.backend sequences.lib tools.hexdump io.files.listing ;
|
||||
io.backend sequences.lib tools.hexdump io.files.listing
|
||||
io.streams.string ;
|
||||
IN: ftp.server
|
||||
|
||||
TUPLE: ftp-client url mode state command-promise ;
|
||||
TUPLE: ftp-client url mode state command-promise user password ;
|
||||
|
||||
: <ftp-client> ( url -- ftp-client )
|
||||
ftp-client new
|
||||
|
|
@ -140,16 +141,16 @@ ERROR: type-error type ;
|
|||
150 "Here comes the directory listing." server-response ;
|
||||
|
||||
: finish-directory ( -- )
|
||||
226 "Opening " server-response ;
|
||||
226 "Directory send OK." server-response ;
|
||||
|
||||
GENERIC: service-command ( stream obj -- )
|
||||
|
||||
M: ftp-list service-command ( stream obj -- )
|
||||
drop
|
||||
start-directory
|
||||
[
|
||||
start-directory [
|
||||
utf8 encode-output
|
||||
directory. [ ftp-send ] each
|
||||
[ current-directory get directory. ] with-string-writer string-lines
|
||||
harvest [ ftp-send ] each
|
||||
] with-output-stream
|
||||
finish-directory ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slides from a talk at Galois by Slava Pestov, October 2008
|
||||
|
|
@ -0,0 +1 @@
|
|||
demos
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slides from Google Tech Talk by Slava Pestov, October 2008
|
||||
|
|
@ -0,0 +1 @@
|
|||
demos
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2007 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: alien arrays byte-arrays combinators summary
|
||||
io.backend graphics.viewer io io.binary io.files kernel libc
|
||||
math math.functions namespaces opengl opengl.gl prettyprint
|
||||
sequences strings ui ui.gadgets.panes io.encodings.binary
|
||||
accessors grouping ;
|
||||
USING: alien arrays byte-arrays combinators summary io.backend
|
||||
graphics.viewer io io.binary io.files kernel libc math
|
||||
math.functions math.bitwise namespaces opengl opengl.gl
|
||||
prettyprint sequences strings ui ui.gadgets.panes
|
||||
io.encodings.binary accessors grouping ;
|
||||
IN: graphics.bitmap
|
||||
|
||||
! Currently can only handle 24bit bitmaps.
|
||||
|
|
@ -56,8 +56,8 @@ M: bitmap-magic summary
|
|||
|
||||
: parse-bitmap-header ( bitmap -- )
|
||||
4 read le> >>header-length
|
||||
4 read le> >>width
|
||||
4 read le> >>height
|
||||
4 read signed-le> >>width
|
||||
4 read signed-le> >>height
|
||||
2 read le> >>planes
|
||||
2 read le> >>bit-count
|
||||
4 read le> >>compression
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ IN: hardware-info.windows
|
|||
: processor-architecture ( -- n )
|
||||
system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ;
|
||||
|
||||
: os-version
|
||||
: os-version ( -- os-version )
|
||||
"OSVERSIONINFO" <c-object>
|
||||
"OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
|
||||
[ GetVersionEx ] keep swap zero? [ win32-error ] when ;
|
||||
|
|
@ -67,4 +67,4 @@ IN: hardware-info.windows
|
|||
{
|
||||
{ [ os wince? ] [ "hardware-info.windows.ce" ] }
|
||||
{ [ os winnt? ] [ "hardware-info.windows.nt" ] }
|
||||
} cond [ require ] when* >>
|
||||
} cond require >>
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
IN: mason.child.tests
|
||||
USING: mason.child mason.config tools.test namespaces ;
|
||||
|
||||
[ { "make" "clean" "winnt-x86-32" } ] [
|
||||
[ { "make" "winnt-x86-32" } ] [
|
||||
[
|
||||
"winnt" target-os set
|
||||
"x86.32" target-cpu set
|
||||
|
|
@ -9,7 +9,7 @@ USING: mason.child mason.config tools.test namespaces ;
|
|||
] with-scope
|
||||
] unit-test
|
||||
|
||||
[ { "make" "clean" "macosx-x86-32" } ] [
|
||||
[ { "make" "macosx-x86-32" } ] [
|
||||
[
|
||||
"macosx" target-os set
|
||||
"x86.32" target-cpu set
|
||||
|
|
@ -17,7 +17,7 @@ USING: mason.child mason.config tools.test namespaces ;
|
|||
] with-scope
|
||||
] unit-test
|
||||
|
||||
[ { "gmake" "clean" "netbsd-ppc" } ] [
|
||||
[ { "gmake" "netbsd-ppc" } ] [
|
||||
[
|
||||
"netbsd" target-os set
|
||||
"ppc" target-cpu set
|
||||
|
|
|
|||
|
|
@ -2,14 +2,26 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel namespaces make debugger sequences io.files
|
||||
io.launcher arrays accessors calendar continuations
|
||||
combinators.short-circuit mason.common mason.report mason.platform ;
|
||||
combinators.short-circuit mason.common mason.report
|
||||
mason.platform mason.config http.client ;
|
||||
IN: mason.child
|
||||
|
||||
: make-cmd ( -- args )
|
||||
[ gnu-make , "clean" , platform , ] { } make ;
|
||||
gnu-make platform 2array ;
|
||||
|
||||
: download-dlls ( -- )
|
||||
target-os get "winnt" = [
|
||||
"http://factorcode.org/dlls/"
|
||||
target-cpu get "x86.64" = [ "64/" append ] when
|
||||
[ "freetype6.dll" append ]
|
||||
[ "zlib1.dll" append ] bi
|
||||
[ download ] bi@
|
||||
] when ;
|
||||
|
||||
: make-vm ( -- )
|
||||
"factor" [
|
||||
download-dlls
|
||||
|
||||
<process>
|
||||
make-cmd >>command
|
||||
"../compile-log" >>stdout
|
||||
|
|
|
|||
|
|
@ -48,19 +48,17 @@ IN: slides
|
|||
: $divider ( -- )
|
||||
[
|
||||
<gadget>
|
||||
T{ gradient f
|
||||
{
|
||||
T{ rgba f 0.25 0.25 0.25 1.0 }
|
||||
T{ rgba f 1.0 1.0 1.0 0.0 }
|
||||
}
|
||||
} >>interior
|
||||
{
|
||||
T{ rgba f 0.25 0.25 0.25 1.0 }
|
||||
T{ rgba f 1.0 1.0 1.0 0.0 }
|
||||
} <gradient> >>interior
|
||||
{ 800 10 } >>dim
|
||||
{ 1 0 } >>orientation
|
||||
gadget.
|
||||
] ($block) ;
|
||||
|
||||
: page-theme ( gadget -- )
|
||||
T{ gradient f { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } }
|
||||
{ T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } <gradient>
|
||||
>>interior drop ;
|
||||
|
||||
: <page> ( list -- gadget )
|
||||
|
|
|
|||
Binary file not shown.
|
After Width: | Height: | Size: 72 KiB |
|
|
@ -0,0 +1,70 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors colors arrays kernel sequences math byte-arrays
|
||||
namespaces cap graphics.bitmap
|
||||
ui.gadgets ui.gadgets.packs ui.gadgets.borders ui.gadgets.grids
|
||||
ui.gadgets.grid-lines ui.gadgets.labels ui.gadgets.buttons
|
||||
ui.render ui opengl opengl.gl ;
|
||||
IN: ui.render.test
|
||||
|
||||
SINGLETON: line-test
|
||||
|
||||
M: line-test draw-interior
|
||||
2drop { 0 0 } { 0 10 } gl-line ;
|
||||
|
||||
: <line-gadget> ( -- gadget )
|
||||
<gadget>
|
||||
line-test >>interior
|
||||
{ 1 10 } >>dim ;
|
||||
|
||||
TUPLE: ui-render-test < pack { first-time? initial: t } ;
|
||||
|
||||
: message-window ( text -- )
|
||||
<label> "Message" open-window ;
|
||||
|
||||
: check-rendering ( gadget -- )
|
||||
gl-screenshot
|
||||
"resource:extra/ui/render/test/reference.bmp" load-bitmap array>>
|
||||
= "perfect" "needs work" ? "Your UI rendering is " prepend
|
||||
message-window ;
|
||||
|
||||
M: ui-render-test draw-gadget*
|
||||
[ call-next-method ] [
|
||||
dup first-time?>> [
|
||||
dup check-rendering
|
||||
f >>first-time?
|
||||
] when
|
||||
drop
|
||||
] bi ;
|
||||
|
||||
: <ui-render-test> ( -- gadget )
|
||||
\ ui-render-test new-gadget
|
||||
{ 1 0 } >>orientation
|
||||
<gadget>
|
||||
black <solid> >>interior
|
||||
{ 98 98 } >>dim
|
||||
1 <border> add-gadget
|
||||
<gadget>
|
||||
gray <solid> >>boundary
|
||||
{ 94 94 } >>dim
|
||||
3 <border>
|
||||
red <solid> >>boundary
|
||||
add-gadget
|
||||
<line-gadget> <line-gadget> <line-gadget> 3array
|
||||
<line-gadget> <line-gadget> <line-gadget> 3array
|
||||
<line-gadget> <line-gadget> <line-gadget> 3array
|
||||
3array <grid>
|
||||
{ 5 5 } >>gap
|
||||
blue <grid-lines> >>boundary
|
||||
add-gadget
|
||||
<gadget>
|
||||
{ 14 14 } >>dim
|
||||
black <checkmark-paint> >>interior
|
||||
black <solid> >>boundary
|
||||
4 <border>
|
||||
add-gadget ;
|
||||
|
||||
: ui-render-test ( -- )
|
||||
<ui-render-test> "Test" open-window ;
|
||||
|
||||
MAIN: ui-render-test
|
||||
|
|
@ -9,7 +9,7 @@ IN: update.latest
|
|||
: git-pull-master ( -- )
|
||||
image parent-directory
|
||||
[
|
||||
{ "git" "pull" "git://factorcode.org/git/factor.git" "master" }
|
||||
{ "git" "pull" "http://factorcode.org/git/factor.git" "master" }
|
||||
run-command
|
||||
]
|
||||
with-directory ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slides from a talk at VPRI by Slava Pestov, October 2008
|
||||
|
|
@ -0,0 +1 @@
|
|||
demos
|
||||
|
|
@ -16,11 +16,11 @@ TUPLE: help-webapp < dispatcher ;
|
|||
{ "search" [ 1 v-min-length 50 v-max-length v-one-line ] }
|
||||
} validate-params
|
||||
|
||||
help-dir set-current-directory
|
||||
|
||||
"search" value article-apropos "articles" set-value
|
||||
"search" value word-apropos "words" set-value
|
||||
"search" value vocab-apropos "vocabs" set-value
|
||||
help-dir [
|
||||
"search" value article-apropos "articles" set-value
|
||||
"search" value word-apropos "words" set-value
|
||||
"search" value vocab-apropos "vocabs" set-value
|
||||
] with-directory
|
||||
|
||||
{ help-webapp "search" } <chloe-content>
|
||||
] >>submit ;
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@
|
|||
<th class="field-label big-field-label">Capabilities:</th>
|
||||
<td>
|
||||
<t:each t:name="capabilities">
|
||||
<li><t:checkbox t:name="@value" t:label="@value" /><br/>
|
||||
<t:checkbox t:name="@value" t:label="@value" /><br/>
|
||||
</t:each>
|
||||
</td>
|
||||
</tr>
|
||||
|
|
|
|||
107
misc/factor.el
107
misc/factor.el
|
|
@ -317,10 +317,9 @@ value from the existing code in the buffer."
|
|||
|
||||
;;; Factor mode indentation:
|
||||
|
||||
(defvar factor-indent-width factor-default-indent-width
|
||||
"Indentation width in factor buffers. A local variable.")
|
||||
|
||||
(make-variable-buffer-local 'factor-indent-width)
|
||||
(make-variable-buffer-local
|
||||
(defvar factor-indent-width factor-default-indent-width
|
||||
"Indentation width in factor buffers. A local variable."))
|
||||
|
||||
(defconst factor--regexp-word-start
|
||||
(let ((sws '("" ":" "TUPLE" "MACRO" "MACRO:" "M")))
|
||||
|
|
@ -340,45 +339,67 @@ value from the existing code in the buffer."
|
|||
(setq iw (current-indentation))))))
|
||||
iw))
|
||||
|
||||
(defun factor--brackets-depth ()
|
||||
"Returns number of brackets, not closed on previous lines."
|
||||
(syntax-ppss-depth
|
||||
(save-excursion
|
||||
(syntax-ppss (line-beginning-position)))))
|
||||
(defsubst factor--ppss-brackets-depth ()
|
||||
(nth 0 (syntax-ppss)))
|
||||
|
||||
(defsubst factor--ppss-brackets-start ()
|
||||
(nth 1 (syntax-ppss)))
|
||||
|
||||
(defsubst factor--line-indent (pos)
|
||||
(save-excursion (goto-char pos) (current-indentation)))
|
||||
|
||||
(defconst factor--regex-closing-paren "[])}]")
|
||||
(defsubst factor--at-closing-paren-p ()
|
||||
(looking-at factor--regex-closing-paren))
|
||||
|
||||
(defsubst factor--at-first-char-p ()
|
||||
(= (- (point) (line-beginning-position)) (current-indentation)))
|
||||
|
||||
(defconst factor--regex-single-liner
|
||||
(format "^%s" (regexp-opt '("USE:" "IN:" "PRIVATE>" "<PRIVATE"))))
|
||||
|
||||
(defun factor--at-end-of-def ()
|
||||
(or (looking-at ".*;[ \t]*$")
|
||||
(looking-at factor--regex-single-liner)))
|
||||
|
||||
(defun factor--indent-in-brackets ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (or (and (re-search-forward factor--regex-closing-paren
|
||||
(line-end-position) t)
|
||||
(not (backward-char)))
|
||||
(> (factor--ppss-brackets-depth) 0))
|
||||
(let ((op (factor--ppss-brackets-start)))
|
||||
(when (> (line-number-at-pos) (line-number-at-pos op))
|
||||
(if (factor--at-closing-paren-p)
|
||||
(factor--line-indent op)
|
||||
(+ (factor--line-indent op) factor-indent-width)))))))
|
||||
|
||||
(defun factor--indent-definition ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (looking-at "\\([^ ]\\|^\\)+:") 0)))
|
||||
|
||||
(defun factor--indent-continuation ()
|
||||
(save-excursion
|
||||
(forward-line -1)
|
||||
(beginning-of-line)
|
||||
(if (bobp) 0
|
||||
(if (looking-at "^[ \t]*$")
|
||||
(factor--indent-continuation)
|
||||
(if (factor--at-end-of-def)
|
||||
(- (current-indentation) factor-indent-width)
|
||||
(if (factor--indent-definition)
|
||||
(+ (current-indentation) factor-indent-width)
|
||||
(current-indentation)))))))
|
||||
|
||||
(defun factor--calculate-indentation ()
|
||||
"Calculate Factor indentation for line at point."
|
||||
(let ((not-indented t)
|
||||
(cur-indent 0))
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (bobp)
|
||||
(setq cur-indent 0)
|
||||
(save-excursion
|
||||
(while not-indented
|
||||
;; Check that we are inside open brackets
|
||||
(save-excursion
|
||||
(let ((cur-depth (factor--brackets-depth)))
|
||||
(forward-line -1)
|
||||
(setq cur-indent (+ (current-indentation)
|
||||
(* factor-indent-width
|
||||
(- cur-depth (factor--brackets-depth)))))
|
||||
(setq not-indented nil)))
|
||||
(forward-line -1)
|
||||
;; Check that we are after the end of previous word
|
||||
(if (looking-at ".*;[ \t]*$")
|
||||
(progn
|
||||
(setq cur-indent (- (current-indentation) factor-indent-width))
|
||||
(setq not-indented nil))
|
||||
;; Check that we are after the start of word
|
||||
(if (looking-at factor--regexp-word-start)
|
||||
(progn
|
||||
(message "inword")
|
||||
(setq cur-indent (+ (current-indentation) factor-indent-width))
|
||||
(setq not-indented nil))
|
||||
(if (bobp)
|
||||
(setq not-indented nil))))))))
|
||||
cur-indent))
|
||||
(or (and (bobp) 0)
|
||||
(factor--indent-definition)
|
||||
(factor--indent-in-brackets)
|
||||
(factor--indent-continuation)
|
||||
0))
|
||||
|
||||
(defun factor-indent-line ()
|
||||
"Indent current line as Factor code"
|
||||
|
|
@ -420,11 +441,15 @@ value from the existing code in the buffer."
|
|||
|
||||
;;; Factor listener mode
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode factor-listener-mode comint-mode "Factor Listener")
|
||||
|
||||
(define-key factor-listener-mode-map [f8] 'factor-refresh-all)
|
||||
|
||||
;;;###autoload
|
||||
(defun run-factor ()
|
||||
"Start a factor listener inside emacs, or switch to it if it
|
||||
already exists."
|
||||
(interactive)
|
||||
(switch-to-buffer
|
||||
(make-comint-in-buffer "factor" nil (expand-file-name factor-binary) nil
|
||||
|
|
@ -433,6 +458,8 @@ value from the existing code in the buffer."
|
|||
(factor-listener-mode))
|
||||
|
||||
(defun factor-refresh-all ()
|
||||
"Reload source files and documentation for all loaded
|
||||
vocabularies which have been modified on disk."
|
||||
(interactive)
|
||||
(comint-send-string "*factor*" "refresh-all\n"))
|
||||
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@ void primitive_fixnum_shift(void)
|
|||
}
|
||||
else if(y < WORD_SIZE - TAG_BITS)
|
||||
{
|
||||
F_FIXNUM mask = -(1L << (WORD_SIZE - 1 - TAG_BITS - y));
|
||||
F_FIXNUM mask = -((F_FIXNUM)1 << (WORD_SIZE - 1 - TAG_BITS - y));
|
||||
if((x > 0 && (x & mask) == 0) || (x & mask) == mask)
|
||||
{
|
||||
dpush(tag_fixnum(x << y));
|
||||
|
|
|
|||
|
|
@ -29,7 +29,13 @@ long exception_handler(PEXCEPTION_POINTERS pe)
|
|||
signal_number = ERROR_DIVIDE_BY_ZERO;
|
||||
c->EIP = (CELL)divide_by_zero_signal_handler_impl;
|
||||
}
|
||||
else
|
||||
/* If the Widcomm bluetooth stack is installed, the BTTray.exe process
|
||||
injects code into running programs. For some reason this results in
|
||||
random SEH exceptions with this (undocumented) exception code being
|
||||
raised. The workaround seems to be ignoring this altogether, since that
|
||||
is what happens if SEH is not enabled. Don't really have any idea what
|
||||
this exception means. */
|
||||
else if(e->ExceptionCode != 0x40010006)
|
||||
{
|
||||
signal_number = 11;
|
||||
c->EIP = (CELL)misc_signal_handler_impl;
|
||||
|
|
|
|||
Loading…
Reference in New Issue