- reader syntax for arrays, byte arrays, displaced aliens\r
- sleep word\r
-- docstrings appear twice\r
- fix infer hang\r
-- fix sort out of bounds\r
\r
+ ui:\r
\r
\r
- split: return vectors\r
- specialized arrays\r
-- clear special word props when redefining words\r
- there is a problem with hashcodes of words and bootstrapping\r
- delegating generic words with a non-standard picker\r
- powerpc has weird callstack residue\r
! FFI code does not run in the interpreter.
-TUPLE: alien-error symbol library ;
-
-C: alien-error ( lib sym -- )
- [ set-alien-error-symbol ] keep
- [ set-alien-error-library ] keep ;
+TUPLE: alien-error library symbol ;
M: alien-error error. ( error -- )
"C library interface words cannot be interpreted. " write
"/library/math/ratio.factor"
"/library/math/float.factor"
"/library/math/complex.factor"
+ "/library/math/random.factor"
"/library/collections/growable.factor"
"/library/collections/cons.factor"
"/library/collections/sequence-sort.factor"
"/library/collections/strings-epilogue.factor"
"/library/collections/tree-each.factor"
+ "/library/collections/queues.factor"
"/library/math/matrices.factor"
"/library/io/string-streams.factor"
"/library/io/c-streams.factor"
"/library/io/files.factor"
-
- "/library/threads.factor"
+ "/library/io/directories.factor"
+ "/library/io/binary.factor"
"/library/syntax/parse-numbers.factor"
"/library/syntax/parse-words.factor"
"/library/syntax/prettyprint.factor"
+ "/library/io/logging.factor"
+
"/library/tools/gensym.factor"
"/library/tools/interpreter.factor"
"/library/tools/debugger.factor"
"/library/tools/memory.factor"
+ "/library/tools/listener.factor"
+ "/library/tools/word-tools.factor"
+ "/library/tools/walker.factor"
+ "/library/tools/jedit.factor"
+
+ "/library/test/test.factor"
+
+ "/library/tools/annotations.factor"
+ "/library/tools/inspector.factor"
+
+ "/library/syntax/see.factor"
+
+ "/library/threads.factor"
+
+ "/library/tools/telnetd.factor"
+
+ "/library/bootstrap/image.factor"
"/library/inference/dataflow.factor"
"/library/inference/inference.factor"
"/library/cli.factor"
- "/library/tools/memory.factor"
-
"/library/bootstrap/init.factor"
} [ dup print parse-resource % ] each
"/library/compiler/ppc/alien.factor"\r
] pull-in\r
\r
-"Compiling base..." print\r
-\r
"statically-linked" get [\r
unix? [\r
"sdl" "libSDL.so" "cdecl" add-library\r
: compile? "compile" get supported-cpu? and ;\r
\r
compile? [\r
+ "Compiling base..." print\r
+\r
\ car compile\r
\ * compile\r
\ = compile\r
"/library/math/pow.factor"\r
"/library/math/trig-hyp.factor"\r
"/library/math/arc-trig-hyp.factor"\r
- "/library/math/random.factor"\r
-\r
- "/library/in-thread.factor"\r
-\r
- "/library/io/directories.factor"\r
- "/library/io/binary.factor"\r
- \r
- "/library/eval-catch.factor"\r
- "/library/tools/listener.factor"\r
- "/library/tools/word-tools.factor"\r
- "/library/syntax/see.factor"\r
- "/library/test/test.factor"\r
- "/library/tools/walker.factor"\r
- "/library/tools/annotations.factor"\r
- "/library/tools/inspector.factor"\r
- "/library/bootstrap/image.factor"\r
- \r
- "/library/io/logging.factor"\r
-\r
- "/library/tools/telnetd.factor"\r
- "/library/tools/jedit.factor"\r
\r
"/library/httpd/load.factor"\r
"/library/sdl/load.factor"\r
: 2car ( cons cons -- car car ) swap car swap car ; inline
: 2cdr ( cons cons -- car car ) swap cdr swap cdr ; inline
-: <queue> ( -- queue )
- #! Make a new functional queue.
- [[ [ ] [ ] ]] ; foldable
-
-: queue-empty? ( queue -- ? )
- uncons or not ; foldable
-
-: enque ( obj queue -- queue )
- uncons >r cons r> cons ; foldable
-
-: deque ( queue -- obj queue )
- uncons
- [ uncons swapd cons ] [ reverse uncons f swons ] ifte* ;
- foldable
-
M: cons = ( obj cons -- ? )
2dup eq? [
2drop t
--- /dev/null
+IN: queues
+USING: errors kernel lists math sequences vectors ;
+
+TUPLE: queue in out ;
+
+C: queue ( -- queue ) ;
+
+: queue-empty? ( queue -- ? )
+ dup queue-in swap queue-out or not ;
+
+: enque ( obj queue -- )
+ [ queue-in cons ] keep set-queue-in ;
+
+: deque ( queue -- obj )
+ dup queue-out [
+ uncons rot set-queue-out
+ ] [
+ dup queue-in [
+ reverse uncons pick set-queue-out
+ f rot set-queue-in
+ ] [
+ "Empty queue" throw
+ ] ifte*
+ ] ifte* ;
IN: sequences
: nsort ( seq quot -- | quot: elt elt -- -1/0/1 )
- swap dup empty?
+ swap dup length 1 <=
[ 2drop ] [ 0 over length 1 - (nsort) ] ifte ; inline
: sort ( seq quot -- seq | quot: elt elt -- -1/0/1 )
+++ /dev/null
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: parser USING: kernel errors io ;
-
-: eval-catch ( str -- )
- [ eval ] [ [ print-error debug-help drop ] when* ] catch ;
-
-: eval>string ( in -- out )
- [ eval-catch ] string-out ;
"methods" word-prop hash-keys [ class-compare ] sort ;
: make-generic ( word -- )
- dup dup "combination" word-prop call (define-compound) ;
+ dup dup "combination" word-prop call define-compound ;
: define-method ( class generic definition -- )
-rot
+++ /dev/null
-! Copyright (C) 2004, 2005 Slava Pestov.
-! See http://factor.sf.net/license.txt for BSD license.
-IN: threads
-USING: errors kernel lists namespaces sequences ;
-
-: in-thread ( quot -- )
- #! Execute a quotation in a co-operative thread. The
- #! quotation begins executing immediately, and execution
- #! after the 'in-thread' call in the original thread
- #! resumes when the quotation yields, either due to blocking
- #! I/O or an explicit call to 'yield'.
- [
- schedule-thread
- ! Clear stacks since we never go up from this point
- [ ] set-catchstack
- { } set-callstack
- try
- stop
- ] callcc0 drop ;
: init-io ( -- )
13 getenv 14 getenv t <c-stream> <line-reader> stdio set ;
+: io-multiplex ( ms -- ) drop ;
+
IN: io
: <file-reader> ( path -- stream )
: GENERIC:
#! GENERIC: bar == G: bar simple-combination ;
- CREATE define-generic ; parsing
+ CREATE dup reset-word define-generic ; parsing
: G:
#! G: word combination ;
- CREATE [ define-generic* ] [ ] ; parsing
+ CREATE dup reset-word [ define-generic* ] [ ] ; parsing
: COMPLEMENT: ( -- )
#! Followed by a class name, then a complemented class.
! Word definitions
: :
#! Begin a word definition. Word name follows.
- CREATE [ define-compound ] [ ] "in-definition" on ; parsing
+ CREATE dup reset-generic [ define-compound ]
+ [ ] "in-definition" on ; parsing
: ;
#! End a word definition.
! Symbols
: SYMBOL:
#! A symbol is a word that pushes itself when executed.
- CREATE define-symbol ; parsing
+ CREATE dup reset-generic define-symbol ; parsing
: \
#! Word literals: \ foo
: DEFER:
#! Create a word with no definition. Used for mutually
#! recursive words.
- CREATE drop ; parsing
+ CREATE dup reset-generic drop ; parsing
: FORGET:
#! Followed by a word name. The word is removed from its
: unparse-short ( object -- str ) [ pprint-short ] string-out ;
-: unparse-short ( object -- )
+: unparse-short. ( object -- )
dup unparse-short swap write-object terpri ;
: [.] ( sequence -- ) [ unparse-short. ] each ;
IN: temporary
-USING: test inspector prettyprint math ;
+USING: inspector math namespaces prettyprint test ;
+
+[[ "hello" "world" ]] inspect
+
+[ "hello" ] [ 0 get ] unit-test
+[ "world" ] [ 1 get ] unit-test
-[[ 1 2 ]] inspect
[ 1 2 3 ] inspect
f inspect
\ + inspect
+++ /dev/null
-IN: temporary
-USE: namespaces
-USE: io
-USE: test
-USE: parser
-
-[
- [ 4 ] [ "2 2 +" eval-catch ] unit-test
- "The following will print an error; ignore it." print terpri
- [ ] [ "clear drop" eval-catch ] unit-test
-] with-scope
IN: temporary
-USING: kernel lists math sequences test ;
+USING: kernel math namespaces queues sequences test ;
-[ { 1 2 3 4 5 } ] [
- <queue> [ 1 2 3 4 5 ] [ swap enque ] each
- 5 [ drop deque swap ] map nip
-] unit-test
+<queue> "queue" set
+
+[ t ] [ "queue" get queue-empty? ] unit-test
+
+[ ] [ [ 1 2 3 4 5 ] [ "queue" get enque ] each ] unit-test
+
+[ { 1 2 3 4 5 } ] [ 5 [ drop "queue" get deque ] map ] unit-test
+
+[ "queue" get deque ] unit-test-fails
! Test EOL comments in multiline strings.
[ [ "Hello" ] ] [ "#! This calls until-eol.\n\"Hello\"" parse ] unit-test
-[ 4 ] [ "2 2 +" eval-catch ] unit-test
-[ "4\n" ] [ "2 2 + ." eval>string ] unit-test
-[ ] [ "fdafdf" eval-catch ] unit-test
-
[ word ] [ \ f class ] unit-test
"continuations" "errors" "hashtables" "strings"
"namespaces" "generic" "tuple" "files" "parser"
"parse-number" "init" "io/io"
- "listener" "vectors" "words" "prettyprint" "random"
+ "vectors" "words" "prettyprint" "random"
"stream" "math/bitops"
"math/math-combinators" "math/rational" "math/float"
"math/complex" "math/irrational" "math/integer"
! Copyright (C) 2005 Mackenzie Straight.
! See http://factor.sf.net/license.txt for BSD license.
IN: threads
-USING: errors kernel kernel-internals lists namespaces ;
-
-! Core of the multitasker. Used by io-internals.factor and
-! in-thread.factor.
+USING: errors hashtables io-internals kernel lists math
+namespaces queues sequences vectors ;
-: run-queue ( -- queue ) 9 getenv ;
-: set-run-queue ( queue -- ) 9 setenv ;
-: init-threads ( -- ) <queue> set-run-queue ;
+! Co-operative multitasker.
+
+: run-queue ( -- queue ) \ run-queue global hash ;
+
+: schedule-thread ( quot -- ) run-queue enque ;
+
+: sleep-queue ( -- vec ) \ sleep-queue global hash ;
+
+: sleep-queue* ( -- vec )
+ sleep-queue dup [ 2car swap - ] nsort ;
+
+: sleep-time ( sorted-queue -- ms )
+ dup empty? [ drop -1 ] [ peek car millis - 0 max ] ifte ;
+
+DEFER: next-thread
+
+: do-sleep ( -- quot )
+ sleep-queue* dup sleep-time dup 0 =
+ [ drop pop ] [ io-multiplex next-thread ] ifte ;
: next-thread ( -- quot )
- run-queue dup queue-empty? [
- drop f
- ] [
- deque set-run-queue
- ] ifte ;
-
-: schedule-thread ( quot -- )
- run-queue enque set-run-queue ;
-
-: stop ( -- )
- #! Stop the current thread and begin executing the next one.
- next-thread [ call ] [ "No more tasks" throw ] ifte* ;
-
-: yield ( -- )
- #! Add the current continuation to the run queue, and yield
- #! to the next quotation. The current continuation will
- #! eventually be restored by a future call to stop or
- #! yield.
- [ schedule-thread stop ] callcc0 ;
+ run-queue dup queue-empty? [ drop do-sleep ] [ deque ] ifte ;
+
+: stop ( -- ) next-thread call ;
+
+: yield ( -- ) [ schedule-thread stop ] callcc0 ;
+
+: sleep ( ms -- )
+ millis + [ cons sleep-queue push stop ] callcc0 drop ;
+
+: in-thread ( quot -- )
+ [
+ schedule-thread
+ [ ] set-catchstack { } set-callstack
+ try stop
+ ] callcc0 drop ;
+
+: init-threads ( -- )
+ global [
+ <queue> \ run-queue set
+ 10 <vector> \ sleep-queue set
+ ] bind ;
sequences strings test ;
: annotate ( word quot -- | quot: word def -- def )
- over >r >r dup word-def r> call r> swap (define-compound) ;
+ over >r >r dup word-def r> call r> swap define-compound ;
inline
: (watch) ( word def -- def )
[ max-length ] keep
[ swap CHAR: \s pad-right ] map-with ;
+: sheet-numbers ( sheet -- sheet )
+ dup first length >vector 1vector swap append ;
+
: format-sheet ( sheet -- list )
- dup first length >vector swons
+ sheet-numbers
dup peek over first [ set ] 2each
[ format-column ] map
flip
! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: jedit
-USING: io kernel lists namespaces parser prettyprint sequences
-strings unparser vectors words ;
+USING: errors io kernel lists namespaces parser prettyprint
+sequences strings unparser vectors words ;
! Some words to send requests to a running jEdit instance to
! edit files and position the cursor on a specific line number.
: read-packet ( -- string ) 4 read be> read ;
+: eval>string ( str -- )
+ [ [ [ eval ] keep ] try drop ] string-out ;
+
: wire-server ( -- )
#! Repeatedly read jEdit requests and execute them. Return
#! on EOF.
: <fd-stream> ( infd outfd flush? -- stream )
>r >r <reader> r> <writer> r> <duplex-stream> ;
-: idle-io-task ( -- )
- [ schedule-thread 10 io-multiplex stop ] callcc0
- idle-io-task ;
-
USE: io
: init-io ( -- )
<namespace> write-tasks set
FD_SETSIZE <bit-array> write-fdset set
0 1 t <fd-stream> stdio set
- ] bind
- [ idle-io-task ] in-thread ;
+ ] bind ;
: init-search-path ( -- )
"scratchpad" "in" set
[
- "compiler" "errors" "gadgets" "generic"
- "hashtables" "help" "inference" "inspector" "interpreter"
+ "compiler" "errors" "gadgets" "generic" "hashtables"
+ "help" "inference" "inspector" "interpreter" "io"
"jedit" "kernel" "listener" "lists" "math" "matrices"
- "memory" "namespaces" "parser" "prettyprint"
- "sequences" "io" "strings" "styles" "syntax" "test"
- "threads" "vectors" "words" "scratchpad"
+ "memory" "namespaces" "parser" "prettyprint" "queues"
+ "scratchpad" "sequences" "strings" "styles" "syntax"
+ "test" "threads" "vectors" "words"
] "use" set ;
PREDICATE: word compound ( obj -- ? ) word-primitive 1 = ;
M: compound definer drop \ : ;
-: (define-compound) ( word def -- )
+: define-compound ( word def -- )
>r dup dup remove-crossref r> 1 swap define add-crossref ;
: reset-props ( word seq -- )
[ f swap set-word-prop ] each-with ;
-: reset-generic ( word -- )
- #! Make a word no longer be generic.
- { "methods" "combination" } reset-props ;
+: reset-word ( word -- )
+ { "parsing" "inline" "foldable" "flushable" "predicating" }
+ reset-props ;
-: define-compound ( word def -- )
- over reset-generic (define-compound) ;
+: reset-generic ( word -- )
+ dup reset-word { "methods" "combination" } reset-props ;
GENERIC: literalize ( obj -- obj )
#define CATCHSTACK_ENV 6 /* used by library only */
#define CPU_ENV 7
#define BOOT_ENV 8
-#define RUNQUEUE_ENV 9 /* used by library only */
+#define UNUSED_ENV 9
#define ARGS_ENV 10
#define OS_ENV 11
#define ERROR_ENV 12 /* a marker consed onto kernel errors */
projects / factor.git / commitdiff