steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Imported https://downloads.factorcode.org/releases/0.66/Factor-0.66.zip

release import-0.66
nomennescio 2019-10-18 15:04:35 +02:00
parent d61bc9f88a 3e6e224c21
commit 30e1a2f1f6
410 changed files with 30398 additions and 3574 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

304
.cvskeywords
View File

@ -1,107 +1,151 @@
./library/vocabulary-style.factor:! $Id: vocabulary-style.factor,v 1.3 2004/07/22 23:48:49 spestov Exp $
./library/prettyprint.factor:! $Id: prettyprint.factor,v 1.6 2004/07/23 05:27:54 spestov Exp $
./library/ansi.factor:! $Id: ansi.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/inspect-vocabularies.factor:! $Id: inspect-vocabularies.factor,v 1.6 2004/07/23 05:38:36 spestov Exp $
./library/vectors.factor:! $Id: vectors.factor,v 1.3 2004/07/22 23:48:49 spestov Exp $
./library/httpd/file-responder.factor:! $Id: file-responder.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/httpd/http-common.factor:! $Id: http-common.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/httpd/inspect-responder.factor:! $Id: inspect-responder.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/httpd/quit-responder.factor:! $Id: quit-responder.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/httpd/responder.factor:! $Id: responder.factor,v 1.3 2004/07/22 23:48:50 spestov Exp $
./library/httpd/default-responders.factor:! $Id: default-responders.factor,v 1.3 2004/07/22 23:48:50 spestov Exp $
./library/httpd/wiki-responder.factor:! $Id: wiki-responder.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/httpd/html.factor:! $Id: html.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/httpd/test-responder.factor:! $Id: test-responder.factor,v 1.3 2004/07/22 23:48:50 spestov Exp $
./library/httpd/httpd.factor:! $Id: httpd.factor,v 1.4 2004/07/23 05:21:46 spestov Exp $
./library/httpd/url-encoding.factor:! $Id: url-encoding.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/namespace-math.factor:! $Id: namespace-math.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/arc-trig-hyp.factor:! $Id: arc-trig-hyp.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/quadratic.factor:! $Id: quadratic.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/list-math.factor:! $Id: list-math.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/math-combinators.factor:! $Id: math-combinators.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/pow.factor:! $Id: pow.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/math.factor:! $Id: math.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/arithmetic.factor:! $Id: arithmetic.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/math/trig-hyp.factor:! $Id: trig-hyp.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/errors.factor:! $Id: errors.factor,v 1.6 2004/07/22 23:48:49 spestov Exp $
./library/random.factor:! $Id: random.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/styles.factor:! $Id: styles.factor,v 1.3 2004/07/22 23:48:49 spestov Exp $
./library/combinators.factor:! $Id: combinators.factor,v 1.3 2004/07/22 23:48:49 spestov Exp $
./library/inspector.factor:! $Id: inspector.factor,v 1.7 2004/07/23 05:21:46 spestov Exp $
./library/words.factor:! $Id: words.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/continuations.factor:! $Id: continuations.factor,v 1.3 2004/07/22 23:48:49 spestov Exp $
./library/assoc.factor:! $Id: assoc.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/logic.factor:! $Id: logic.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/list-namespaces.factor:! $Id: list-namespaces.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/vocabularies.factor:! $Id: vocabularies.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/lists.factor:! $Id: lists.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/debugger.factor:! $Id: debugger.factor,v 1.6 2004/07/23 05:38:36 spestov Exp $
./contrib/irc.factor:! $Id: irc.factor,v 1.3 2004/08/23 01:56:04 spestov Exp $
./library/compiler/assembler.factor:! $Id: assembler.factor,v 1.5 2004/10/01 01:49:49 spestov Exp $
./library/compiler/generic.factor:! $Id: generic.factor,v 1.3 2004/10/07 01:04:01 spestov Exp $
./library/compiler/assembly-x86.factor:! $Id: assembly-x86.factor,v 1.9 2004/10/02 02:25:19 spestov Exp $
./library/compiler/alien-types.factor:! $Id: alien-types.factor,v 1.4 2004/09/27 00:16:01 spestov Exp $
./library/compiler/alien-macros.factor:! $Id: alien-macros.factor,v 1.6 2004/10/01 01:49:49 spestov Exp $
./library/compiler/compile-all.factor:! $Id: compile-all.factor,v 1.4 2004/10/10 01:58:16 spestov Exp $
./library/compiler/alien.factor:! $Id: alien.factor,v 1.3 2004/10/10 01:43:14 spestov Exp $
./library/compiler/compiler.factor:! $Id: compiler.factor,v 1.12 2004/10/09 19:14:49 spestov Exp $
./library/compiler/compiler-macros.factor:! $Id: compiler-macros.factor,v 1.4 2004/10/02 02:46:12 spestov Exp $
./library/compiler/interpret-only.factor:! $Id: interpret-only.factor,v 1.3 2004/10/07 01:04:01 spestov Exp $
./library/compiler/ifte.factor:! $Id: ifte.factor,v 1.3 2004/10/03 20:07:48 spestov Exp $
./library/vocabulary-style.factor:! $Id: vocabulary-style.factor,v 1.9 2004/09/02 23:38:04 spestov Exp $
./library/prettyprint.factor:! $Id: prettyprint.factor,v 1.18 2004/09/28 04:24:35 spestov Exp $
./library/ansi.factor:! $Id: ansi.factor,v 1.4 2004/08/22 05:46:25 spestov Exp $
./library/inspect-vocabularies.factor:! $Id: inspect-vocabularies.factor,v 1.11 2004/10/02 02:25:19 spestov Exp $
./library/vectors.factor:! $Id: vectors.factor,v 1.7 2004/08/27 02:21:03 spestov Exp $
./library/httpd/file-responder.factor:! $Id: file-responder.factor,v 1.11 2004/10/05 01:51:57 spestov Exp $
./library/httpd/http-common.factor:! $Id: http-common.factor,v 1.12 2004/09/02 23:38:04 spestov Exp $
./library/httpd/inspect-responder.factor:! $Id: inspect-responder.factor,v 1.3 2004/08/18 01:57:45 spestov Exp $
./library/httpd/quit-responder.factor:! $Id: quit-responder.factor,v 1.4 2004/08/28 20:43:42 spestov Exp $
./library/httpd/responder.factor:! $Id: responder.factor,v 1.16 2004/09/23 03:42:45 spestov Exp $
./library/httpd/resource-responder.factor:! $Id: resource-responder.factor,v 1.1 2004/09/02 23:38:04 spestov Exp $
./library/httpd/default-responders.factor:! $Id: default-responders.factor,v 1.9 2004/09/23 03:42:45 spestov Exp $
./library/httpd/wiki-responder.factor:! $Id: wiki-responder.factor,v 1.6 2004/09/15 03:23:05 spestov Exp $
./library/httpd/html.factor:! $Id: html.factor,v 1.14 2004/10/05 01:51:57 spestov Exp $
./library/httpd/test-responder.factor:! $Id: test-responder.factor,v 1.4 2004/08/11 03:48:07 spestov Exp $
./library/httpd/httpd.factor:! $Id: httpd.factor,v 1.16 2004/09/18 22:15:00 spestov Exp $
./library/httpd/url-encoding.factor:! $Id: url-encoding.factor,v 1.6 2004/10/07 03:34:22 spestov Exp $
./library/math/namespace-math.factor:! $Id: namespace-math.factor,v 1.4 2004/10/07 03:34:22 spestov Exp $
./library/math/arc-trig-hyp.factor:! $Id: arc-trig-hyp.factor,v 1.4 2004/08/27 02:21:03 spestov Exp $
./library/math/constants.factor:! $Id: constants.factor,v 1.2 2004/09/19 02:29:28 spestov Exp $
./library/math/quadratic.factor:! $Id: quadratic.factor,v 1.4 2004/10/07 03:34:22 spestov Exp $
./library/math/simpson.factor:! $Id: simpson.factor,v 1.3 2004/08/27 02:21:16 spestov Exp $
./library/math/list-math.factor:! $Id: list-math.factor,v 1.4 2004/08/27 02:21:16 spestov Exp $
./library/math/math-combinators.factor:! $Id: math-combinators.factor,v 1.5 2004/09/25 03:22:43 spestov Exp $
./library/math/pow.factor:! $Id: pow.factor,v 1.6 2004/10/07 03:34:22 spestov Exp $
./library/math/math.factor:! $Id: math.factor,v 1.5 2004/09/22 02:58:53 spestov Exp $
./library/math/arithmetic.factor:! $Id: arithmetic.factor,v 1.9 2004/09/04 05:05:49 spestov Exp $
./library/math/trig-hyp.factor:! $Id: trig-hyp.factor,v 1.7 2004/09/19 02:29:28 spestov Exp $
./library/errors.factor:! $Id: errors.factor,v 1.13 2004/10/03 20:07:47 spestov Exp $
./library/random.factor:! $Id: random.factor,v 1.4 2004/10/07 03:34:19 spestov Exp $
./library/styles.factor:! $Id: styles.factor,v 1.7 2004/09/02 23:38:04 spestov Exp $
./library/combinators.factor:! $Id: combinators.factor,v 1.10 2004/10/10 02:36:41 spestov Exp $
./library/inspector.factor:! $Id: inspector.factor,v 1.17 2004/08/31 00:24:18 spestov Exp $
./library/words.factor:! $Id: words.factor,v 1.5 2004/09/28 04:24:35 spestov Exp $
./library/continuations.factor:! $Id: continuations.factor,v 1.5 2004/08/23 06:15:10 spestov Exp $
./library/assoc.factor:! $Id: assoc.factor,v 1.5 2004/08/21 07:30:49 spestov Exp $
./library/logic.factor:! $Id: logic.factor,v 1.4 2004/08/28 20:43:42 spestov Exp $
./library/cross-compiler.factor:! $Id: cross-compiler.factor,v 1.51 2004/10/05 03:58:50 spestov Exp $
./library/image.factor:! $Id: image.factor,v 1.30 2004/10/01 01:49:49 spestov Exp $
./library/list-namespaces.factor:! $Id: list-namespaces.factor,v 1.4 2004/09/28 04:24:35 spestov Exp $
./library/stdio-binary.factor:! $Id: stdio-binary.factor,v 1.5 2004/09/04 05:05:49 spestov Exp $
./library/vocabularies.factor:! $Id: vocabularies.factor,v 1.10 2004/09/19 02:29:28 spestov Exp $
./library/lists.factor:! $Id: lists.factor,v 1.15 2004/10/01 01:49:49 spestov Exp $
./library/extend-stream.factor:! $Id: extend-stream.factor,v 1.1 2004/08/22 05:46:25 spestov Exp $
./library/debugger.factor:! $Id: debugger.factor,v 1.11 2004/08/18 23:22:14 spestov Exp $
./library/cons.factor:! $Id: cons.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/format.factor:! $Id: format.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/hashtables.factor:! $Id: hashtables.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/stream.factor:! $Id: stream.factor,v 1.3 2004/07/22 23:48:49 spestov Exp $
./library/strings.factor:! $Id: strings.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/logging.factor:! $Id: logging.factor,v 1.3 2004/07/24 00:35:12 spestov Exp $
./library/init.factor:! $Id: init.factor,v 1.6 2004/07/24 19:11:54 spestov Exp $
./library/platform/jvm/prettyprint.factor:! $Id: prettyprint.factor,v 1.4 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/vectors.factor:! $Id: vectors.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/kernel.factor:! $Id: kernel.factor,v 1.3 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/errors.factor:! $Id: errors.factor,v 1.5 2004/07/23 05:38:36 spestov Exp $
./library/sdl/sdl-video.factor:! $Id: sdl-video.factor,v 1.2 2004/10/10 01:43:14 spestov Exp $
./library/sdl/sdl.factor:! $Id: sdl.factor,v 1.2 2004/10/10 01:43:14 spestov Exp $
./library/sdl/sdl-event.factor:! $Id: sdl-event.factor,v 1.2 2004/10/10 01:43:14 spestov Exp $
./library/inferior.factor:! $Id: inferior.factor,v 1.2 2004/08/24 22:01:35 spestov Exp $
./library/format.factor:! $Id: format.factor,v 1.3 2004/08/27 02:21:03 spestov Exp $
./library/hashtables.factor:! $Id: hashtables.factor,v 1.6 2004/08/31 04:27:09 spestov Exp $
./library/stream.factor:! $Id: stream.factor,v 1.9 2004/08/24 22:01:35 spestov Exp $
./library/files.factor:! $Id: files.factor,v 1.4 2004/09/04 07:06:53 spestov Exp $
./library/strings.factor:! $Id: strings.factor,v 1.14 2004/10/07 03:34:19 spestov Exp $
./library/logging.factor:! $Id: logging.factor,v 1.6 2004/08/18 03:49:48 spestov Exp $
./library/init.factor:! $Id: init.factor,v 1.23 2004/10/10 01:43:13 spestov Exp $
./library/platform/jvm/prettyprint.factor:! $Id: prettyprint.factor,v 1.10 2004/10/05 03:06:18 spestov Exp $
./library/platform/jvm/vectors.factor:! $Id: vectors.factor,v 1.3 2004/07/31 18:58:16 spestov Exp $
./library/platform/jvm/kernel.factor:! $Id: kernel.factor,v 1.11 2004/09/04 07:06:53 spestov Exp $
./library/platform/jvm/errors.factor:! $Id: errors.factor,v 1.6 2004/10/03 20:07:48 spestov Exp $
./library/platform/jvm/random.factor:! $Id: random.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/combinators.factor:! $Id: combinators.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/words.factor:! $Id: words.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/math-types.factor:! $Id: math-types.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/stack2.factor:! $Id: stack2.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/vocabularies.factor:! $Id: vocabularies.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/combinators.factor:! $Id: combinators.factor,v 1.5 2004/08/22 21:28:31 spestov Exp $
./library/platform/jvm/words.factor:! $Id: words.factor,v 1.8 2004/10/05 03:06:18 spestov Exp $
./library/platform/jvm/processes.factor:! $Id: processes.factor,v 1.2 2004/09/15 03:23:05 spestov Exp $
./library/platform/jvm/cross-compiler.factor:! $Id: cross-compiler.factor,v 1.5 2004/09/11 19:26:17 spestov Exp $
./library/platform/jvm/math-types.factor:! $Id: math-types.factor,v 1.4 2004/08/27 02:21:16 spestov Exp $
./library/platform/jvm/stack2.factor:! $Id: stack2.factor,v 1.5 2004/08/28 20:43:43 spestov Exp $
./library/platform/jvm/vocabularies.factor:! $Id: vocabularies.factor,v 1.3 2004/08/16 23:28:54 spestov Exp $
./library/platform/jvm/debugger.factor:! $Id: debugger.factor,v 1.5 2004/07/23 05:38:36 spestov Exp $
./library/platform/jvm/regexp.factor:! $Id: regexp.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/regexp.factor:! $Id: regexp.factor,v 1.4 2004/08/27 02:21:16 spestov Exp $
./library/platform/jvm/stack.factor:! $Id: stack.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/cons.factor:! $Id: cons.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/compiler.factor:! $Id: compiler.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/parser.factor:! $Id: parser.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/stream.factor:! $Id: stream.factor,v 1.3 2004/07/23 22:52:08 spestov Exp $
./library/platform/jvm/boot-mini.factor:! $Id: boot-mini.factor,v 1.5 2004/07/23 05:38:36 spestov Exp $
./library/platform/jvm/strings.factor:! $Id: strings.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/listener.factor:! $Id: listener.factor,v 1.4 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/init.factor:! $Id: init.factor,v 1.4 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/arithmetic.factor:! $Id: arithmetic.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/unparser.factor:! $Id: unparser.factor,v 1.3 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/threads.factor:! $Id: threads.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/sbuf.factor:! $Id: sbuf.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/real-math.factor:! $Id: real-math.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/boot.factor:! $Id: boot.factor,v 1.3 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/cons.factor:! $Id: cons.factor,v 1.3 2004/08/03 06:08:11 spestov Exp $
./library/platform/jvm/compiler.factor:! $Id: compiler.factor,v 1.5 2004/08/24 19:27:37 spestov Exp $
./library/platform/jvm/parser.factor:! $Id: parser.factor,v 1.9 2004/09/06 00:14:37 spestov Exp $
./library/platform/jvm/stream.factor:! $Id: stream.factor,v 1.15 2004/09/18 22:15:00 spestov Exp $
./library/platform/jvm/files.factor:! $Id: files.factor,v 1.3 2004/09/04 07:06:53 spestov Exp $
./library/platform/jvm/boot-mini.factor:! $Id: boot-mini.factor,v 1.9 2004/09/19 02:29:28 spestov Exp $
./library/platform/jvm/strings.factor:! $Id: strings.factor,v 1.3 2004/08/28 20:43:43 spestov Exp $
./library/platform/jvm/listener.factor:! $Id: listener.factor,v 1.16 2004/09/25 03:22:43 spestov Exp $
./library/platform/jvm/init.factor:! $Id: init.factor,v 1.16 2004/09/02 23:38:05 spestov Exp $
./library/platform/jvm/arithmetic.factor:! $Id: arithmetic.factor,v 1.8 2004/08/27 02:21:16 spestov Exp $
./library/platform/jvm/unparser.factor:! $Id: unparser.factor,v 1.6 2004/09/05 02:29:07 spestov Exp $
./library/platform/jvm/threads.factor:! $Id: threads.factor,v 1.3 2004/07/28 00:23:08 spestov Exp $
./library/platform/jvm/sbuf.factor:! $Id: sbuf.factor,v 1.4 2004/09/07 02:39:11 spestov Exp $
./library/platform/jvm/real-math.factor:! $Id: real-math.factor,v 1.4 2004/08/27 02:21:16 spestov Exp $
./library/platform/jvm/boot.factor:! $Id: boot.factor,v 1.5 2004/08/28 20:43:43 spestov Exp $
./library/platform/jvm/namespaces.factor:! $Id: namespaces.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/jvm/boot-sumo.factor:! $Id: boot-sumo.factor,v 1.5 2004/07/23 05:38:36 spestov Exp $
./library/platform/native/prettyprint.factor:! $Id: prettyprint.factor,v 1.4 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/vectors.factor:! $Id: vectors.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/kernel.factor:! $Id: kernel.factor,v 1.6 2004/07/24 04:54:57 spestov Exp $
./library/platform/native/errors.factor:! $Id: errors.factor,v 1.9 2004/07/24 21:37:42 spestov Exp $
./library/platform/native/words.factor:! $Id: words.factor,v 1.3 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/cross-compiler.factor:! $Id: cross-compiler.factor,v 1.10 2004/07/24 21:37:42 spestov Exp $
./library/platform/native/image.factor:! $Id: image.factor,v 1.5 2004/07/24 19:11:54 spestov Exp $
./library/platform/native/vocabularies.factor:! $Id: vocabularies.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/io-internals.factor:! $Id: io-internals.factor,v 1.3 2004/07/24 00:35:13 spestov Exp $
./library/platform/native/parse-syntax.factor:! $Id: parse-syntax.factor,v 1.1 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/parse-numbers.factor:! $Id: parse-numbers.factor,v 1.1 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/stack.factor:! $Id: stack.factor,v 1.2 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/parse-stream.factor:! $Id: parse-stream.factor,v 1.7 2004/07/24 19:11:54 spestov Exp $
./library/platform/native/parser.factor:! $Id: parser.factor,v 1.7 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/stream.factor:! $Id: stream.factor,v 1.8 2004/07/24 21:37:42 spestov Exp $
./library/platform/native/init.factor:! $Id: init.factor,v 1.6 2004/07/24 04:54:57 spestov Exp $
./library/platform/native/unparser.factor:! $Id: unparser.factor,v 1.4 2004/07/22 23:48:50 spestov Exp $
./library/platform/native/boot.factor:! $Id: boot.factor,v 1.10 2004/07/24 00:35:13 spestov Exp $
./library/platform/native/namespaces.factor:! $Id: namespaces.factor,v 1.4 2004/07/22 23:48:50 spestov Exp $
./library/vector-combinators.factor:! $Id: vector-combinators.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/stdio.factor:! $Id: stdio.factor,v 1.5 2004/07/22 23:48:49 spestov Exp $
./library/interpreter.factor:! $Id: interpreter.factor,v 1.3 2004/07/22 23:48:49 spestov Exp $
./library/sbuf.factor:! $Id: sbuf.factor,v 1.2 2004/07/22 23:48:49 spestov Exp $
./library/telnetd.factor:! $Id: telnetd.factor,v 1.4 2004/07/22 23:48:49 spestov Exp $
./library/namespaces.factor:! $Id: namespaces.factor,v 1.4 2004/07/22 23:48:49 spestov Exp $
./library/platform/jvm/boot-sumo.factor:! $Id: boot-sumo.factor,v 1.18 2004/09/04 07:06:53 spestov Exp $
./library/platform/native/prettyprint.factor:! $Id: prettyprint.factor,v 1.9 2004/10/02 02:25:19 spestov Exp $
./library/platform/native/vectors.factor:! $Id: vectors.factor,v 1.7 2004/09/28 04:24:35 spestov Exp $
./library/platform/native/kernel.factor:! $Id: kernel.factor,v 1.34 2004/10/09 19:14:49 spestov Exp $
./library/platform/native/errors.factor:! $Id: errors.factor,v 1.19 2004/08/23 06:15:10 spestov Exp $
./library/platform/native/heap-stats.factor:! $Id: heap-stats.factor,v 1.1 2004/09/21 16:41:57 spestov Exp $
./library/platform/native/random.factor:! $Id: random.factor,v 1.4 2004/08/28 20:43:43 spestov Exp $
./library/platform/native/boot-stage2.factor:! $Id: boot-stage2.factor,v 1.27 2004/10/10 01:43:14 spestov Exp $
./library/platform/native/words.factor:! $Id: words.factor,v 1.11 2004/10/02 02:25:19 spestov Exp $
./library/platform/native/network.factor:! $Id: network.factor,v 1.2 2004/08/29 02:25:58 spestov Exp $
./library/platform/native/cross-compiler.factor:! $Id: cross-compiler.factor,v 1.18 2004/09/11 19:26:18 spestov Exp $
./library/platform/native/init-stage2.factor:! $Id: init-stage2.factor,v 1.7 2004/10/09 19:14:49 spestov Exp $
./library/platform/native/vocabularies.factor:! $Id: vocabularies.factor,v 1.4 2004/08/28 20:43:43 spestov Exp $
./library/platform/native/io-internals.factor:! $Id: io-internals.factor,v 1.14 2004/09/03 01:51:19 spestov Exp $
./library/platform/native/parse-syntax.factor:! $Id: parse-syntax.factor,v 1.22 2004/10/07 03:40:46 spestov Exp $
./library/platform/native/debugger.factor:! $Id: debugger.factor,v 1.16 2004/09/27 00:16:01 spestov Exp $
./library/platform/native/parse-numbers.factor:! $Id: parse-numbers.factor,v 1.11 2004/09/15 03:23:05 spestov Exp $
./library/platform/native/stack.factor:! $Id: stack.factor,v 1.5 2004/10/01 01:49:49 spestov Exp $
./library/platform/native/primitives.factor:! $Id: primitives.factor,v 1.14 2004/10/03 20:07:48 spestov Exp $
./library/platform/native/profiler.factor:! $Id: profiler.factor,v 1.4 2004/08/29 07:20:18 spestov Exp $
./library/platform/native/parse-stream.factor:! $Id: parse-stream.factor,v 1.17 2004/09/06 00:14:37 spestov Exp $
./library/platform/native/parser.factor:! $Id: parser.factor,v 1.20 2004/09/28 04:24:35 spestov Exp $
./library/platform/native/stream.factor:! $Id: stream.factor,v 1.27 2004/09/06 00:14:37 spestov Exp $
./library/platform/native/files.factor:! $Id: files.factor,v 1.5 2004/09/02 20:40:19 spestov Exp $
./library/platform/native/strings.factor:! $Id: strings.factor,v 1.4 2004/08/27 02:21:16 spestov Exp $
./library/platform/native/init.factor:! $Id: init.factor,v 1.22 2004/09/07 02:39:11 spestov Exp $
./library/platform/native/in-thread.factor:! $Id: in-thread.factor,v 1.1 2004/08/22 05:46:26 spestov Exp $
./library/platform/native/math.factor:! $Id: math.factor,v 1.8 2004/10/02 02:25:19 spestov Exp $
./library/platform/native/unparser.factor:! $Id: unparser.factor,v 1.21 2004/09/27 00:16:01 spestov Exp $
./library/platform/native/threads.factor:! $Id: threads.factor,v 1.3 2004/08/29 02:25:58 spestov Exp $
./library/platform/native/types.factor:! $Id: types.factor,v 1.5 2004/10/02 02:02:54 spestov Exp $
./library/platform/native/boot.factor:! $Id: boot.factor,v 1.36 2004/09/22 02:58:53 spestov Exp $
./library/platform/native/namespaces.factor:! $Id: namespaces.factor,v 1.10 2004/08/27 02:21:16 spestov Exp $
./library/jedit/jedit-remote.factor:! $Id: jedit-remote.factor,v 1.3 2004/08/22 05:46:25 spestov Exp $
./library/jedit/jedit-local.factor:! $Id: jedit-local.factor,v 1.2 2004/08/27 02:21:03 spestov Exp $
./library/jedit/jedit.factor:! $Id: jedit.factor,v 1.8 2004/09/28 04:24:35 spestov Exp $
./library/vector-combinators.factor:! $Id: vector-combinators.factor,v 1.4 2004/10/07 03:34:19 spestov Exp $
./library/stdio.factor:! $Id: stdio.factor,v 1.16 2004/09/25 03:22:43 spestov Exp $
./library/interpreter.factor:! $Id: interpreter.factor,v 1.18 2004/10/05 01:51:53 spestov Exp $
./library/sbuf.factor:! $Id: sbuf.factor,v 1.10 2004/10/07 03:34:19 spestov Exp $
./library/telnetd.factor:! $Id: telnetd.factor,v 1.8 2004/09/18 22:15:00 spestov Exp $
./library/namespaces.factor:! $Id: namespaces.factor,v 1.8 2004/10/10 01:43:13 spestov Exp $
./factor/compiler/CompiledList.java: * $Id: CompiledList.java,v 1.1.1.1 2004/07/16 06:26:09 spestov Exp $
./factor/compiler/TypeInferenceException.java: * $Id: TypeInferenceException.java,v 1.1.1.1 2004/07/16 06:26:10 spestov Exp $
./factor/compiler/StackEffect.java: * $Id: StackEffect.java,v 1.1.1.1 2004/07/16 06:26:10 spestov Exp $
./factor/compiler/Literal.java: * $Id: Literal.java,v 1.1.1.1 2004/07/16 06:26:09 spestov Exp $
./factor/compiler/FactorClassLoader.java:* $Id: FactorClassLoader.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/compiler/FactorClassLoader.java:* $Id: FactorClassLoader.java,v 1.3 2004/08/06 22:40:42 spestov Exp $
./factor/compiler/FactorCompiler.java.new: * $Id: FactorCompiler.java.new,v 1.1.1.1 2004/07/16 06:26:10 spestov Exp $
./factor/compiler/FactorCompilerException.java: * $Id: FactorCompilerException.java,v 1.1.1.1 2004/07/16 06:26:10 spestov Exp $
./factor/compiler/CompiledDefinition.java:* $Id: CompiledDefinition.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/compiler/Result.java: * $Id: Result.java,v 1.1.1.1 2004/07/16 06:26:09 spestov Exp $
@ -113,57 +157,72 @@
./factor/compiler/RecursiveForm.java: * $Id: RecursiveForm.java,v 1.1.1.1 2004/07/16 06:26:08 spestov Exp $
./factor/compiler/AuxiliaryQuotation.java: * $Id: AuxiliaryQuotation.java,v 1.1.1.1 2004/07/16 06:26:09 spestov Exp $
./factor/compiler/CompilerState.java: * $Id: CompilerState.java,v 1.1.1.1 2004/07/16 06:26:09 spestov Exp $
./factor/compiler/FlowObject.java: * $Id: FlowObject.java,v 1.1.1.1 2004/07/16 06:26:10 spestov Exp $
./factor/compiler/FlowObject.java: * $Id: FlowObject.java,v 1.2 2004/09/07 02:39:10 spestov Exp $
./factor/FactorPrimitiveDefinition.java: * $Id: FactorPrimitiveDefinition.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/math/Complex.java: * $Id: Complex.java,v 1.1.1.1 2004/07/16 06:26:13 spestov Exp $
./factor/math/FactorNumber.java: * $Id: FactorNumber.java,v 1.1.1.1 2004/07/16 06:26:12 spestov Exp $
./factor/math/NumberParser.java: * $Id: NumberParser.java,v 1.1.1.1 2004/07/16 06:26:12 spestov Exp $
./factor/math/NumberParser.java: * $Id: NumberParser.java,v 1.2 2004/08/07 22:45:47 spestov Exp $
./factor/math/Ratio.java: * $Id: Ratio.java,v 1.1.1.1 2004/07/16 06:26:13 spestov Exp $
./factor/math/FactorMath.java: * $Id: FactorMath.java,v 1.1.1.1 2004/07/16 06:26:13 spestov Exp $
./factor/math/FactorMath.java: * $Id: FactorMath.java,v 1.2 2004/08/26 23:37:16 spestov Exp $
./factor/FactorExternalizable.java: * $Id: FactorExternalizable.java,v 1.1.1.1 2004/07/16 06:26:06 spestov Exp $
./factor/FactorJava.java: * $Id: FactorJava.java,v 1.1.1.1 2004/07/16 06:26:06 spestov Exp $
./factor/FactorDocComment.java: * $Id: FactorDocComment.java,v 1.1.1.1 2004/07/16 06:26:05 spestov Exp $
./factor/FactorArray.java: * $Id: FactorArray.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/FactorLib.java: * $Id: FactorLib.java,v 1.1.1.1 2004/07/16 06:26:04 spestov Exp $
./factor/FactorDocComment.java: * $Id: FactorDocComment.java,v 1.2 2004/08/18 02:08:35 spestov Exp $
./factor/FactorArray.java: * $Id: FactorArray.java,v 1.5 2004/09/27 01:34:24 spestov Exp $
./factor/FactorCompoundDefinition.java.new:* $Id: FactorCompoundDefinition.java.new,v 1.1.1.1 2004/07/16 06:26:04 spestov Exp $
./factor/FactorSymbolDefinition.java:* $Id: FactorSymbolDefinition.java,v 1.1 2004/10/05 03:06:14 spestov Exp $
./factor/FactorLib.java: * $Id: FactorLib.java,v 1.7 2004/09/07 02:39:10 spestov Exp $
./factor/FactorRuntimeException.java: * $Id: FactorRuntimeException.java,v 1.1.1.1 2004/07/16 06:26:06 spestov Exp $
./factor/ReadTable.java: * $Id: ReadTable.java,v 1.1.1.1 2004/07/16 06:26:03 spestov Exp $
./factor/FactorReader.java: * $Id: FactorReader.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/ReadTable.java: * $Id: ReadTable.java,v 1.4 2004/09/06 00:14:36 spestov Exp $
./factor/FactorReader.java: * $Id: FactorReader.java,v 1.9 2004/09/04 07:06:53 spestov Exp $
./factor/FactorStackException.java: * $Id: FactorStackException.java,v 1.1.1.1 2004/07/16 06:26:06 spestov Exp $
./factor/FactorUndefinedWordException.java: * $Id: FactorUndefinedWordException.java,v 1.1.1.1 2004/07/16 06:26:05 spestov Exp $
./factor/FactorParsingDefinition.java: * $Id: FactorParsingDefinition.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/FactorNamespace.java: * $Id: FactorNamespace.java,v 1.1.1.1 2004/07/16 06:26:05 spestov Exp $
./factor/FactorNamespace.java: * $Id: FactorNamespace.java,v 1.3 2004/09/25 03:22:43 spestov Exp $
./factor/PublicCloneable.java: * $Id: PublicCloneable.java,v 1.1.1.1 2004/07/16 06:26:06 spestov Exp $
./factor/Cons.java: * $Id: Cons.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/FactorCompoundDefinition.java:* $Id: FactorCompoundDefinition.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/FactorCompoundDefinition.java:* $Id: FactorCompoundDefinition.java,v 1.3 2004/08/06 22:40:41 spestov Exp $
./factor/FactorObject.java: * $Id: FactorObject.java,v 1.1.1.1 2004/07/16 06:26:03 spestov Exp $
./factor/parser/PassThrough.java: * $Id: PassThrough.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/ComplexLiteral.java: * $Id: ComplexLiteral.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/ComplexLiteral.java: * $Id: ComplexLiteral.java,v 1.3 2004/08/16 02:45:08 spestov Exp $
./factor/parser/Base.java: * $Id: Base.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Symbol.java: * $Id: Symbol.java,v 1.1 2004/10/05 03:06:18 spestov Exp $
./factor/parser/NoParsing.java: * $Id: NoParsing.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/StringLiteral.java: * $Id: StringLiteral.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Bar.java: * $Id: Bar.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Def.java: * $Id: Def.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Def.java: * $Id: Def.java,v 1.6 2004/08/20 06:08:19 spestov Exp $
./factor/parser/F.java: * $Id: F.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/CharLiteral.java: * $Id: CharLiteral.java,v 1.3 2004/07/22 23:48:49 spestov Exp $
./factor/parser/CharLiteral.java: * $Id: CharLiteral.java,v 1.5 2004/10/03 20:07:47 spestov Exp $
./factor/parser/Shuffle.java: * $Id: Shuffle.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/LineComment.java: * $Id: LineComment.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/T.java: * $Id: T.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/StackComment.java: * $Id: StackComment.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Dispatch.java: * $Id: Dispatch.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Use.java: * $Id: Use.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Use.java: * $Id: Use.java,v 1.3 2004/08/16 02:45:08 spestov Exp $
./factor/parser/EndVector.java: * $Id: EndVector.java,v 1.1 2004/08/10 23:53:52 spestov Exp $
./factor/parser/Ket.java: * $Id: Ket.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Defer.java: * $Id: Defer.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Ine.java: * $Id: Ine.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Unreadable.java: * $Id: Unreadable.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/Ine.java: * $Id: Ine.java,v 1.3 2004/08/17 03:52:49 spestov Exp $
./factor/parser/Bra.java: * $Id: Bra.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/In.java: * $Id: In.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/parser/In.java: * $Id: In.java,v 1.3 2004/08/16 02:45:08 spestov Exp $
./factor/parser/BeginVector.java: * $Id: BeginVector.java,v 1.1 2004/08/10 23:53:52 spestov Exp $
./factor/listener/EvalListener.java: * $Id: EvalListener.java,v 1.1.1.1 2004/07/16 06:26:11 spestov Exp $
./factor/listener/FactorListener.java: * $Id: FactorListener.java,v 1.1.1.1 2004/07/16 06:26:11 spestov Exp $
./factor/listener/FactorDesktop.java: * $Id: FactorDesktop.java,v 1.1.1.1 2004/07/16 06:26:11 spestov Exp $
./factor/FactorInterpreter.java: * $Id: FactorInterpreter.java,v 1.6 2004/07/22 23:48:49 spestov Exp $
./factor/listener/FactorListenerPanel.java: * $Id: FactorListenerPanel.java,v 1.3 2004/08/22 23:01:40 spestov Exp $
./factor/listener/FactorListener.java: * $Id: FactorListener.java,v 1.8 2004/09/03 20:54:58 spestov Exp $
./factor/listener/FactorDesktop.java: * $Id: FactorDesktop.java,v 1.3 2004/08/08 21:20:53 spestov Exp $
./factor/FactorInterpreter.java: * $Id: FactorInterpreter.java,v 1.20 2004/10/05 03:06:14 spestov Exp $
./factor/FactorDomainException.java: * $Id: FactorDomainException.java,v 1.1.1.1 2004/07/16 06:26:06 spestov Exp $
./factor/FactorWord.java: * $Id: FactorWord.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/FactorWordDefinition.java: * $Id: FactorWordDefinition.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./factor/FactorWord.java: * $Id: FactorWord.java,v 1.6 2004/10/03 20:07:47 spestov Exp $
./factor/FactorWordDefinition.java.new: * $Id: FactorWordDefinition.java.new,v 1.1.1.1 2004/07/16 06:26:04 spestov Exp $
./factor/jedit/FactorAsset.java: * $Id: FactorAsset.java,v 1.3 2004/09/04 05:05:49 spestov Exp $
./factor/jedit/FactorParsedData.java: * $Id: FactorParsedData.java,v 1.3 2004/09/04 05:05:49 spestov Exp $
./factor/jedit/RestartableFactorScanner.java: * $Id: RestartableFactorScanner.java,v 1.1 2004/08/17 03:52:49 spestov Exp $
./factor/jedit/FactorSideKickParser.java: * $Id: FactorSideKickParser.java,v 1.12 2004/09/04 05:05:49 spestov Exp $
./factor/jedit/EditWordDialog.java: * $Id: EditWordDialog.java,v 1.2 2004/09/04 05:05:49 spestov Exp $
./factor/jedit/FactorPlugin.java: * $Id: FactorPlugin.java,v 1.15 2004/09/27 00:16:01 spestov Exp $
./factor/jedit/FactorCompletion.java: * $Id: FactorCompletion.java,v 1.6 2004/09/04 05:05:49 spestov Exp $
./factor/jedit/WordPreview.java: * $Id: WordPreview.java,v 1.2 2004/09/04 05:05:49 spestov Exp $
./factor/jedit/WordListDialog.java: * $Id: WordListDialog.java,v 1.2 2004/09/04 05:05:49 spestov Exp $
./factor/jedit/FactorWordRenderer.java: * $Id: FactorWordRenderer.java,v 1.9 2004/10/07 01:03:54 spestov Exp $
./factor/jedit/InsertUseDialog.java: * $Id: InsertUseDialog.java,v 1.3 2004/09/04 05:05:49 spestov Exp $
./factor/FactorWordDefinition.java: * $Id: FactorWordDefinition.java,v 1.3 2004/08/08 06:32:56 spestov Exp $
./factor/primitives/JVarGetStatic.java: * $Id: JVarGetStatic.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/primitives/Unstack.java: * $Id: Unstack.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/primitives/JInvoke.java: * $Id: JInvoke.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
@ -178,7 +237,10 @@
./factor/primitives/Coerce.java: * $Id: Coerce.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/primitives/JVarSetStatic.java: * $Id: JVarSetStatic.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/primitives/JVarGet.java: * $Id: JVarGet.java,v 1.2 2004/07/19 20:10:18 spestov Exp $
./factor/FactorScanner.java: * $Id: FactorScanner.java,v 1.1.1.1 2004/07/16 06:26:03 spestov Exp $
./factor/FactorParseException.java: * $Id: FactorParseException.java,v 1.1.1.1 2004/07/16 06:26:06 spestov Exp $
./factor/FactorScanner.java: * $Id: FactorScanner.java,v 1.6 2004/10/03 20:07:47 spestov Exp $
./factor/FactorParseException.java: * $Id: FactorParseException.java,v 1.3 2004/08/13 22:43:03 spestov Exp $
./factor/FactorException.java: * $Id: FactorException.java,v 1.1.1.1 2004/07/16 06:26:06 spestov Exp $
./factor/FactorShuffleDefinition.java: * $Id: FactorShuffleDefinition.java,v 1.2 2004/07/19 20:10:17 spestov Exp $
./native/s48_bignum.c:$Id: s48_bignum.c,v 1.6 2004/08/29 19:56:30 spestov Exp $
./native/s48_bignumint.h:$Id: s48_bignumint.h,v 1.7 2004/08/29 05:04:42 spestov Exp $
./native/s48_bignum.h:$Id: s48_bignum.h,v 1.5 2004/08/28 03:20:10 spestov Exp $

1
Factor.manifest Normal file
View File

@ -0,0 +1 @@
Main-Class: factor.listener.FactorDesktop

5
META-INF/MANIFEST.MF
View File

@ -1,5 +0,0 @@
Manifest-Version: 1.0
Created-By: 1.4.2-p6-slava_18_jan_2004_13_00 (Sun Microsystems Inc.)
Ant-Version: Apache Ant 1.5.4
Main-Class: factor.listener.FactorDesktop

58
Makefile Normal file
View File

@ -0,0 +1,58 @@
CC = gcc
DEFAULT_CFLAGS = -Os -Wall -export-dynamic -fomit-frame-pointer
DEFAULT_LIBS = -lm
STRIP = strip
OBJS = native/arithmetic.o native/array.o native/bignum.o \
native/s48_bignum.o \
native/complex.o native/cons.o native/error.o \
native/factor.o native/file.o native/fixnum.o \
native/float.o native/gc.o \
native/image.o native/io.o native/memory.o \
native/misc.o native/port.o native/primitives.o \
native/ratio.o native/read.o native/relocate.o \
native/run.o \
native/sbuf.o native/socket.o native/stack.o \
native/string.o native/types.o native/vector.o \
native/write.o native/word.o native/compiler.o \
native/ffi.o
default:
@echo "Run 'make' with one of the following parameters:"
@echo ""
@echo "bsd"
@echo "linux"
@echo "solaris"
@echo ""
@echo "Also, you might want to set the SITE_CFLAGS environment"
@echo "variable to enable some CPU-specific optimizations; this"
@echo "can make a huge difference. Eg:"
@echo ""
@echo "export SITE_CFLAGS=\"-march=pentium4 -ffast-math\""
bsd:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS) -DFFI -pthread" \
LIBS="$(DEFAULT_LIBS)"
linux:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS) -DFFI" \
LIBS="$(DEFAULT_LIBS) -ldl"
solaris:
$(MAKE) f \
CFLAGS="$(DEFAULT_CFLAGS)" \
LIBS="$(DEFAULT_LIBS) -lsocket -lnsl -lm"
f: $(OBJS)
$(CC) $(LIBS) $(CFLAGS) -o $@ $(OBJS)
$(STRIP) $@
clean:
rm -f $(OBJS)
.c.o:
$(CC) -c $(CFLAGS) -o $@ $<

59
README.SRC.txt Normal file
View File

@ -0,0 +1,59 @@
FACTOR
This source archive contains sources for two distinct
bodies of code -- a Factor interpreter written in Java,
and a Factor interpreter written in C. The C interpreter
is a more recent development than the Java interpreter.
They both share a large body of library code written in
Factor.
Java interpreter
----------------
The Java interpreter includes a slick GUI with hyperlinked
inspection of source code, as well as stack effect checking.
build.xml - Ant buildfile for Java interpreter.
factor/ - source code for Factor interpreter written in Java.
org/objectweb/asm/ - helper library for Java interpreter.
library/platform/jvm - JVM-specific Factor code
Factor.jar - compiled, stand-alone Java interpreter
C interpreter
-------------
The C interpreter is a minimal implementation, with the goal
of achieving the highest possible flexibility/lines of code
ratio. It runs faster than the Java interpreter, and uses
far less memory.
Makefile - Makefile for building C interpreter.
native/ - source code for Factor interpreter written in C.
library/platform/native - C interpreter-specific code
f - compiled C interpreter - needs image to run
boot.image.le - image for x86
boot.image.be - image for 32-bit SPARC and 32-bit PowerPC
Notes on the C interpreter
--------------------------
When you run the interpreter with a boot image, it loads a
bunch of files and saves a 'factor.image'. Run the
interpreter again with this image.
At the moment it assumes a 32-bit architecture. Your C
compiler's types must be as follows:
short - signed 16 bits
long - signed 32 bits
long long - signed 64 bits
double -IEEE double precision 64-bit float
Moving to 64-bits would require a few changes in the image
cross-compiler, namely in the way it packs strings.
Not everything has been implemented yet. However, a lot
already works. Compare the output of this in the C and
Java interpreters to see how they differ:
"vocabularies" get describe

225
README.txt Normal file
View File

@ -0,0 +1,225 @@
THE CONCATENATIVE LANGUAGE FACTOR
* Introduction
Factor supports various data types; atomic types include numbers of
various kinds, strings of characters, and booleans. Compound data types
include lists consisting of cons cells, vectors, and string buffers.
Factor encourages programming in a functional style where new objects
are returned and input parameters remain unmodified, but does not
enforce this. No manifest type declarations are necessary, and all data
types use exactly one slot each on the stack (unlike, say, FORTH).
The internal representation of a Factor program is a linked list. Linked
lists that are to be executed are referred to as ``quotations.'' The
interpreter iterates the list, executing words, and pushing all other
types of objects on the data stack. A word is a unique data type because
it can be executed. Words come in two varieties: primitive and compound.
Primitive words have an implementation coded in the host language (C or
Java). Compound words are executed by invoking the interpreter
recursively on their definition, which is also a linked list.
* A note about code examples
Factor words are separated out into multiple ``vocabularies''. Each code
example given here is preceeded with a series of declarations, such as
the following:
USE: math
USE: streams
When entering code at the interactive interpreter loop, most
vocabularies are already in the search path, and the USE: declarations
can be omitted. However, in a source file they must all be specified, by convention at the beginning of the file.
* Control flow
Control flow rests on two basic concepts: recursion, and branching.
Words with compound definitions may refer to themselves, and there is
exactly one primitive for performing conditional execution:
USE: combinators
1 10 < [ "1 is less than 10." print ] [ "whoa!" print ] ifte
==> 1 is less than 10.
Here is an example of a word that uses these two concepts:
: contains? ( element list -- remainder )
#! If the proper list contains the element, push the
#! remainder of the list, starting from the cell whose car
#! is elem. Otherwise push f.
dup [
2dup car = [ nip ] [ cdr contains? ] ifte
] [
2drop f
] ifte ;
An example:
USE: lists
3 [ 1 2 3 4 ] contains?
==> [ 3 4 ]
5 [ 1 2 3 4 ] contains?
==> f
It recurses down the list, until it reaches the end, in which case the
outer ifte's 'false' branch is executed.
A quick overview of the words used here, along with their stack effects:
Shuffle words:
dup ( x -- x x )
nip ( x y -- y )
2dup ( x y -- x y x y )
2drop ( x y -- )
Linked list deconstruction:
car ( [ x | y ] -- x )
cdr ( [ x | y ] -- y ) - push the "tail" of a list.
Equality:
= ( x y -- ? )
More complicated control flow constructs, such as loops and higher order
functions, are usually built with the help of another primitive that
simply executes a quotation at the top of the stack, removing it from
the stack:
USE: math
USE: prettyprint
[ 2 2 + . ] call
==> 4
Here is an example of a word that applies a quotation to each element of
a list. Note that it uses 'call' to execute the given quotation:
: each ( list quotation -- )
#! Push each element of a proper list in turn, and apply a
#! quotation to each element.
#!
#! In order to compile, the quotation must consume one more
#! value than it produces.
over [
>r uncons r> tuck >r >r call r> r> each
] [
2drop
] ifte ;
An example:
USE: lists
USE: math
USE: stack
[ 1 2 3 4 ] [ dup * . ] each
==> 1
4
9
16
A quick overview of the words used here:
Printing top of stack:
. ( x -- ) print top of stack in a form that is valid Factor syntax.
Shuffle words:
over ( x y -- x y x )
tuck ( x y -- y x y )
>r ( x -- r:x ) - move top of data stack to/from 'extra hand'.
r> ( r:x -- x )
Writing >r foo r> is analogous to '[ foo ] dip' in Joy. Occurrences of
>r and r> must be balanced within a single word definition.
Linked list deconstruction:
uncons ( [ x | y ] -- x y )
* Variables
Factor supports a notion of ``variables''. Whereas the stack is used for
transient, intermediate values, variables are used for more permanent
data.
Variables are retreived and stored using the 'get' and 'set' words. For
example:
USE: math
USE: namespaces
USE: prettyprint
"~" get .
==> "/home/slava"
5 "x" set
"x" get 2 * .
==> 10
The set of available variables is determined using ``dynamic scope''.
A ``namespace'' is a set of variable name/value pairs. Namespaces can be
pushed onto the ``name stack'', and later popped. The 'get' word
searches all namespaces on the namestack in turn. The 'set' word stores
a variable value into the namespace at the top of the name stack.
While it is possible to push/pop the namestack directly using the words
>n and n>, most of the time using the 'bind' combinator is more
desirable.
Good examples of namespace use are found in the I/O system.
Factor provides two sets of words for working with I/O streams: words
whose stream operand is specified on the stack (freadln, fwrite,
fprint...) and words that use the standard input/output stream (read,
write, print...).
An I/O stream is a namespace with a slot for each I/O operation. I/O
operations taking an explicit stream operand are all defined as follows:
: freadln ( stream -- string )
[ "freadln" get call ] bind ;
: fwrite ( string stream -- )
[ "fwrite" get call ] bind ;
: fclose ( stream -- )
[ "fclose" get call ] bind ;
( ... et cetera )
The second set of I/O operations, whose stream is the implicit 'standard
input/output' stream, are defined as follows:
: read ( -- string )
"stdio" get freadln ;
: write ( string -- )
"stdio" get fwrite ;
( ... et cetera )
In the global namespace, the 'stdio' variable corresponds to a stream
whose operations read/write from the standard file descriptors 0 and 1.
However, the 'with-stream' combinator provides a way to rebind the
standard input/output stream for the duration of the execution of a
single quotation. The following example writes the source of a word
definition to a file named 'definition.txt':
USE: prettyprint
USE: streams
"definition.txt" <filebw> [ "with-stream" see ] with-stream
The 'with-stream' word is implemented by pushing a new namespace on the
namestack, setting the 'stdio' variable therein, and execution the given
quotation.

141
TODO.FACTOR.txt Normal file
View File

@ -0,0 +1,141 @@
FFI:
- is signed -vs- unsigned pointers an issue?
- command line parsing cleanup
- BIN: 2: bad
- compile word twice; no more 'cannot compile' error!
- doc comments in assoc, image, inferior
- styles - could use some cleanup
- list - trim down
- move quadratic and simpson to contrib
- init-assembler called twice
- compiler: drop literal peephole optimization
- compiling when*
- compiling unless*
- getenv/setenv: if literal arg, compile as a load/store
- inline words
[error] SideKick$BufferChangeHandler: We have cplusplus.xml (/home/slava/jEdit/modes/) but got event for DefaultInputHandler.java (/home/slava/jEdit/org/gjt/sp/jedit/gui/)
[error] SideKick$BufferChangeHandler: We have cplusplus.xml (/home/slava/jEdit/modes/) but got event for DefaultInputHandler.java (/home/slava/jEdit/org/gjt/sp/jedit/gui/)
[error] AWT-EventQueue-0: java.lang.ArrayIndexOutOfBoundsException: Array index out of range: 98
[error] AWT-EventQueue-0: at org.gjt.sp.jedit.Buffer.getLineOfOffset(Buffer.java:882)
[error] AWT-EventQueue-0: at errorlist.DefaultErrorSource$DefaultError.getLineNumber(Unknown Source)
[error] AWT-EventQueue-0: at errorlist.DefaultErrorSource.getLineErrors(Unknown Source)
[error] AWT-EventQueue-0: at errorlist.ErrorOverview.paintComponent(Unknown Source)
[error] EditBus: Exception while sending message on EditBus:
[error] EditBus: java.lang.ArrayIndexOutOfBoundsException: Array index out of range: 98
[error] EditBus: at org.gjt.sp.jedit.Buffer.getLineOfOffset(Buffer.java:882)
[error] EditBus: at errorlist.DefaultErrorSource$DefaultError.getLineNumber(Unknown Source)
[error] EditBus: at errorlist.ErrorList$ErrorCellRenderer.getTreeCellRendererComponent(Unknown Source)
[error] EditBus: at javax.swing.plaf.basic.BasicTreeUI$NodeDimensionsHandler.getNodeDimensions(BasicTreeUI.java:2751)
[error] EditBus: Exception while sending message on EditBus:
[error] EditBus: java.lang.ArrayIndexOutOfBoundsException: Array index out of range: 98
[error] EditBus: at org.gjt.sp.jedit.Buffer.getLineOfOffset(Buffer.java:882)
[error] EditBus: at errorlist.DefaultErrorSource$DefaultError.getLineNumber(Unknown Source)
[error] EditBus: at errorlist.ErrorList$ErrorCellRenderer.getTreeCellRendererComponent(Unknown Source)
[error] EditBus: at javax.swing.plaf.basic.BasicTreeUI$NodeDimensionsHandler.getNodeDimensions(BasicTreeUI.java:2751)
[error] EditBus: at javax.swing.tree.AbstractLayoutCache.getNodeDimensions(AbstractLayoutCache.java:475)
- perhaps /i should work with all numbers
- profiler is inaccurate: wrong word on cs
- buffer change handler in sidekick is screwed
- dec> bin> oct> hex> throw errors
- parse-number doesn't
- eval with multilien strings and #!
- quit responder breaks with multithreading
- nicer way to combine two paths
- don't show listener on certain commands
- plugin should not exit jEdit on fatal errors
- wordpreview: don't show for string literals and comments
- alist -vs- assoc terminology
- file responder: don't show full path in title
- clean up listener's action popups
- jedit ==> jedit-word, jedit takes a file name
- add a socket timeout
- fix error postoning -- not all errors thrown by i/o code are
postponed
- some way to run httpd from command line
+ bignums:
- move some s48_ functions into bignum.c
- remove unused functions
- >lower, >upper for strings
- accept multi-line input in listener
+ docs:
- explain how log uses >polar and rect>
- when* unless*
- simple i/o section
- unparse examples, and difference from prettyprint
- review doc formatting with latex2html
- recursion -vs- iteration in vectors chapter, and combinator
construction
- [, , ,] -- mention that , are usually in nested words
- finish namespaces docs
- mention word accessors/mutators
- to document:
continuations
streams
multitasking
unit testing
+ tests:
- java factor: equal numbers have non-equal hashcodes!
- FactorLib.equal() not very good
- investigate mandel.factor
+ listener/plugin:
- NPE in ErrorHighlight
- some way to not have previous definitions from a source file
clutter the namespace
- use inferior.factor for everything not just listener
- fedit broken with listener
- maple-like: press enter at old commands to evaluate there
- input style after clicking link
- listener backspace overzealous
- completion in the listener
- special completion for USE:/IN:
- inspector links when describe called without object path
+ native:
- better i/o scheduler
+ JVM compiler:
- compiled stack traces broken
- save classes to disk
- tail call optimization broken again
- don't compile inline words
- recursive words with code after ifte
- less unnecessary args to auxiliary methods
- inlining tail-recursive immediates
- direct stack access leaks memory on stack
- unnecessary local allocation: max is instance var, but several methods
get compiled.
+ misc:
- don't rehash strings on every startup
- 'cascading' styles
- ditch expand
+ httpd:
- wiki responder:
- port to native
- text styles
- log with date
basic authentication, using httpdAuth function from a config file
- file responder; last-modified field

74
actions.xml Normal file
View File

@ -0,0 +1,74 @@
<?xml version="1.0"?>
<!DOCTYPE ACTIONS SYSTEM "actions.dtd">
<ACTIONS>
<ACTION NAME="factor-eval-selection">
<CODE>
sel = textArea.selectedText;
if(sel == null)
view.toolkit.beep();
else
FactorPlugin.eval(view,sel);
</CODE>
</ACTION>
<ACTION NAME="factor-run-file">
<CODE>
buffer.save(view,null);
VFSManager.waitForRequests();
FactorPlugin.eval(view,
"\""
+ FactorReader.charsToEscapes(buffer.path)
+ "\" run-file");
</CODE>
</ACTION>
<ACTION NAME="factor-apropos">
<CODE>
word = FactorPlugin.getWordAtCaret(textArea);
if(word == null)
view.toolkit.beep();
else
{
FactorPlugin.eval(view,
"\""
+ FactorReader.charsToEscapes(word)
+ "\" apropos.");
}
</CODE>
</ACTION>
<ACTION NAME="factor-see">
<CODE>
FactorPlugin.factorWordOperation(view,"see");
</CODE>
</ACTION>
<ACTION NAME="factor-edit">
<CODE>
FactorPlugin.factorWordOperation(view,"jedit");
</CODE>
</ACTION>
<ACTION NAME="factor-edit-dialog">
<CODE>
new EditWordDialog(view,FactorPlugin
.getSideKickParser());
</CODE>
</ACTION>
<ACTION NAME="factor-usages">
<CODE>
FactorPlugin.factorWordOperation(view,"usages.");
</CODE>
</ACTION>
<ACTION NAME="factor-insert-use">
<CODE>
word = FactorPlugin.getWordAtCaret(textArea);
if(word == null)
view.toolkit.beep();
else
FactorPlugin.insertUseDialog(view,word);
</CODE>
</ACTION>
<ACTION NAME="factor-extract-word">
<CODE>
FactorPlugin.extractWord(view);
</CODE>
</ACTION>
</ACTIONS>

BIN
boot.image.be32 Normal file
View File

Binary file not shown.

BIN
boot.image.be64 Normal file
View File

Binary file not shown.

BIN
boot.image.le32 Normal file
View File

Binary file not shown.

BIN
boot.image.le64 Normal file
View File

Binary file not shown.

99
build.xml Normal file
View File

@ -0,0 +1,99 @@
<?xml version="1.0"?>
<project name=" Factor" default="dist" basedir=".">
<target name="init">
<available property="jedit" classname="org.gjt.sp.jedit.jEdit" />
</target>
<target name="compile" depends="init">
<javac
srcdir="."
destdir="."
deprecation="on"
includeJavaRuntime="yes"
debug="true"
optimize="true"
>
<include name="**/*.java"/>
<exclude name="factor/jedit/*.java"/>
</javac>
</target>
<path id="jedit-classpath">
<pathelement location="${user.home}/.jedit/jars/ErrorList.jar" />
<pathelement location="${user.home}/.jedit/jars/SideKick.jar" />
</path>
<target name="compile-jedit" depends="init" if="jedit">
<javac
classpathref="jedit-classpath"
debug="true"
deprecation="on"
destdir="."
optimize="true"
srcdir=".">
<include name="factor/jedit/*.java"/>
</javac>
</target>
<target name="dist" depends="compile,compile-jedit">
<jar
jarfile="Factor.jar"
manifest="Factor.manifest"
compress="true"
>
<fileset dir=".">
<include name="factor/*.class"/>
<include name="factor/**/*.class"/>
<include name="factor/**/*.props"/>
<include name="factor/**/*.bsh"/>
<include name="factor/**/*.txt"/>
<include name="*.xml"/>
<include name="library/**/*.factor"/>
<include name="library/**/*.txt"/>
<include name="library/**/*.png"/>
<include name="org/**/*.class"/>
<include name="*.factor"/>
<include name="doc/**/*.html"/>
<include name="doc/**/*.png"/>
<include name="doc/*.html"/>
<include name="Factor.manifest"/>
</fileset>
</jar>
</target>
<target name="dist-jedit" depends="dist">
<copy file="Factor.jar" tofile="../Factor.jar" />
</target>
<target name="clean" description="Clean old stuff.">
<delete>
<fileset dir="." includes="**/*.class"/>
<fileset dir="." includes="**/*~" defaultexcludes="no"/>
<fileset dir="." includes="**/#*#" defaultexcludes="no"/>
<fileset dir="." includes="**/*.rej"/>
<fileset dir="." includes="**/*.orig"/>
<fileset dir="." includes="**/.*.swp"/>
<fileset dir="." includes="**/.#*"/>
<fileset dir="." includes="**/.new*"/>
<fileset dir="." includes="**/.directory"/>
</delete>
</target>
<target name="docs" description="Build PDF and HTML docs.">
<delete>
<fileset dir="." includes="doc/devel-guide/*.html"/>
<fileset dir="." includes="doc/devel-guide.aux"/>
<fileset dir="." includes="doc/devel-guide.log"/>
<fileset dir="." includes="doc/devel-guide.pdf"/>
</delete>
<exec executable="latex" dir="doc">
<arg value="devel-guide.tex" />
</exec>
<exec executable="latex2html" dir="doc">
<arg value="-local_icons"/>
<arg value="devel-guide.tex" />
</exec>
</target>
</project>

236
contrib/cont-responder/browser.factor Normal file
View File

@ -0,0 +1,236 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! An Smalltalk-link browser that runs in the httpd server using
! cont-responder facilities.
!
IN: browser
USE: cont-html
USE: cont-responder
USE: cont-utils
USE: stack
USE: stdio
USE: combinators
USE: namespaces
USE: words
USE: lists
USE: streams
USE: strings
USE: inspector
USE: kernel
USE: prettyprint
USE: words
USE: html
USE: parser
USE: errors
USE: unparser
USE: logging
: <browser> ( allow-edit? vocab word -- )
#! An object for storing the current browser
#! user interface state.
<namespace> [
"current-word" set
"current-vocab" set
"allow-edit?" set
] extend ;
: write-vocab-list ( -- )
#! Write out the HTML for the list of vocabularies
<select name= "vocabs" style= "width: 200" size= "20" onchange= "document.forms.main.submit()" select>
vocabs [
dup "current-vocab" get [ "" ] unless* = [
"<option selected>" write
] [
"<option>" write
] ifte
chars>entities write
"</option>\n" write
] each
</select> ;
: write-word-list ( vocab -- )
#! Write out the HTML for the list of words in a vocabulary.
<select name= "words" style= "width: 200" size= "20" onchange= "document.forms.main.submit()" select>
words [
word-name dup "current-word" get [ "" ] unless* str-compare 0 = [
"<option selected>" write
] [
"<option>" write
] ifte
chars>entities write
"</option>\n" write
] each
</select> ;
: write-editable-word-source ( vocab word -- )
#! Write the source in a manner allowing it to be edited.
<textarea name= "eval" rows= "30" cols= "80" textarea>
1024 <string-output-stream> dup >r [
>r words r> swap [ over swap dup word-name rot = [ see ] [ drop ] ifte ] each drop
] with-stream r> stream>str chars>entities write
</textarea> <br/>
"Accept" button ;
: write-word-source ( vocab word -- )
#! Write the source for the given word from the vocab as HTML.
<namespace> [
"responder" "inspect" put
"allow-edit?" get [ "Edit" [ "edit-state" t put ] quot-href <br/> ] when
"edit-state" get [
write-editable-word-source
] [
[
>r words r> swap [ over swap dup word-name rot = [ see ] [ drop ] ifte ] each drop
] with-simple-html-output
] ifte
] bind drop ;
: write-vm-statistics ( -- )
#! Display statistics about the JVM in use.
room swap unparse >r unparse r>
<table>
<tr>
<td> "Free Memory" write </td>
<td> write </td>
</tr>
<tr>
<td> "Total Memory" write </td>
<td> write </td>
</tr>
</table> ;
: write-browser-body ( -- )
#! Write out the HTML for the body of the main browser page.
<table width= "100%" table>
<tr>
<td> "<b>Vocabularies</b>" write </td>
<td> "<b>Words</b>" write </td>
<td> "<b>Source</b>" write </td>
</tr>
<tr>
<td valign= "top" style= "width: 200" td> write-vocab-list </td>
<td valign= "top" style= "width: 200" td> "current-vocab" get write-word-list </td>
<td valign= "top" td> "current-vocab" get "current-word" get write-word-source </td>
</tr>
</table>
write-vm-statistics ;
: flatten ( tree - list )
#! Flatten a tree into a list.
dup f = [
] [
dup cons? [
dup car flatten swap cdr flatten append
] [
[ ] cons
] ifte
] ifte ;
: word-uses ( word -- list )
#! Return a list of vocabularies that the given word uses.
word-parameter flatten [ word? ] subset [
word-vocabulary
] map ;
: vocabulary-uses ( vocab -- list )
#! Return a list of vocabularies that all words in a vocabulary
#! uses.
<namespace> [
"result" f put
words [
word-uses [
"result" unique@
] each
] each
"result" get
] bind ;
: build-eval-string ( vocab to-eval -- string )
#! Build a string that can evaluate the string 'to-eval'
#! by first doing an 'IN: vocab' and a 'USE:' of all
#! necessary vocabs for existing words in that vocab.
<% >r "IN: " % dup % "\n" %
vocabulary-uses [ "USE: " % % "\n" % ] each
r> % "\n" % %> ;
: show-parse-error ( error -- )
#! Show an error page describing the parse error.
[
<html>
<head> <title> "Parse error" write </title> </head>
<body>
swap [ write ] with-simple-html-output
<a href= a> "Ok" write </a>
</body>
</html>
] show drop drop ;
: eval-string ( vocab to-eval -- )
#! Evaluate the 'to-eval' within the given vocabulary.
build-eval-string [
parse call
] [
[
show-parse-error
drop
] when*
] catch ;
: browse ( <browser> -- )
#! Display a Smalltalk like browser for exploring/modifying words.
[
[
[
<html>
<head>
<title> "Factor Browser" write </title>
</head>
<body>
<form name= "main" action= method= "post" form>
write-browser-body
</form>
</body>
</html>
] show [
"allow-edit?" get [
"eval" get [
"eval" f put
"Editing has been disabled." show-message-page
] when
] unless
"allow-edit?" get "allow-edit?" set
] extend
] bind [
"allow-edit?" get
"vocabs" get
"words" get
"eval" get dup [ "vocabs" get swap eval-string ] [ drop ] ifte
] bind <browser>
] forever ;
: browser-responder ( allow-edit? -- )
#! Start the Smalltalk-like browser.
"browser" f <browser> browse ;
"browser" [ f browser-responder ] install-cont-responder

123
contrib/cont-responder/cont-examples.factor Normal file
View File

@ -0,0 +1,123 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! Simple test applications
IN: cont-examples
USE: cont-responder
USE: cont-html
USE: stack
USE: stdio
USE: html
USE: lists
USE: strings
USE: math
USE: namespaces
USE: prettyprint
USE: unparser
: display-page ( title -- )
#! Display a page with some text to test the cont-responder.
#! The page has a link to the 'next' continuation.
[
swap [
<a href= a> "Next" write </a>
] html-document
] show drop drop ;
: display-get-name-page ( -- name )
#! Display a page prompting for input of a name and return that name.
[
"Enter your name" [
<form method= "post" action= form>
"Name: " write
<input type= "text" name= "name" size= "20" input/>
<input type= "submit" value= "Ok" input/>
</form>
] html-document
] show [
"name" get
] bind ;
: test-cont-responder ( - )
#! Test the cont-responder responder by displaying a few pages in a row.
"Page one" display-page
"Hello " display-get-name-page cat2 display-page
"Page three" display-page ;
: test-cont-responder2 ( - )
#! Test the cont-responder responder by displaying a few pages in a loop.
[ "one" "two" "three" "four" ] [ display-page [ .s ] with-string-stream display-page ] each
"Done!" display-page ;
: test-cont-responder3 ( - )
#! Test the quot-href word by displaying a menu of the current
#! test words. Note that we drop the 'url' argument to the show
#! quotation as we don't link to a 'next' page.
[
drop
"Menu" [
<ol>
<li> "Test responder1" [ test-cont-responder ] quot-href </li>
<li> "Test responder2" [ [ .s ] with-string-stream display-page test-cont-responder2 [ .s ] with-string-stream display-page ] quot-href </li>
</ol>
] html-document
] show drop ;
: counter-example ( count - )
#! Display a counter which can be incremented or decremented
#! using anchors.
#!
#! Don't need the original alist
[
#! And we don't need the 'url' argument
drop
"Counter: " over unparse cat2 [
dup <h2> unparse write </h2>
"++" over unit [ f ] swap append [ 1 + counter-example ] append quot-href
"--" over unit [ f ] swap append [ 1 - counter-example ] append quot-href
drop
] html-document
] show drop ;
: counter-example2 ( - )
#! Display a counter which can be incremented or decremented
#! using anchors.
#!
0 "counter" set
[
#! We don't need the 'url' argument
drop
"Counter: " "counter" get unparse cat2 [
<h2> "counter" get unparse write </h2>
"++" [ "counter" get 1 + "counter" set ] quot-href
"--" [ "counter" get 1 - "counter" set ] quot-href
] html-document
] show
drop ;
! Install the examples
"counter1" [ drop 0 counter-example ] install-cont-responder
"counter2" [ drop counter-example2 ] install-cont-responder
"test1" [ drop test-cont-responder ] install-cont-responder
"test2" [ drop test-cont-responder2 ] install-cont-responder
"test3" [ drop test-cont-responder3 ] install-cont-responder

217
contrib/cont-responder/cont-html.factor Normal file
View File

@ -0,0 +1,217 @@
! cont-html v0.6
!
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cont-html
USE: strings
USE: lists
USE: format
USE: stack
USE: combinators
USE: stdio
USE: namespaces
USE: words
USE: logic
! These words in cont-html are used to provide a means of writing
! formatted HTML to standard output with a familiar 'html' look
! and feel in the code.
!
! HTML tags can be used in a number of different ways. The highest
! level involves a similar syntax to HTML:
!
! <p> "someoutput" write </p>
!
! <p> will outupt the opening tag and </p> will output the closing
! tag with no attributes.
!
! <p class= "red" p> "someoutput" write </p>
!
! This time the opening tag does not have the '>'. It pushes
! a namespace on the stack to hold the attributes and values.
! Any attribute words used will store the attribute and values
! in that namespace. After the attribute word should come the
! value of that attribute. The next attribute word or
! finishing word (which is the html word followed by '>')
! will actually set the attribute to that value in the namespace.
! The finishing word will print out the operning tag including
! attributes.
! Any writes after this will appear after the opening tag.
!
! Values for attributes can be used directly without any stack
! operations:
!
! (url -- )
! <a href= a> "Click me" write </a>
!
! (url -- )
! <a href= "http://" swap cat2 a> "click" write </a>
!
! (url -- )
! <a href= <% "http://" % % %> a> "click" write </a>
!
! Tags that have no 'closing' equivalent have a trailing tag/> form:
!
! <input type= "text" name= "name" size= "20" input/>
: attrs>string ( alist -- string )
#! Convert the attrs alist to a string
#! suitable for embedding in an html tag.
nreverse <% [ dup car % "='" % cdr % "'" % ] each %> ;
: write-attributes ( n: namespace -- )
#! With the attribute namespace on the stack, get the attributes
#! and write them to standard output. If no attributes exist, write
#! nothing.
"attrs" get [ " " write attrs>string write ] when* ;
: store-prev-attribute ( n: tag value -- )
#! Assumes an attribute namespace is on the stack.
#! Gets the previous attribute that was used (if any)
#! and sets it's value to the current value on the stack.
#! If there is no previous attribute, no value is expected
#! on the stack.
"current-attribute" get [ swons "attrs" cons@ ] when* ;
! HTML tag words
!
! Each closable HTML tag has four words defined. The example below is for
! <p>:
!
! : <p> ( -- )
! #! Writes the opening tag to standard output.
! "<p>" write ;
! : <p ( -- n: <namespace> )
! #! Used for setting inline attributes. Prints out
! #! an unclosed opening tag.
! "<p" write <namespace> >n ;
!
! : p> ( n: <namespace> -- )
! #! Used to close off inline attribute version of word.
! #! Prints out attributes and closes opening tag.
! store-prev-attribute write-attributes n> drop ">" write ;
!
! : </p> ( -- )
! #! Write out the closing tag.
! "</foo>" write ;
!
! Each open only HTML tag has only three words:
!
! : <input/> ( -- )
! #! Used for printing the tag with no attributes.
! "<input>" write ;
!
! : <input ( -- n: <namespace> )
! #! Used for setting inline attributes.
! "<input" write <namespace> >n ;
!
! : input/> ( n: <namespace> -- )
! #! Used to close off inline attribute version of word
! #! and print the tag/
! store-prev-attribute write-attributes n> drop ">" write ;
!
! Each attribute word has the form xxxx= where 'xxxx' is the attribute
! name. The example below is for href:
!
! : href= ( n: <namespace> optional-value -- )
! store-prev-attribute "href" "current-attribute" set ;
: create-word ( vocab name def -- )
#! Define 'word creating' word to allow
#! dynamically creating words.
>r swap create r> define-compound ;
: def-for-html-word-<foo> ( name -- name quot )
#! Return the name and code for the <foo> patterned
#! word.
<% "<" % % ">" % %> dup [ write ] cons ;
: def-for-html-word-<foo ( name -- name quot )
#! Return the name and code for the <foo patterned
#! word.
<% "<" % % %> dup [ write <namespace> >n ] cons ;
: def-for-html-word-foo> ( name -- name quot )
#! Return the name and code for the foo> patterned
#! word.
<% % ">" % %> [ store-prev-attribute write-attributes n> drop ">" write ] ;
: def-for-html-word-</foo> ( name -- name quot )
#! Return the name and code for the </foo> patterned
#! word.
<% "</" % % ">" % %> dup [ write ] cons ;
: def-for-html-word-<foo/> ( name -- name quot )
#! Return the name and code for the <foo/> patterned
#! word.
<% "<" % dup % "/>" % %> swap <% "<" % % ">" % %> [ write ] cons ;
: def-for-html-word-foo/> ( name -- name quot )
#! Return the name and code for the foo/> patterned
#! word.
<% % "/>" % %> [ store-prev-attribute write-attributes n> drop ">" write ] ;
: define-closed-html-word ( name -- )
#! Given an HTML tag name, define the words for
#! that closable HTML tag.
"cont-html" swap
2dup def-for-html-word-<foo> create-word
2dup def-for-html-word-<foo create-word
2dup def-for-html-word-foo> create-word
def-for-html-word-</foo> create-word ;
: define-open-html-word ( name -- )
#! Given an HTML tag name, define the words for
#! that open HTML tag.
"cont-html" swap
2dup def-for-html-word-<foo/> create-word
2dup def-for-html-word-<foo create-word
def-for-html-word-foo/> create-word ;
: define-attribute-word ( name -- )
"cont-html" swap dup "=" cat2 swap
[ store-prev-attribute ] cons reverse [ "current-attribute" set ] append create-word ;
! Define some closed HTML tags
[ "h1" "h2" "h3" "h4" "h5" "h6" "h7" "h8" "h9"
"ol" "li" "form" "a" "p" "html" "head" "body" "title"
"b" "i" "ul" "table" "tr" "td" "th" "pre" "textarea"
"script" "div" "span" "select" "option"
] [ define-closed-html-word ] each
! Define some open HTML tags
[
"input"
"br"
"link"
] [ define-open-html-word ] each
! Define some attributes
[
"method" "action" "type" "value" "name"
"size" "href" "class" "border" "rows" "cols"
"id" "onclick" "style" "valign" "accesskey"
"src" "language" "colspan" "onchange" "rel"
"width"
] [ define-attribute-word ] each

319
contrib/cont-responder/cont-responder.factor Normal file
View File

@ -0,0 +1,319 @@
! cont-responder v0.6
!
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cont-responder
USE: stdio
USE: httpd
USE: httpd-responder
USE: math
USE: random
USE: continuations
USE: format
USE: namespaces
USE: stack
USE: combinators
USE: streams
USE: lists
USE: strings
USE: html
USE: kernel
USE: logic
USE: cont-html
USE: logging
USE: url-encoding
USE: unparser
: expiry-timeout ( -- timeout-seconds )
#! Number of seconds to timeout continuations in
#! continuation table. This value will need to be
#! tuned. I leave it at 24 hours but it can be
#! higher/lower as needed. Default to 1 hour for
#! testing.
3600 ;
: redirect-enabled?
#! Set to true if you want the post-redirect-get pattern
#! implemented. See the redirect-to-here word for details.
t ;
: get-random-id ( -- id )
#! Generate a random id to use for continuation URL's
<% 16 [ random-digit unparse % ] times %> ;
: continuation-table ( -- <namespace> )
#! Return the global table of continuations
"continuation-table" get ;
: reset-continuation-table ( -- )
#! Create the initial global table
<namespace> "continuation-table" set ;
: continuation-item ( expire? quot id -- <item> )
#! A continuation item is the actual item stored
#! in the continuation table. It contains the id,
#! quotation/continuation, time added, etc. If
#! expire? is true then the continuation will
#! be expired after a certain amount of time.
<namespace> [
"id" set
"quot" set
"expire?" set
millis "time-added" set
] extend ;
: seconds>millis ( seconds -- millis )
#! Convert a number of seconds to milliseconds
1000 * ;
: expired? ( timeout-seconds <item> -- bool )
#! Return true if the continuation item is expirable
#! and has expired (ie. was added to the table more than
#! timeout milliseconds ago).
[ seconds>millis "time-added" get + millis - 0 <
"expire?" get and
] bind ;
: continuation-items ( -- alist )
#! Return an alist of all continuation items in the continuation
#! table with the car as the id and the cdr as the item.
continuation-table [ vars-values ] bind ;
: expire-continuations ( timeout-seconds -- )
#! Expire all continuations in the continuation table
#! if they are 'timeout-seconds' old (ie. were added
#! more than 'timeout-seconds' ago.
continuation-items [ cdr dupd expired? not ] subset nip
alist>namespace "continuation-table" set ;
: register-continuation ( expire? quot -- id )
#! Store a continuation in the table and associate it with
#! a random id. That continuation will be expired after
#! a certain period of time if 'expire?' is true.
continuation-table [
get-random-id -rot pick continuation-item over set
] bind ;
: append* ( lists -- list )
#! Given a list of lists, append the lists together
#! and return the concatenated list.
f swap [ append ] each ;
: register-continuation* ( expire? quots -- id )
#! Like register-continuation but registers a quotation
#! that will call all quotations in the list, in the order given.
append* register-continuation ;
: get-continuation-item ( id -- <item> )
#! Get the continuation item associated with the id.
continuation-table [ get ] bind ;
DEFER: show
: expired-page-handler ( alist -- )
#! Display a page has expired message.
#! TODO: Need to handle this better to enable
#! returning back to root continuation.
drop
[
drop
<html>
<body>
<p> "This page has expired." write </p>
</body>
</html>
] show drop ;
: get-registered-continuation ( id -- cont )
#! Return the continuation or quotation
#! associated with the given id.
#! TODO: handle expired pages better.
expiry-timeout expire-continuations
get-continuation-item dup [
[ "quot" get ] bind
] [
drop [ expired-page-handler ]
] ifte ;
: resume-continuation ( value id -- )
#! Call the continuation associated with the given id,
#! with 'value' on the top of the stack.
get-registered-continuation call ;
: exit-continuation ( -- exit )
#! Get the current exit continuation
"exit" get ;
: call-exit-continuation ( value -- )
#! Call the exit continuation, passing it the given value on the
#! top of the stack.
"exit" get call ;
: with-exit-continuation ( quot -- )
#! Call the quotation with the variable "exit" bound such that when
#! the exit continuation is called, computation will resume from the
#! end of this 'with-exit-continuation' call, with the value passed
#! to the exit continuation on the top of the stack.
[ "exit" set call f call-exit-continuation ] callcc1 nip ;
: store-callback-cc ( -- )
#! Store the current continuation in the variable 'callback-cc'
#! so it can be returned to later by callbacks. Note that it
#! recalls itself when the continuation is called to ensure that
#! it resets its value back to the most recent show call.
[ ( 0 -- )
[ ( 0 1 -- )
"callback-cc" set ( 0 -- )
call
] callcc1 ( 0 [ ] == )
nip
call
store-callback-cc
] callcc0 ;
: with-string-stream ( quot -- string )
#! Call the quotation with standard output bound to a string output
#! stream. Return the string on exit.
<namespace> [
"stdio" 1024 <string-output-stream> put call "stdio" get stream>str
] bind ;
: redirect-to-here ( -- )
#! Force a redirect to the client browser so that the browser
#! goes to the current point in the code. This forces an URL
#! change on the browser so that refreshing that URL will
#! immediately run from this code point. This prevents the
#! "this request will issue a POST" warning from the browser
#! and prevents re-running the previous POST logic. This is
#! known as the 'post-refresh-get' pattern.
"disable-initial-redirect?" get [
"disable-initial-redirect?" f put
] [
[
t swap register-continuation
<% "HTTP/1.1 302 Document Moved\nLocation: " % % "\n" %
"Content-Length: 0\nContent-Type: text/plain\n\n" % %>
call-exit-continuation
] callcc1 drop
] ifte ;
: show ( quot -- namespace )
#! Call the quotation with the URL associated with the current
#! continuation. Return the HTML string generated by that code
#! to the exit continuation. When the URL is later referenced then
#! computation will resume from this 'show' call with a namespace on
#! the stack containing any query or post parameters.
#! NOTE: On return from 'show' the stack is exactly the same as
#! initial entry with 'quot' popped off an <namespace> put on. Even
#! if the quotation consumes items on the stack.
store-callback-cc
redirect-enabled? [ redirect-to-here ] when
[
t swap register-continuation swap
[ serving-html ] car swons with-string-stream
call-exit-continuation
] callcc1
nip ;
USE: prettyprint
USE: inspector
: cont-get-responder ( id-or-f -- )
#! httpd responder that retrieves a continuation and calls it.
dup f-or-"" [
#! No continuation id given
drop "root-continuation" get dup [
#! Use the root continuation
[ f swap resume-continuation ] with-exit-continuation
] [
#! No root continuation either
drop [ f expired-page-handler ] with-exit-continuation
] ifte
] [
#! Use the given continuation
[ f swap resume-continuation ] with-exit-continuation
] ifte
[ write flush ] when* drop ;
: post-request>namespace ( post-request -- namespace )
#! Return a namespace containing the name/value's from the
#! post data.
alist>namespace ;
: cont-post-responder ( id -- )
#! httpd responder that retrieves a continuation for the given
#! id and calls it with the POST data as an alist on the top
#! of the stack.
[
"response" get post-request>namespace swap resume-continuation
] with-exit-continuation
print drop ;
: callback-quot ( quot -- quot )
#! Convert the given quotation so it works as a callback
#! by returning a quotation that will pass the original
#! quotation to the callback continuation.
unit "callback-cc" get [ call ] cons append ;
: quot-href ( text quot -- )
#! Write to standard output an HTML HREF where the href,
#! when referenced, will call the quotation and then return
#! back to the most recent 'show' call (via the callback-cc).
#! The text of the link will be the 'text' argument on the
#! stack.
<a href= callback-quot t swap register-continuation a> write </a> ;
: with-new-session ( quot -- )
#! Each cont-responder is bound inside their own
#! namespace for storing session state. Run the given
#! quotation inside a new namespace for this purpose.
<namespace> swap bind ;
: init-session-namespace ( -- )
#! Setup the initial session namespace. Currently this only
#! copies the global value of whether the initial redirect
#! will be disabled. It assumes the session namespace is
#! topmost on the namespace stack.
"disable-initial-redirect?" get "disable-initial-redirect?" set ;
: install-cont-responder ( name quot -- )
#! Install a cont-responder with the given name
#! that will initially run the given quotation.
#!
#! Convert the quotation so it is run within a session namespace
#! and that namespace is initialized first.
[ init-session-namespace ] swap append unit [ with-new-session ] append
"httpd-responders" get [
<responder> [
[ cont-get-responder ] "get" set
[ cont-post-responder ] "post" set
over "responder-name" set
over "responder" set
reset-continuation-table
"disable-initial-redirect?" t put
] extend dup >r rot set
r> [
f swap register-continuation "root-continuation" set
] bind
] bind ;

92
contrib/cont-responder/cont-utils.factor Normal file
View File

@ -0,0 +1,92 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! General purpose words for display pages using the continuation
! based responder.
IN: cont-utils
USE: cont-html
USE: cont-responder
USE: lists
USE: stdio
USE: stack
USE: namespaces
USE: html
USE: combinators
: simple-page ( title quot -- )
#! Call the quotation, with all output going to the
#! body of an html page with the given title.
<html>
<head> <title> swap write </title> </head>
<body> call </body>
</html> ;
: styled-page ( title stylesheet-quot quot -- )
#! Call the quotation, with all output going to the
#! body of an html page with the given title. stylesheet-quot
#! is called to generate the required stylesheet.
<html>
<head>
<title> rot write </title>
swap call
</head>
<body> call </body>
</html> ;
: paragraph ( str -- )
#! Output the string as an html paragraph
<p> write </p> ;
: show-message-page ( message -- )
#! Display the message in an HTML page with an OK button.
[
"Press OK to Continue" [
swap paragraph
<a href= a> "OK" write </a>
] simple-page
] show 2drop ;
: vertical-layout ( list -- )
#! Given a list of HTML components, arrange them vertically.
<table>
[ <tr> <td> call </td> </tr> ] each
</table> ;
: horizontal-layout ( list -- )
#! Given a list of HTML components, arrange them horizontally.
<table>
<tr valign= "top" tr> [ <td> call </td> ] each </tr>
</table> ;
: button ( label -- )
#! Output an HTML submit button with the given label.
<input type= "submit" value= input/> ;
: with-simple-html-output ( quot -- )
#! Run the quotation inside an HTML stream wrapped
#! around stdio.
<pre>
"stdio" get <html-stream> [
call
] with-stream
</pre> ;

375
contrib/cont-responder/cont.txt Normal file
View File

@ -0,0 +1,375 @@
cont-responder v0.3
===================
NOTE: This documentation is slightly out of date with respect to the
current code but contains the basic idea.
In a continuation based web application the current position within
the web application is identified by a random URL. In this example the
URL is generated as a string of random digits:
: get-random-id ( -- id )
#! Generate a random id to use for continuation URL's
<% 16 [ random-digit % ] times %> ;
Each URL is associated with a quotation or continuation. When that URL
is accessed, that quotation is executed. The quotation will receive an
alist on the top of the stack which holds any POST or query
parameters. A global table is maintained that holds the association of
quotations to id's.
: continuation-table ( -- <namespace> )
#! Return the global table of continuations
"cont" get ;
: reset-continuation-table ( -- )
#! Create the initial global table
<namespace> "cont" set ;
: register-continuation ( quot -- id )
#! Store a continuation in the table and associate it with
#! a random id.
continuation-table [ get-random-id dup [ set ] dip ] bind ;
: get-registered-continuation ( id -- cont )
#! Return the continuation associated with the given id.
continuation-table [ get ] bind ;
: resume-continuation ( value id -- )
#! Call the continuation associated with the given id,
#! with 'value' on the top of the stack.
get-registered-continuation call ;
When a an URL is accessed, the continuation for the specific URL is
obtained and called. That continuation needs to exit back to the
caller when it has some HTML that it needs to display. returning that
HTML to the caller. To exit back to the caller it calls an 'exit
continuation' that is stored in an "exit" variable:
: exit-continuation ( -- exit )
#! Get the current exit continuation
"exit" get ;
: call-exit-continuation ( value -- )
#! Call the exit continuation, passing it the given value on the
#! top of the stack.
"exit" get call ;
: with-exit-continuation ( quot -- )
#! Call the quotation with the variable "exit" bound such that when
#! the exit continuation is called, computation will resume from the
#! end of this 'with-exit-continuation' call, with the value passed
#! to the exit continuation on the top of the stack.
[ "exit" set call call-exit-continuation ] callcc1 nip ;
All this calling of continuations is hidden behind a single 'show'
call. 'show' will take a quotation on the stack. That quotation should
return an HTML string. 'show' will call it to generate the HTML and
call the exit continuation with this string on the stack so it gets
returned to the httpd responder. The quotation receives a 'url' on the
top of the stack which is the 'id' of the continuation to resume when
that URL is accessed.
The HTML page that 'show' displays can contain links to
'callbacks'. These are links to other quotations that when called
will perform some action and return back to the calling page. To
return back to the calling page 'show' must capture and store the
current continuation before 'show' does anything so it can be later
return to by the callback. The following words store the current
continuation and retrieve it:
: store-callback-cc ( -- )
#! Store the current continuation in the variable 'callback-cc'
#! so it can be returned to later by callbacks. Note that it
#! recalls itself when the continuation is called to ensure that
#! it resets it's value back to the most recent show call.
[
[ "callback-cc" set call ] callcc0 drop store-callback-cc
] callcc0 ;
To generate the string of HTML I use 'with-string-stream' which calls
a quotation and all output inside that call gets appended to a string:
: with-string-stream ( quot -- string )
#! Call the quotation with standard output bound to a string output
#! stream. Return the string on exit.
<namespace> [
"stdio" <string-output-stream> put call "stdio" get stream>str
] bind ;
: show ( quot -- alist )
#! Call the quotation with the URL associated with the current
#! continuation. Return the HTML string generated by that code
#! to the exit continuation. When the URL is later referenced then
#! computation will resume from this 'show' call with a alist on
#! the stack containing any query or post parameters.
store-callback-cc
[
register-continuation swap with-string-stream
call-exit-continuation
] callcc1
nip ;
An httpd get responder is used that takes the ID as an argument, retrieves
the continuation associated with it and calls it. For the post
responder the post data is converted into an alist and it is put on
the top of the stack when calling the continuation.
: cont-get-responder ( id -- )
#! httpd responder that retrieves a continuation and calls it.
[ f swap resume-continuation ] with-exit-continuation
serving-html print drop ;
: post-request>alist ( post-request -- alist )
#! Return an alist containing name/value pairs from the
#! post data.
dup "&" swap str-contains [
"(.+)&(.+)" groups [ "(.+)=(.+)" groups uncons car cons ] inject
] [
"(.+)=(.+)" groups uncons car cons unit
] ifte ;
: cont-post-responder ( id -- )
#! httpd responder that retrieves a continuation for the given
#! id and calls it with the POST data as an alist on the top
#! of the stack.
[
read-post-request post-request>alist swap resume-continuation
] with-exit-continuation
serving-html print drop ;
Some code to install the responder:
: install-cont-responder ( -- )
#! Install the cont-responder in the table of httpd responders
"httpd-responders" get [
<responder> [
[ cont-get-responder ] "get" set
[ cont-post-responder ] "post" set
reset-continuation-table
] extend "cont" set
] bind ;
Now to test it. Here's a function that displays some text on an HTML page:
: display-page ( title -- )
#! Display a page with some text to test the cont-responder.
#! The page has a link to the 'next' continuation.
[
swap [
"<a href='" write write "'>Next</a>" write
] html-document
] show drop ;
Note that it contains an A HREF link to the URL that resumes the
computation (The quotation passed to show has this URL passed to it by
show).
An example of a POST request is a page that requests input of a
name. The following function calls show to display it and returns the
result of the 'name' field by retrieving it from the alist. Notice how
the 'action' of the post request is set to the URL passed in to the
quotation passed to show. So the 'next' that happens here is not an A
HREF but the action field of the POST.
: display-get-name-page ( -- name )
#! Display a page prompting for input of a name and return that name.
[
"Enter your name" [
"<form method='post' action='" write write "'>" write
"Name: <input type='text' name='name' size='20'>" write
"<input type='submit' value='Ok'>" write
"</form>" write
] html-document
] show
"name" swap assoc ;
A word that displays a sequence of these pages would be:
: test-cont-responder ( alist - )
#! Test the cont-responder responder by displaying a few pages in a row.
drop
"Page one" display-page
"Hello " display-get-name-page cat2 display-page
"Page three" display-page ;
This displays the first page, then a page prompting for the
name. "Hello " is concatenated to the result of the page and a third
page is displayed. A fourth page is available as well.
The following registers this word with the continuation system:
: register-test-cont-responder ( -- id )
#! Register the test-cont-responder word so that accessing the
#! URL with the returned ID will call it.
"httpd-responders" get [
"cont" get [
[ test-cont-responder ] register-continuation
] bind
] bind ;
This returns an ID which can be used from the web server to resume
it. Start the web server:
8888 httpd
Now access the URL with that id:
http://localhost:8888/cont/1234567890
(replace 1234567890 with the ID returned by register-continuation above)
You'll see the first page and a link. Click the link and you'll see
the second page requesting a name. Enter the name and press 'Ok'. A
third page will display a message using that name. You can book mark,
refresh, go back, enter a new name, etc as expected.
You can do any form of computation inside the handlers. Here's an
example of looping a set number of times:
: test-cont-responder2 ( alist - )
#! Test the cont-responder responder by displaying a few pages in a loop.
[ "one" "two" "three" "four" ] [ display-page ] each
"Done!" display-page ;
: register-test-cont-responder2 ( -- id )
#! Register the test-cont-responder2 word so that accessing the
#! URL with the returned ID will call it.
"httpd-responders" get [
"cont" get [
[ test-cont-responder2 ] register-continuation
] bind
] bind ;
There is currently a limited ability to do 'callbacks'. You can
register a quotation as an HTML A HREF anchor thar when accessed by
the browser will run the quotation and then return to the most recent
'show' call. This has the effect of allowing 'subroutine' calls as
page links that can do anything (including display other pages and
complicated action) and will return back to the originating page. The
word to generate this link is:
: quot-href ( text quot -- )
#! Write to standard output an HTML HREF where the href,
#! when referenced, will call the quotation and then return
#! back to the most recent 'show' call (via the callback-cc).
#! The text of the link will be the 'text' argument on the
#! stack.
"<a href='" write
"callback-cc" get [ call ] cons append register-continuation write
"'>" write
write
"</a>" write ;
An example of use is a simple menu page that displays links to the
words written previously:
: test-cont-responder3 ( alist - )
#! Test the quot-href word by displaying a menu of the current
#! test words. Note that we drop the 'url' argument to the show
#! quotation as we don't link to a 'next' page.
drop
[
drop
"Menu" [
"<ol>" write
"<li>" write
"Test responder1" [ test-cont-responder ] quot-href
"</li>" write
"<li>" write
"Test responder2" [ test-cont-responder2 ] quot-href
"</li>" write
"</ol>" write
] html-document
] show drop ;
: register-test-cont-responder3 ( -- id )
#! Register the test-cont-responder3 word so that accessing the
#! URL with the returned ID will call it.
"httpd-responders" get [
"cont" get [
[ test-cont-responder3 ] register-continuation
] bind
] bind ;
You should now be able to click on the menu items, navigate through
those pages and when the sequence of pages ends, return back to the
original menu page.
Note that this is just a proof of concept. In a real framework the
continuations need to be expired after time. It would also enable
generating links to other pages, etc rather than just a sequence of
pages. I plan to flesh this out over the next few days and present
some more useful examples. My main point was to see if it was possible
to do this type of thing in Factor.
The number of words required to get things going is amazingly small
and it was very easy to develop this far.
The code is contained in cont-responder.factor. Here are the steps to
run all the examples starting with a default Factor 0.60 install:
1) java -cp Factor.jar factor.FactorInterpreter
-db:factor.db.FileStore:factor.db
At the prompt enter:
---8<---
USE: httpd-responder
default-responders
exit
---8<---
2) java -cp Factor.jar factor.FactorInterpreter
-db:factor.db.FileStore:factor.db
-no-compile
At the prompt enter:
---8<---
USE: httpd
"cont-responder.factor" run-file
USE: cont-responder
init-cont-responder
register-test-cont-responder .
---8<---
Make note of the number returned by the last line call this [1].
---8<---
register-test-cont-responder2 .
---8<---
Make note of the number returned by the last line call this [2].
---8<---
register-test-cont-responder3 .
---8<---
Make note of the number returned by the last line call this [3].
---8<---
8888 httpd
---8<---
For the first example go to http://localhost:8888/cont/[1]
where you replace [1] with the number from [1] above. In my system
it was:
http://localhost:8888/cont/0406763029866672
For the second example go to http://localhost:8888/cont/[2]
where you replace [2] with the number from [2] above. In my system
it was:
http://localhost:8888/cont/6018237533813007
For the menu example go to http://localhost:8888/cont/[3]
where you replace [3] with the number from [3] above. In my system
it was:
http://localhost:8888/cont/3568874223456634
3) You can use the inspector to look at the continuation table:
http://localhost:8888/inspect/global'httpd-responders'cont'cont

210
contrib/cont-responder/eval-responder.factor Normal file
View File

@ -0,0 +1,210 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! An httpd responder that allows executing simple definitions.
!
IN: eval-responder
USE: cont-html
USE: html
USE: cont-responder
USE: cont-utils
USE: stack
USE: stdio
USE: namespaces
USE: streams
USE: parser
USE: lists
USE: errors
USE: strings
USE: logic
USE: combinators
USE: live-updater
USE: prettyprint
USE: words
: <evaluator> ( stack msg history -- )
#! Create an 'evaluator' object that holds
#! the current stack, output and history for
#! do-eval.
<namespace> [
"history" set
"output" set
"stack" set
] extend ;
: display-eval-form ( url -- )
#! Display the components for allowing entry of
#! factor words to be evaluated.
<form name= "main" method= "post" action= form>
[
[
<textarea name= "eval" rows= "10" cols= "40" textarea>
"" write
</textarea>
]
[
<input type= "submit" value= "Evaluate" accesskey= "e" input/>
]
] vertical-layout
</form>
"<script language='javascript'>document.forms.main.eval.focus()</script>" write ;
: escape-quotes ( string -- string )
#! Replace occurrences of single quotes with
#! backslash quote.
[ dup [ [ "'" | "\\'" ] [ "\"" | "\\\"" ] ] assoc dup rot ? ] str-map ;
: make-eval-javascript ( string -- string )
#! Give a string return some javascript that when
#! executed will set the eval textarea to that string.
<% "document.forms.main.eval.value=\"" % escape-quotes % "\"" % %> ;
: write-eval-link ( string -- )
#! Given text to evaluate, create an A HREF link which when
#! clicked sets the eval textarea to that value.
<a href= "#" onclick= dup make-eval-javascript a> write </a> ;
: display-stack ( list -- )
#! Write out html to display the stack.
<table border= "1" table>
<tr> <th> "Callstack" write </th> </tr>
[ <tr> <td> write-eval-link </td> </tr> ] each
</table> ;
: display-clear-history-link ( -- )
#! Write out html to display a link that will clear
#! the history list.
" (" write
"Clear" [ [ ] "history" set ] quot-href
")" write ;
: display-history ( list -- )
#! Write out html to display the history.
<table border= "1" table>
<tr> <th> "History" write display-clear-history-link </th> </tr>
[ <tr> <td> write-eval-link </td> </tr> ] each
</table> ;
: html-for-word-source ( word-string -- )
#! Return an html fragment dispaying the source
#! of the given word.
dup dup
<namespace> [
"responder" "inspect" put
<table border= "1" table>
<tr> <th colspan= "2" th> "Source" write </th> </tr>
<tr> <td colspan= "2" td> [ see ] with-simple-html-output </td> </tr>
<tr> <th> "Apropos" write </th> <th> "Usages" write </th> </tr>
<tr> <td valign= "top" td> [ apropos. ] with-simple-html-output </td>
<td valign= "top" td> [ usages. ] with-simple-html-output </td>
</tr>
</table>
] bind ;
: display-word-see-form ( url -- )
#! Write out the html for code that accepts
#! the name of a word, and displays the source
#! code of that word.
<form method= "post" action= "." form>
[
[
"Enter the name of a word: " write
"see" [ html-for-word-source ] live-search
]
[
<div id= "see" div> "" write </div>
]
] vertical-layout
</form> ;
: display-last-output ( string -- )
#! Write out html to display the last output.
<table border= "1" table>
<tr> <th> "Last Output" write </th> </tr>
<tr> <td> <pre> write </pre> </td> </tr>
</table> ;
: get-expr-to-eval ( -- string )
#! Show a page to the user requesting the form to be
#! evaluated. Return the form as a string. Assumes
#! an evaluator is on the namestack.
[
<html>
<head>
<title> "Factor Evaluator" write </title>
include-live-updater-js
</head>
<body>
"Use Alt+E to evaluate, or press 'Evaluate'" paragraph
[
[ display-eval-form ]
[ "stack" get display-stack ]
[ "history" get display-history ]
] horizontal-layout
display-word-see-form
"output" get display-last-output
</body>
</html>
] show [
"eval" get
] bind ;
: do-eval ( list string -- list )
#! Evaluate the expression in 'string' using 'list' as
#! the datastack. Return the resulting stack as a list.
parse unit append restack call unstack ;
: do-eval-to-string ( list string -- list string )
#! Evaluate expression using 'list' as the current callstack.
#! All output should go to a string which is returned on the
#! callstack along with the resulting datastack as a list.
<namespace> [
"inspect" "responder" set
1024 <string-output-stream> dup >r <html-stream> [
do-eval
] with-stream r> stream>str
] bind ;
: run-eval-requester ( evaluator -- )
#! Enter a loop request an expression to
#! evaluate, and displaying the results.
[
[
get-expr-to-eval dup "history" cons@
"stack" get swap do-eval-to-string
"output" set "stack" set
] forever
] bind ;
: eval-responder ( evaluator -- )
#! Run an eval-responder using the given evaluation details.
[
[
run-eval-requester
] [
show-message-page
] catch
] forever ;
"eval" [ [ ] "None" [ ] <evaluator> eval-responder ] install-cont-responder

1
contrib/cont-responder/js/liveUpdater.js Normal file
View File

@ -0,0 +1 @@
/* liveUpdater.js originally written by Avi Bryant, author of Seaside (http://www.beta4.com/seaside2) Modifed by Chris Double to add LiveUpdaterPost and use ' instead of " for the id. */ function liveUpdaterUri(uri) { return liveUpdater(function() { return uri; }); } function liveUpdater(uriFunc) { var request = false; var regex = /<(\w+).*?id='(\w+)'.*?>((.|\n)*)<\/\1>/; if (window.XMLHttpRequest) { request = new XMLHttpRequest(); } function update() { if(request && request.readyState < 4) request.abort(); if(!window.XMLHttpRequest) request = new ActiveXObject("Microsoft.XMLHTTP"); request.onreadystatechange = processRequestChange; request.open("GET", uriFunc()); request.send(null); return false; } function processRequestChange() { if(request.readyState == 4) { var results = regex.exec(request.responseText); if(results) document.getElementById(results[2]).innerHTML = results[3]; } } return update; } function liveUpdaterPost(uriFunc) { var request = false; var regex = /<(\w+).*?id='(\w+)'.*?>((.|\n)*)<\/\1>/; if (window.XMLHttpRequest) { request = new XMLHttpRequest(); } function update(data) { if(request && request.readyState < 4) request.abort(); if(!window.XMLHttpRequest) request = new ActiveXObject("Microsoft.XMLHTTP"); request.onreadystatechange = processRequestChange; request.open("POST", uriFunc()); request.send(data); return false; } function processRequestChange() { if(request.readyState == 4) { var results = regex.exec(request.responseText); if(results) document.getElementById(results[2]).innerHTML = results[3]; } } return update; } function liveSearch(id, uri) { var updater = liveUpdaterPost((function() { return uri; })); var last = ""; var timeout = false; function update() { if (last != document.getElementById(id).value) updater("s=" + escape(document.getElementById(id).value)); } function start() { if (timeout) window.clearTimeout(timeout); timeout = window.setTimeout(update, 300); } if (navigator.userAgent.indexOf("Safari") > 0) document.getElementById(id).addEventListener("keydown",start,false); else if (navigator.product == "Gecko") document.getElementById(id).addEventListener("keypress",start,false); else document.getElementById(id).attachEvent("onkeydown",start); }

82
contrib/cont-responder/live-updater-responder.factor Normal file
View File

@ -0,0 +1,82 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! An httpd responder that demonstrates using XMLHttpRequest to send
! asynchronous requests back to the server.
!
IN: live-updater-responder
USE: live-updater
USE: namespaces
USE: cont-html
USE: html
USE: words
USE: stdio
USE: stack
USE: kernel
USE: cont-utils
USE: cont-responder
USE: prettyprint
: live-search-apropos-word ( string -- )
#! Given a string that is a factor word, show the
#! aporpos of that word.
<namespace> [
"responder" "inspect" put
<pre>
"stdio" get <html-stream> [
apropos.
] with-stream
</pre>
] bind ;
: live-updater-responder ( -- )
[
drop
<html>
<head>
<title> "Live Updater Example" write </title>
include-live-updater-js
</head>
<body>
[
[
"millis" [ millis prettyprint ] "Display Server millis" live-anchor
<div id= "millis" div>
"The millisecond time from the server will appear here" write
</div>
]
[
"Enter a word to apropos:" paragraph
"apropos" [ live-search-apropos-word ] live-search
]
[
<div id= "apropos" div>
"" write
</div>
]
] vertical-layout
</body>
</html>
] show ;
"live-updater" [ live-updater-responder ] install-cont-responder

168
contrib/cont-responder/live-updater.factor Normal file
View File

@ -0,0 +1,168 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! cont-responder code for display forms and anchors that use XMLHttpRequest
! and the 'liveUpdater.js' code.
IN: live-updater
USE: stack
USE: streams
USE: strings
USE: cont-html
USE: cont-responder
USE: stdio
USE: namespaces
USE: lists
USE: combinators
: get-live-updater-js* ( stream -- string )
#! Read all lines from the stream, creating a string of the result.
dup freadln dup [ % "\n" % get-live-updater-js* ] [ drop fclose ] ifte ;
: get-live-updater-js ( filename -- string )
#! Return the liveUpdater javascript code as a string.
<filecr> <% get-live-updater-js* %> ;
: live-updater-url ( -- url )
#! Generate an URL to the liveUpdater.js code.
t [
[
"js/liveUpdater.js" get-live-updater-js write
] show
] register-continuation ;
: include-live-updater-js ( -- )
#! Write out the HTML script to include the live updater
#! javascript code.
<script language= "JavaScript" src= live-updater-url script>
"" write
</script> ;
: write-live-anchor-tag ( text -- id )
#! Write out the HTML for the clickable anchor. This
#! will have no actionable HREF assigned to it. Instead
#! an onclick is set via DHTML later to make it run a
#! quotation on the server. The randomly generated id
#! for the anchor is returned.
<a id= get-random-id dup href= "#" a>
swap write
</a> ;
: register-live-anchor-quot ( div-id div-quot -- kid )
#! Register the 'quot' with the cont-responder so
#! that when it is run it will produce an HTML
#! fragment which is the output generated by calling
#! 'quot'. That HTML fragment will be wrapped in a
#! 'div' with the given id.
<namespace> [
"div-quot" set
"div-id" set
] extend [
[
t "disable-initial-redirect?" set
[
<div id= "div-id" get div> "div-quot" get call </div>
] show
] bind
] cons t swap register-continuation ;
: write-live-anchor-script ( div-id div-quot anchor-id -- )
#! Write the javascript that will attach the onclick
#! event handler to the anchor with the 'anchor-id'. The
#! onclick, when clicked, will retrieve from the server
#! the HTML generated by the output of 'div-quot' wrapped
#! in a 'div' tag with the 'div-id'. That 'div' tag will
#! replace whatever HTML DOM object currently has that same
#! id.
<script language= "JavaScript" script>
"document.getElementById('" write
write
"').onclick=liveUpdaterUri('" write
register-live-anchor-quot write
"');" write
</script> ;
: live-anchor ( id quot text -- )
#! Write out the HTML for an anchor that when clicked
#! will replace the DOM object on the current page with
#! the given 'id' with the result of the output of calling
#! 'quot'.
write-live-anchor-tag
write-live-anchor-script ;
: write-live-search-tag ( -- id )
#! Write out the HTML for the input box. This
#! will have no actionable keydown assigned to it. Instead
#! a keydown is set via DHTML later to make it run a
#! quotation on the server. The randomly generated id
#! for the input box is returned.
<input id= get-random-id dup type= "text" input/> ;
: register-live-search-quot ( div-id div-quot -- kid )
#! Register the 'quot' with the cont-responder so
#! that when it is run it will produce an HTML
#! fragment which is the output generated by calling
#! 'quot'. That HTML fragment will be wrapped in a
#! 'div' with the given id. The 'quot' is called with
#! a string on top of the stack. This is the input string
#! entered in the live search input box.
<namespace> [
"div-quot" set
"div-id" set
] extend [
[
t "disable-initial-redirect?" set
#! Retrieve the search query value from the POST parameters.
[ "s" get ] bind
[
#! Don't need the URL as the 'show' won't be resumed.
drop
<div id= "div-id" get div> "div-quot" get call </div>
] show
] bind
] cons t swap register-continuation ;
: write-live-search-script ( div-id div-quot id-id -- )
#! Write the javascript that will attach the keydown handler
#! to the input box with the give id. Whenever a keydown is
#! received the 'div-quot' will be executed on the server,
#! with the input boxes text on top of the stack. The
#! output of the quot will be an HTML fragment, it is wrapped in
#! a 'div' with the id 'div-id' and will
#! replace whatever HTML DOM object currently has that same
#! id.
<script language= "JavaScript" script>
"liveSearch('" write
write
"', '" write
register-live-search-quot write
"');" write
</script> ;
: live-search ( div-id div-quot -- )
#! Write an input text field. The keydown of this
#! text field will run 'div-quot' on the server with
#! the value of the text field on the stack. The output
#! of div-quot will replace the HTML DOM object with the
#! given id.
write-live-search-tag
write-live-search-script ;

53
contrib/cont-responder/load.factor Normal file
View File

@ -0,0 +1,53 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! Start an httpd server and some words to re-load the continuation
! server files.
USE: httpd-responder
USE: httpd
USE: threads
USE: stack
USE: prettyprint
USE: combinators
USE: errors
USE: stdio
USE: parser
: l1
"../parser-combinators/lazy.factor" run-file
"../parser-combinators/parser-combinators.factor" run-file
"cont-html.factor" run-file
"cont-responder.factor" run-file
"cont-utils.factor" run-file ;
: l2
"cont-examples.factor" run-file ;
: l3 "todo.factor" run-file ;
: l4 "todo-example.factor" run-file ;
: l5 "live-updater.factor" run-file ;
: l6 "eval-responder.factor" run-file ;
: l7 "live-updater-responder.factor" run-file ;
: l8 "browser.factor" run-file ;
: la ;
: la [ 8888 httpd ] [ dup . flush [ la ] when* ] catch ;
! : lb [ la "httpd thread exited.\n" write flush ] in-thread ;

482
contrib/cont-responder/todo-example.factor Normal file
View File

@ -0,0 +1,482 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! A simple 'to-do list' web application.
!
! Users can register with the system and from there manage a simple
! list of things to do. All data is stored in a directory in the
! filesystem with the users name.
IN: todo-example
USE: cont-responder
USE: cont-html
USE: cont-utils
USE: html
USE: stdio
USE: stack
USE: strings
USE: namespaces
USE: inspector
USE: lists
USE: combinators
USE: cont-examples
USE: regexp
USE: prettyprint
USE: todo
USE: math
USE: logic
USE: kernel
USE: lazy
USE: parser-combinators
: todo-stylesheet ( -- string )
#! Return the stylesheet for the todo list
<%
"table.list {" %
" text-align:center;" %
" font-family: Verdana;" %
" font-weight: normal;" %
" font-size: 11px;" %
" color: #404040;" %
" background-color: #fafafa;" %
" border: 1px #6699cc solid;" %
" border-collapse: collapse;" %
" boder-spacing: 0px;" %
"}" %
"tr.heading {" %
" border-bottom: 2px solid #6699cc;" %
" border-left: 1px solix #6699cc;" %
" background-color: #BEC8D1;" %
" text-align: left;" %
" text-indent: 0px;" %
" font-family: verdana;" %
" font-weight: bold;" %
" color: #404040;" %
"}" %
"tr.item {" %
" border-bottom: 1px solid #9cf;" %
" border-top: 0px;" %
" border-left: 1px solid #9cf;" %
" border-right: 0px;" %
" text-align: left;" %
" text-indent: 2px;" %
" font-family: verdana, sans-serif, arial;" %
" font-weight: normal;" %
" color: #404040;" %
" background-color: #fafafa;" %
"}" %
"tr.complete {" %
" border-bottom: 1px solid #9cf;" %
" border-top: 0px;" %
" border-left: 1px solid #9cf;" %
" border-right: 0px;" %
" text-align: left;" %
" text-indent: 2px;" %
" font-family: verdana, sans-serif, arial;" %
" font-weight: normal;" %
" color: #404040;" %
" background-color: #ccc;" %
"}" %
"td.lbl {" %
" font-weight: bold; text-align: right;" %
"}" %
"tr.required {" %
" background: #FCC;" %
"}" %
"input:focus {" %
" background: yellow;" %
"}" %
"textarea:focus {" %
" background: yellow;" %
"}" %
%> ;
: todo-stylesheet-url ( -- url )
#! Generate an URL for the stylesheet.
t [ [ drop todo-stylesheet write ] show ] register-continuation ;
: include-todo-stylesheet ( -- )
#! Generate HTML to include the todo stylesheet
<link rel= "stylesheet" href= todo-stylesheet-url link/> ;
: show-stack-page ( -- )
#! Debug function to show a page containing the current call stack.
[ .s ] with-string-stream chars>entities show-message-page ;
: row ( list -- )
#! Output an html TR row with each element of the list
#! being called to produce the output for each TD.
<tr>
[ <td> call </td> ] each
</tr> ;
: styled-row ( class list -- )
#! Output an html TR row with each element of the list
#! being called to produce the output for each TD.
<tr class= swap tr>
[ <td> call </td> ] each
</tr> ;
: simple-input ( name -- )
#! Output a simple HTML input field which will have the
#! specified name.
<input type= "text" size= "20" name= input/> ;
: simple-input-with-value ( name value -- )
#! Output a simple HTML input field which will have the
#! specified name and value.
<input type= "text" size= "20" value= name= input/> ;
: textarea-input ( name -- )
#! Output a simple HTML textarea field which will have the
#! specified name.
<textarea name= rows= "10" cols= "40" textarea> "Enter description here." write </textarea> ;
: textarea-input-with-value ( name value -- )
#! Output a simple HTML textarea field which will have the
#! specified name and value.
<textarea name= swap rows= "10" cols= "40" textarea> write </textarea> ;
: password-input ( name -- )
#! Output an HTML password input field which will have the
#! specified name.
<input type= "password" size= "20" name= input/> ;
: form ( action quot -- )
#! Call quot with any output appearing inside an HTML form.
#! The form is a POST form where the action is as specified.
<form method= "post" action= swap form> call </form> ;
: input-value ( name -- value )
#! Get the value of the variable "name". If it is f
#! return "" else return the value.
get [ "" ] unless* ;
: login-form ( url button-text -- )
#! Write the HTML for an HTML form requesting a username
#! and password. The 'accept' button has the text given
#! in 'button-text'. The form will go to the given URL on
#! submission.
swap [
<table>
[ [ "Name:" write ] [ "name" simple-input ] ] row
[ [ "Password:" write ] [ "password" password-input ] ] row
</table>
button
] form ;
: registration-page ( submit-url -- )
#! Write the HTML for the registration page to std output.
"Register New TODO List" [
"Enter the username and password for your new todo list:" paragraph
"Register" login-form
] simple-page ;
: username-parser ( -- parser )
#! Return a parser which parses a valid todo username.
#! That is, it contains only lowercase, uppercase and digits.
[ letter? ] satisfy
[ LETTER? ] satisfy <|>
[ digit? ] satisfy <|> <!+> just ;
: is-valid-username? ( password -- bool )
#! Return true if the username parses correctly
username-parser call ;
: login-details-valid? ( name password -- )
#! Ensure that a valid username and password were
#! entered. In particular, ensure that only alphanumeric
#! data was entered to prevent security problems by
#! using .., etc in the name.
drop is-valid-username? ;
: get-registration-details ( -- name password )
#! Get the registration details from the user putting
#! the name and password on the stack.
[ registration-page ] show [
"name" get "password" get
] bind 2dup login-details-valid? [
2drop
"Please ensure you enter a username containing letters and numbers only." show-message-page
get-registration-details
] unless ;
: get-todo-filename ( database-path <todo> -- filename )
#! Get the filename containing the todo list details.
<% swap % todo-username % ".todo" % %> ;
: add-default-todo-item ( <todo> -- )
#! Add a default todo item. This is a workaround for the
#! currently hackish method of saving todo lists which can't
#! handle empty lists.
"1" "Set up todo list" <todo-item> add-todo-item ;
: init-new-todo ( <todo> -- )
#! Add the default todo item and store the todo list to
#! persistent storage.
dup add-default-todo-item
dup "database-path" get swap get-todo-filename store-todo ;
: register-new-user ( -- )
#! Get registration details for a new user and add a
#! todo list for them.
get-registration-details
2dup "database-path" get -rot user-exists? [
2drop
"That user already exists in the system, sorry. Please use another name."
show-message-page
register-new-user
] [
<todo> init-new-todo
"You have successfully registered your todo list." show-message-page
] ifte ;
: login-request-paragraph ( -- )
#! Display the paragraph requesting the user to login or register.
<p>
"Please enter your username and password (" write
"Click to Register" [ register-new-user ] quot-href
"):" write
</p> ;
: get-login-information ( -- user password )
[
"Login" [
login-request-paragraph
"Login" login-form
] simple-page
] show [
"name" get "password" get
] bind ;
: ensure-login-valid ( user password -- user password )
2dup login-details-valid? [
"Please ensure you enter a username containing letters and numbers only." show-message-page
get-login-information
] unless ;
: get-todo-list ( -- <todo> )
#! Prompts for a username or password until a valid combination
#! is entered then returns the <todo> list for that user.
get-login-information ensure-login-valid
"database-path" get -rot user-exists? [
"Sorry, your username or password was incorrect." show-message-page
get-todo-list
] unless* ;
: write-new-todo-item-form ( url -- )
#! Display the HTML for a form allowing entry of a
#! todo item details.
[
<table>
<tr class= "required" tr>
<td class= "lbl" td> "Priority" write </td>
<td> "priority" simple-input </td>
</tr>
<tr class= "required" tr>
<td class= "lbl" td> "Description" write </td>
<td> "description" textarea-input </td>
</tr>
</table>
"Add" button
] form ;
: write-edit-todo-item-form ( item url -- )
#! Display the HTML for a form allowing editing of a
#! todo item details.
swap [
[
<table>
<tr class= "required" tr>
<td class= "lbl" td> "Priority" write </td>
<td> "priority" dup get simple-input-with-value </td>
</tr>
<tr class= "required" tr>
<td class= "lbl" td> "Description" write </td>
<td> "description" dup get textarea-input-with-value </td>
</tr>
</table>
"Save" button
] form
] bind ;
: priority-parser ( -- parser )
#! Return a parser for parsing priorities
[ digit? ] satisfy just ;
: todo-details-valid? ( priority description -- bool )
#! Return true if a valid priority and description were entered.
str-length 0 > swap priority-parser call and ;
: get-new-todo-item ( -- <todo-item> )
#! Enter a new item to the current todo list.
[
"Enter New Todo Item" [ include-todo-stylesheet ] [ write-new-todo-item-form ] styled-page
] show [
"priority" get "description" get
] bind 2dup todo-details-valid? [
<todo-item>
] [
2drop
"Please ensure you enter a Priority from 0-9 and a description." show-message-page
get-new-todo-item
] ifte ;
: write-get-password-form ( url -- )
#! Display the HTML for a form allowing entry of a
#! new password.
[
<table>
<tr class= "required" tr>
<td class= "lbl" td> "Old Password" write </td>
<td> "old-password" password-input </td>
</tr>
<tr class= "required" tr>
<td class= "lbl" td> "New Password" write </td>
<td> "new-password" password-input </td>
</tr>
<tr class= "required" tr>
<td class= "lbl" td> "Verify Password" write </td>
<td> "verify-password" password-input </td>
</tr>
</table>
"Change Password" button
] form ;
: get-new-password ( <todo> -- password )
#! Get a new password for the todo list.
[
"Enter New Password" [ include-todo-stylesheet ] [ write-get-password-form ] styled-page
] show [
"old-password" get
swap password-matches? [
"new-password" get
"verify-password" get = [
"new-password" get
] [
"Your new password did not match. The password was NOT changed." show-message-page
f
] ifte
] [
"You entered an incorrect old password. The password was NOT changed." show-message-page
f
] ifte
] bind ;
: edit-item-details ( item -- )
#! Allow editing of an existing items details.
[
"Edit Item" [ include-todo-stylesheet ] [ write-edit-todo-item-form ] styled-page
] show [
"priority" get "description" get
] bind 2dup todo-details-valid? [
rot [ "description" set "priority" set ] bind
] [
drop drop
"Please ensure you enter a Priority from 0-9 and a description." show-message-page
edit-item-details
] ifte ;
: save-current-todo ( -- )
#! Save the current todo list
"database-path" get "todo" get get-todo-filename "todo" get swap store-todo ;
: lcurry1 ( value quot -- quot )
#! Return a quotation that when called will have 'value'
#! as the first item on the stack.
cons ;
: write-mark-complete-action ( item -- )
#! Write out HTML to perform a mark complete
#! action on an item (or other appropriate
#! action if already complete).
dup item-complete? [
"Delete" swap [ "todo" get swap delete-item save-current-todo ] lcurry1 quot-href
] [
"Complete" swap [ set-item-completed save-current-todo ] lcurry1 quot-href
] ifte ;
: write-edit-action ( item -- )
#! Write out html to allow editing an item.
"Edit" swap [ edit-item-details save-current-todo ] lcurry1 quot-href ;
: item-class ( <todo-item> -- string )
#! Return the class to use for displaying the row for the
#! item.
item-complete? [ "complete" ] [ "item" ] ifte ;
: write-item-row ( <todo-item> -- )
#! Write the todo list item as an HTML row.
dup dup dup dup
dup item-class [
[ item-priority write ]
[ item-complete? [ "Yes" ] [ "No" ] ifte write ]
[ item-description write ]
[ write-mark-complete-action ]
[ write-edit-action ]
] styled-row ;
: write-item-table ( <todo> -- )
#! Write the table of items for the todo list.
<table>
"heading" [
[ "Priority" write ] [ "Complete?" write ] [ "Description" write ] [ "Action" write ] [ " " write ]
] styled-row
todo-items [ write-item-row ] each
</table> ;
: do-add-new-item ( -- )
#! Request a new item from the user and add it to the current todo list.
"todo" get get-new-todo-item add-todo-item save-current-todo ;
: do-change-password ( -- )
#! Allow changing the password for the todo list.
"todo" get get-new-password dup [
"todo" get [ "password" set ] bind save-current-todo
"Your password has been changed." show-message-page
] [
drop
] ifte ;
: show-todo-list ( -- )
#! Show the current todo list.
[
<% "todo" get todo-username % "'s To Do list" % %>
[ include-todo-stylesheet ]
[
drop
"todo" get write-item-table
[
[ "Add Item" [ do-add-new-item ] quot-href ]
[ "Change Password" [ do-change-password ] quot-href ]
] horizontal-layout
] styled-page
] show drop ;
: todo-example ( path -- )
#! Startup the todo list example using the given path as the
#! directory holding the todo files.
"database-path" set
get-todo-list "todo" set
show-todo-list ;
"todo" [ drop "todo/" todo-example ] install-cont-responder

169
contrib/cont-responder/todo.factor Normal file
View File

@ -0,0 +1,169 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! Routines for managing a simple "To Do list". A todo list has a 'user', 'password'
! and list of items. Each item has a priority, description, and indication if it is
! complete.
IN: todo
USE: parser
USE: stack
USE: strings
USE: streams
USE: namespaces
USE: lists
USE: math
USE: stdio
USE: kernel
USE: prettyprint
USE: unparser
USE: url-encoding
USE: combinators
USE: files
: <todo> ( user password -- <todo> )
#! Create an empty todo list
<namespace> [
"password" set
"user" set
f "items" set
] extend ;
: <todo-item> ( priority description -- )
#! Create a todo item
<namespace> [
"description" set
"priority" set
f "complete?" set
] extend ;
: add-todo-item ( <todo> <item> -- )
#! Add the item to the todo list
swap [
"items" add@
] bind ;
: namespace>alist ( namespace -- alist )
#! Convert a namespace to an alist
[ vars-values ] bind ;
: print-quoted ( str -- )
#! Print the string with quotes around it
"\"" write write "\"" print ;
: write-item ( <todo-item> -- )
#! write the item in a manner that can be later re-read
[
"complete?" get [ "yes" url-encode print ] [ "no" url-encode print ] ifte
"priority" get url-encode print
"description" get url-encode print
] bind ;
: write-items ( list -- )
#! write the todo list items
dup length unparse print
[ write-item ] each ;
: write-todo ( <todo> -- )
#! Write the todo list to the current output stream
#! in a format that if loaded by the parser will result
#! in a <todo> again.
[
"user" get url-encode print
"password" get url-encode print
"items" get write-items
] bind ;
: store-todo ( <todo> filename -- )
#! store the todo list in the given file.
<filecw> [ write-todo ] with-stream ;
: read-todo ( -- <todo> )
#! Read a todo list from the current input stream.
read url-decode read url-decode <todo>
read str>number [
dup
<namespace> [
read url-decode "yes" = "complete?" set
read url-decode "priority" set
read url-decode "description" set
] extend add-todo-item
] times ;
: load-todo ( filename -- <todo> )
<filecr> [ read-todo ] with-stream ;
: password-matches? ( password <todo> -- <todo> )
#! Returns the <todo> if the password matches otherwise
#! returns false.
dup -rot [ "password" get ] bind = [ ] [ drop f ] ifte ;
: user-exists? ( db-path name password -- <todo> )
#! Returns a <todo> if a user with the given name exists
#! otherwise returns false.
-rot ".todo" cat3 dup exists? [
load-todo password-matches?
] [
2drop f
] ifte ;
: items-each-bind ( quot -- )
#! For each item in the currently bound todo list, call the quotation
#! with that item bound.
unit [ bind ] append "items" get swap each ;
: todo-username ( <todo> -- username )
#! return the username for the todo list item.
[ "user" get ] bind ;
: item-priority ( <todo-item> -- priority )
#! return the priority for the todo list item.
[ "priority" get ] bind ;
: item-complete? ( <todo-item> -- boolean )
#! return true if the todo list item is completed.
[ "complete?" get ] bind ;
: set-item-completed ( <todo-item> -- )
[ t "complete?" set ] bind ;
: item-description ( <todo-item> -- description )
#! return the description for the todo list item.
[ "description" get ] bind ;
: priority-comparator ( item1 item2 -- bool )
#! Return true if item1 is a higher priority than item2
>r item-priority r> item-priority str-lexi> ;
: todo-items ( <todo> -- alist )
#! Return a list of items for the given todo list.
[ "items" get ] bind [ priority-comparator ] sort ;
: delete-item ( <todo> <todo-item> -- )
#! Delete the item from the todo list
swap dup >r todo-items remove r> [ "items" set ] bind ;
: test-todo
"user" "password" <todo>
dup "1" "item1" <todo-item> add-todo-item
dup "2" "item2" <todo-item> add-todo-item ;

152
contrib/irc.factor Normal file
View File

@ -0,0 +1,152 @@
! :folding=indent:collapseFolds=1:
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: irc
USE: arithmetic
USE: combinators
USE: errors
USE: inspector
USE: interpreter
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: parser
USE: prettyprint
USE: stack
USE: stdio
USE: streams
USE: strings
USE: words
USE: unparser
: irc-register ( -- )
"USER " write
"user" get write " " write
"host" get write " " write
"server" get write " " write
"realname" get write " " print
"NICK " write
"nick" get print ;
: irc-join ( channel -- )
"JOIN " write print ;
: irc-message ( message recepients -- )
"PRIVMSG " write write " :" write print ;
: irc-action ( message recepients -- )
"ACTION " write write " :" write print ;
: keep-datastack ( quot -- )
datastack [ call ] dip set-datastack drop ;
: irc-stream-write ( string -- )
dup "buf" get sbuf-append
ends-with-newline? [
"buf" get sbuf>str
0 "buf" get set-sbuf-length
"\n" split [ dup f-or-"" [ drop ] [ "recepient" get irc-message ] ifte ] each
] when ;
: <irc-stream> ( stream recepient -- stream )
<stream> [
"recepient" set
"stdio" set
100 <sbuf> "buf" set
[
irc-stream-write
] "fwrite" set
] extend ;
: irc-eval ( line -- )
[
[
eval
] [
default-error-handler
] catch
] keep-datastack drop ;
: with-irc-stream ( recepient quot -- )
[
[ "stdio" get swap <irc-stream> "stdio" set ] dip
call
] with-scope ;
: irc-action-quot ( action -- quot )
[
[ "eval" swap [ irc-eval ] with-irc-stream ]
[ "see" swap [ see terpri ] with-irc-stream ]
[ "join" nip irc-join ]
[ "quit" 2drop global [ "irc-quit-flag" on ] bind ]
] assoc [ [ 2drop ] ] unless* ;
: irc-action-handler ( recepient message -- )
" " split1 swap irc-action-quot call ;
: irc-input ( line -- )
#! Handle a line of IRC input.
dup
" PRIVMSG " split1 nip [
":" split1 dup [
irc-action-handler
] [
drop
] ifte
] when*
global [ print ] bind ;
: irc-quit-flag ( -- ? )
global [ "irc-quit-flag" get ] bind ;
: clear-irc-quit-flag ( -- ? )
global [ "irc-quit-flag" off ] bind ;
: irc-loop ( -- )
irc-quit-flag [
read [ irc-input irc-loop ] when*
] unless clear-irc-quit-flag ;
: irc ( channels -- )
irc-register
"identify foobar" "NickServ" irc-message
[ irc-join ] each
irc-loop ;
: irc-test
"factorbot" "user" set
"emu" "host" set
"irc.freenode.net" "server" set
"Factor" "realname" set
"factorbot" "nick" set
"irc.freenode.net" 6667 <client> [
[ "#factor" ] irc
] with-stream ;

40
contrib/mandel.factor Normal file
View File

@ -0,0 +1,40 @@
! Based on lisp code from newsgroup discussion in
! comp.lang.lisp
! (loop for y from -1 to 1.1 by 0.1 do
! (loop for x from -2 to 1 by 0.04 do
! (let* ((c 126)
! (z (complex x y))
! (a z))
! (loop while (< (abs
! (setq z (+ (* z z) a)))
! 2)
! while (> (decf c) 32))
! (princ (code-char c))))
! (format t "~%"))
USE: combinators
USE: math
USE: prettyprint
USE: stack
USE: stdio
USE: strings
: ?mandel-step ( a z c -- a z c ? )
>r dupd sq + dup abs 2 < [
r> pred dup CHAR: \s >
] [
r> f
] ifte ;
: mandel-step ( a z c -- )
[ ?mandel-step ] [ ] while >char write 2drop ;
: mandel-x ( x y -- )
rect> dup CHAR: ~ mandel-step ;
: mandel-y ( y -- )
150 [ dupd 50 / 2 - >float swap mandel-x ] times* drop ;
: mandel ( -- )
42 [ 20 / 1 - >float mandel-y terpri ] times* ;

63
contrib/parser-combinators/lazy-examples.factor Normal file
View File

@ -0,0 +1,63 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: lazy-examples
USE: lazy
USE: stack
USE: math
USE: lists
USE: combinators
USE: kernel
USE: logic
: lfrom ( n -- llist )
#! Return a lazy list of increasing numbers starting
#! from the initial value 'n'.
dup [ succ lfrom ] curry1 lcons ;
: lfrom-by ( n quot -- llist )
#! Return a lazy list of values starting from n, with
#! each successive value being the result of applying quot to
#! n.
dupd [ dup [ call ] dip lfrom-by ] curry2 lcons ;
: lnaturals 0 lfrom ;
: lpositves 1 lfrom ;
: levens 0 [ 2 + ] lfrom-by ;
: lodds 1 lfrom [ 2 mod 1 = ] lsubset ;
: lpowers-of-2 1 [ 2 * ] lfrom-by ;
: lones 1 [ ] lfrom-by ;
: lsquares lnaturals [ dup * ] lmap ;
: first-five-squares 5 lsquares ltake ;
: divisible-by? ( a b -- bool )
#! Return true if a is divisible by b
mod 0 = ;
: sieve ( llist - llist )
#! Given a lazy list of numbers, use the sieve of eratosthenes
#! algorithm to return a lazy list of primes.
luncons over [ divisible-by? not ] curry1 lsubset [ sieve ] curry1 lcons ;
: lprimes 2 lfrom sieve ;
: first-ten-primes 10 lprimes ltake ;

172
contrib/parser-combinators/lazy.factor Normal file
View File

@ -0,0 +1,172 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: lazy
USE: lists
USE: stack
USE: math
USE: stdio
USE: prettyprint
USE: kernel
USE: combinators
USE: logic
: curry1 ( n quot -- quot )
#! Return a quotation that when called will initially
#! have 'n' pushed on the stack.
cons ;
: curry2 ( n1 n2 quot -- quot )
#! Return a quotation that when called will initially
#! have 'n1' and 'n2' pushed on the stack.
cons cons ;
: delay ( value -- promise )
#! Return a promise that when 'forced' returns the original value.
unit ;
: force ( promise -- value )
#! Return the value associated with the promise.
call ;
: lcons ( car promise -- lcons )
#! Return a lazy pair, where the cdr is a promise and must
#! be forced to return the value.
cons ;
: lunit ( a -- llist )
#! Construct a lazy list of one element.
[ ] delay lcons ;
: lcar ( lcons -- car )
#! Return the car of a lazy pair.
car ;
: lcdr ( lcons -- cdr )
#! Return the cdr of a lazy pair, implicitly forcing it.
cdr force ;
: lnth ( n llist -- value )
#! Return the nth item in a lazy list
swap [ lcdr ] times lcar ;
: luncons ( lcons -- car cdr )
#! Return the car and forced cdr of the lazy cons.
uncons force ;
: (ltake) ( n llist accum -- list )
>r >r pred dup 0 < [
drop r> drop r> nreverse
] [
r> luncons swap r> cons (ltake)
] ifte ;
: ltake ( n llist -- list )
#! Return a list containing the first n items from
#! the lazy list.
[ ] (ltake) ;
: lmap ( llist quot -- llist )
#! Return a lazy list containing the collected result of calling
#! quot on the original lazy list.
over [ ] = [
2drop [ ]
] [
[ luncons ] dip
dup swapd
[ lmap ] curry2
[ call ] dip
lcons
] ifte ;
: lsubset ( llist pred -- llist )
#! Return a lazy list containing only the items from the original
#! lazy list for which the predicate returns a value other than f.
over [ ] = [
2drop [ ]
] [
[ luncons ] dip
dup swapd
[ lsubset ] curry2
-rot dupd call [
swap lcons
] [
drop call
] ifte
] ifte ;
: lappend* ;
: (lappend*) ;
: lappend-list* ;
: lappend-item* ( llists list item -- llist )
-rot [ lappend-list* ] curry2 lcons ;
: lappend-list* ( llists list -- llist )
dup [
#! non-empty list
luncons swap lappend-item*
] [
#! empty list
drop lappend*
] ifte ;
: (lappend*) ( llists -- llist )
dup lcar [ ( llists )
#! Yes, the first item in the list is a valid llist
luncons swap lappend-list*
] [
#! The first item in the list is an empty list.
#! Resume passing the next list.
lcdr lappend*
] ifte ;
: lappend* ( llists -- llist )
#! Given a lazy list of lazy lists, return a lazy list that
#! works through all of the sub-lists in sequence.
dup [
(lappend*)
] [
#! Leave empty list on the stack
] ifte ;
: list>llist ( list -- llist )
#! Convert a list to a lazy list.
dup [
uncons [ list>llist ] curry1 lcons
] when ;
: lappend ( llist1 llist2 -- llist )
#! Concatenate two lazy lists such that they appear to be one big lazy list.
2list list>llist lappend* ;
: leach ( llist quot -- )
#! Call the quotation on each item in the lazy list.
#! Warning: If the list is infinite then this will
#! never return.
over [
>r luncons r> tuck >r >r call r> r> leach
] [
2drop
] ifte ;

280
contrib/parser-combinators/lazy.html Normal file
View File

@ -0,0 +1,280 @@
<html>
<head>
<title>Lazy Evaluation</title>
<link rel="stylesheet" type="text/css" href="style.css">
</head>
<body>
<h1>Lazy Evaluation</h1>
<p>The 'lazy' vocabulary adds lazy lists to Factor. This provides the
ability to describe infinite structures, and to delay execution of
expressions until they are actually used.</p>
<p>Lazy lists, like normal lists, are composed of a head and tail. In
a lazy list the tail is something called a 'promise'. To convert a
'promise' into its actual value a word called 'force' is used. To
convert a value into a 'promise' the word to use is 'delay'.</p>
<p>Many of the lazy list words are named similar to the standard list
words but with an 'l' suffixed to it. Here are the commonly used
words and their equivalent list operation:</p>
<table border="1">
<tr><th>Lazy List</th><th>Normal List</th></tr>
<tr><td><a href="#lcons">lcons</a></td><td>cons</td></tr>
<tr><td><a href="#lunit">lunit</a></td><td>unit</td></tr>
<tr><td><a href="#lcar">lcar</a></td><td>car</td></tr>
<tr><td><a href="#lcdr">lcdr</a></td><td>cdr</td></tr>
<tr><td><a href="#lnth">lnth</a></td><td>nth</td></tr>
<tr><td><a href="#luncons">luncons</a></td><td>uncons</td></tr>
<tr><td><a href="#lmap">lmap</a></td><td>map</td></tr>
<tr><td><a href="#lsubset">lsubset</a></td><td>subset</td></tr>
<tr><td><a href="#leach">leach</a></td><td>each</td></tr>
<tr><td><a href="#lappend">lappend</a></td><td>append</td></tr>
</table>
<p>A few additional words specific to lazy lists are:</p>
<table border="1">
<tr><td><a href="#ltake">ltake</a></td><td>Returns a normal list containing a specified
number of items from the lazy list.</td></tr>
<tr><td><a href="#lappendstar">lappend*</a></td><td>Given a lazy list of lazy lists,
concatenate them together in a lazy manner, returning a single lazy
list.</td></tr>
<tr><td><a href="#list>llist">list>llist</a></td><td>Given a normal list, return a lazy list
that contains the same elements as the normal list.</td></tr>
</table>
<p>A couple of helper functions are also provided by the lazy
vocabulary.</p>
<table border="1">
<tr><td>curry1</td><td>Given a value and a quotation, returns a new
quotation that when called will have the value on the stack.</td></tr>
<tr><td>curry2</td><td>Given two values and a quotation, returns a new
quotation that when called will have the two values on the
stack.</td></tr>
</table>
<h2>Reference</h2>
<!-- lcons description -->
<a name="lcons">
<h3>lcons ( value promise -- lcons )</h3>
<p>Provides the same effect as 'cons' does for normal lists. It
creates a cons cell where the first element is the value given and the
second element is a promise.</p>
<a name="promise">
<p>A promise is either a value that has had 'force' called on it, or
a quotation that when 'call' is applied to it, returns the actual
value.</p>
<pre class="code">
( 1 ) 5 6 delay <a href="#lcons">lcons</a> dup .
=> [ 5 6 ]
( 2 ) dup <a href="#lcar">lcar</a> .
=> 5
( 3 ) dup <a href="#lcdr">lcdr</a> .
=> 6
</pre>
<!-- lunit description -->
<a name="lunit">
<h3>lunit ( value -- llist )</h3>
<p>Provides the same effect as 'unit' does for normal lists. It
creates a lazy list where the first element is the value given.</p>
<pre class="code">
( 1 ) 42 <a href="#lunit">lunit</a> dup .
=> [ 42 f ]
( 2 ) dup <a href="#lcar">lcar</a> .
=> 42
( 3 ) dup <a href="#lcdr">lcdr</a> .
=> f
( 4 ) [ . ] <a href="#leach">leach</a>
=> 42
</pre>
<!-- lcar description -->
<a name="lcar">
<h3>lcar ( lcons -- value )</h3>
<p>Provides the same effect as 'car' does for normal lists. It
returns the first element in a lazy cons cell.</p>
<pre class="code">
( 1 ) 42 <a href="#lunit">lunit</a> dup .
=> [ 42 f ]
( 2 ) <a href="#lcar">lcar</a> .
=> 42
</pre>
<!-- lcdr description -->
<a name="lcdr">
<h3>lcdr ( lcons -- value )</h3>
<p>Provides the same effect as 'cdr' does for normal lists. It
returns the second element in a lazy cons cell and forces it. This
causes that element to be evaluated immediately.</p>
<pre class="code">
( 1 ) 5 [ 5 6 + ] <a href="#lcons">lcons</a> dup .
=> [ 5 5 6 + ]
( 2 ) <a href="#lcdr">lcdr</a> .
=> 11
</pre>
<pre class="code">
( 1 ) 5 lfrom dup .
=> [ 5 5 succ lfrom ]
( 2 ) <a href="#lcdr">lcdr</a> dup <a href="#lcar">lcar</a> .
=> 6
( 3 ) <a href="#lcdr">lcdr</a> dup <a href="#lcar">lcar</a> .
=> 7
( 4 ) <a href="#lcdr">lcdr</a> dup <a href="#lcar">lcar</a> .
=> 8
</pre>
<!-- lnth description -->
<a name="lnth">
<h3>lnth ( n llist -- value )</h3>
<p>Provides the same effect as 'nth' does for normal lists. It
returns the nth value in the lazy list. It causes all the values up to
'n' to be evaluated.</p>
<pre class="code">
( 1 ) 1 lfrom
=> [ 1 1 succ lfrom ]
( 2 ) 5 swap <a href="#lnth">lnth</a> .
=> 6
</pre>
<!-- luncons description -->
<a name="luncons">
<h3>luncons ( lcons -- car cdr )</h3>
<p>Provides the same effect as 'uncons' does for normal lists. It
returns the car and cdr of the lazy list. Note that cdr is forced
resulting in it being evaluated.</p>
<pre class="code">
( 1 ) 5 [ 6 ] <a href="#lcons">lcons</a> dup .
=> [ 5 6 ]
( 2 ) <a href="#luncons">luncons</a> .s
=> { 5 6 }
</pre>
<!-- lmap description -->
<a name="lmap">
<h3>lmap ( llist quot -- llist )</h3>
<p>Provides the same effect as 'map' does for normal lists. It
lazily maps over a lazy list applying the quotation to each element.
A new lazy list is returned which contains the results of the
quotation.</p>
<p>When initially called <a href="#lmap">lmap</a> will only call quot on the first element
of the list. It then constructs a lazy list that performs the
next '<a href="#lmap">lmap</a>' operation on the next element when it is evaluated. This
allows mapping over infinite lists.</p>
<pre class="code">
( 1 ) 1 lfrom
=> < infinite list of incrementing numbers >
( 2 ) [ 2 * ] <a href="#lmap">lmap</a>
=> < infinite list of numbers incrementing by 2 >
( 3 ) 5 swap <a href="#ltake">ltake</a> .
=> [ 2 4 6 8 10 ]
</pre>
<!-- lsubset description -->
<a name="lsubset">
<h3>lsubset ( llist pred -- llist )</h3>
<p>Provides the same effect as 'subset' does for normal lists. It
lazily iterates over a lazy list applying the predicate quotation to each
element. If that quotation returns true, the element will be included
in the resulting lazy list. If it is false, the element will be skipped.
A new lazy list is returned which contains all elements where the
predicate returned true.</p>
<p>When initially called <a href="#lsubset">lsubset</a> will only call
the predicate quotation on the first element
of the list. It then constructs a lazy list that performs the
next '<a href="#lsubset">lsubset</a>' operation on the next element when it is evaluated. This
allows subsetting over infinite lists.</p>
<pre class="code">
( 1 ) 1 lfrom
=> < infinite list of incrementing numbers >
( 2 ) [ prime? ] <a href="#lsubset">lsubset</a>
=> < infinite list of prime numbers >
( 3 ) 5 swap <a href="#ltake">ltake</a> .
=> [ 2 3 5 7 11 ]
</pre>
<!-- leach description -->
<a name="leach">
<h3>leach ( llist quot -- )</h3>
<p>Provides the same effect as 'each' does for normal lists. It
lazily iterates over a lazy list applying the quotation to each
element. If this operation is applied to an infinite list it will
never return unless the quotation escapes out by calling a continuation.</p>
<pre class="code">
( 1 ) 1 lfrom
=> < infinite list of incrementing numbers >
( 2 ) [ 2 mod 1 = ] <a href="#lsubset">lsubset</a>
=> < infinite list of odd numbers >
( 3 ) [ . ] <a href="#leach">leach</a>
=> 1
3
5
7
... for ever ...
</pre>
<!-- ltake description -->
<a name="ltake">
<h3>ltake ( n llist -- list )</h3>
<p>Iterates over the lazy list 'n' times, appending each element to a
normal list. The normal list is returned. This provides a convenient
way of getting elements out of a lazy list.</p>
<pre class="code">
( 1 ) : ones 1 [ ones ] <a href="#lcons">lcons</a> ;
( 2 ) 5 ones <a href="#ltake">ltake</a>
=> [ 1 1 1 1 1 ]
</pre>
<!-- lappend description -->
<a name="lappend">
<h3>lappend ( llist1 llist2 -- llist )</h3>
<p>Lazily appends two lists together. The actual appending is done
lazily on iteration rather than immediately so it works very fast no
matter how large the list.</p>
<pre class="code">
( 1 ) [ 1 2 3 ] <a href="#list>llist">list>llist</a> [ 4 5 6 ] <a href="#list>llist">list>llist</a> <a href="#lappend">lappend</a>
( 2 ) [ . ] <a href="#leach">leach</a>
=> 1
2
3
4
5
6
</pre>
<!-- lappend* description -->
<a name="lappendstar">
<h3>lappend* ( llists -- llist )</h3>
<p>Given a lazy list of lazy lists, concatenate them together in a
lazy fashion. The actual appending is done lazily on iteration rather
than immediately so it works very fast no matter how large the lists.</p>
<pre class="code">
( 1 ) [ 1 2 3 ] <a href="#list>llist">list>llist</a>
( 2 ) [ 4 5 6 ] <a href="#list>llist">list>llist</a>
( 3 ) [ 7 8 9 ] <a href="#list>llist">list>llist</a>
( 4 ) 3list <a href="#list>llist">list>llist</a> <a href="#lappendstar">lappend*</a>
( 5 ) [ . ] <a href="#leach">leach</a>
=> 1
2
3
4
5
6
7
8
9
</pre>
<!-- list>llist description -->
<a name="list>llist">
<h3>list>llist ( list -- llist )</h3>
<p>Converts a normal list into a lazy list. This is done lazily so the
initial list is not iterated through immediately.</p>
<pre class="code">
( 1 ) [ 1 2 3 ] <a href="#list>llist">list>llist</a>
( 2 ) [ . ] <a href="#leach">leach</a>
=> 1
2
3
</pre>
<p class="footer">
News and updates to this software can be obtained from the authors
weblog: <a href="http://radio.weblogs.com/0102385">Chris Double</a>.</p>
<p id="copyright">Copyright (c) 2004, Chris Double. All Rights Reserved.</p>
</body> </html>

433
contrib/parser-combinators/parser-combinators.factor Normal file
View File

@ -0,0 +1,433 @@
! Copyright (C) 2004 Chris Double.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: parser-combinators
USE: lazy
USE: stack
USE: lists
USE: strings
USE: math
USE: logic
USE: kernel
USE: combinators
USE: parser
: phead ( object -- head )
#! Polymorphic head. Return the head item of the object.
#! For a string this is the first character.
#! For a list this is the car.
[
[ string? ] [ 0 swap str-nth ]
[ list? ] [ car ]
] cond ;
: ptail ( object -- tail )
#! Polymorphic tail. Return the tail of the object.
#! For a string this is everything but the first character.
#! For a list this is the cdr.
[
[ string? ] [ 1 str-tail ]
[ list? ] [ cdr ]
] cond ;
: pfirst ( object -- first )
#! Polymorphic first
phead ;
: psecond ( object -- second )
#! Polymorphic second
[
[ string? ] [ 1 swap str-nth ]
[ list? ] [ cdr car ]
] cond ;
: ph:t ( object -- head tail )
#! Return the head and tail of the object.
dup phead swap ptail ;
: pempty? ( object -- bool )
#! Polymorphic empty test.
[
[ string? ] [ "" = ]
[ list? ] [ not ]
] cond ;
: string-take ( n string -- string )
#! Return a string with the first 'n' characters
#! of the original string.
dup str-length pick < [
2drop ""
] [
swap str-head
] ifte ;
: (list-take) ( n list accum -- list )
>r >r pred dup 0 < [
drop r> drop r> nreverse
] [
r> uncons swap r> cons (list-take)
] ifte ;
: list-take ( n list -- list )
#! Return a list with the first 'n' characters
#! of the original list.
[ ] (list-take) ;
: ptake ( n object -- object )
#! Polymorphic take.
#! Return a collection of the first 'n'
#! characters from the original collection.
[
[ string? ] [ string-take ]
[ list? ] [ list-take ]
] cond ;
: string-drop ( n string -- string )
#! Return a string with the first 'n' characters
#! of the original string removed.
dup str-length pick < [
2drop ""
] [
swap str-tail
] ifte ;
: list-drop ( n list -- list )
#! Return a list with the first 'n' items
#! of the original list removed.
>r pred dup 0 < [
drop r>
] [
r> cdr list-drop
] ifte ;
: pdrop ( n object -- object )
#! Polymorphic drop.
#! Return a collection the same as 'object'
#! but with the first n items removed.
[
[ string? ] [ string-drop ]
[ list? ] [ list-drop ]
] cond ;
: ifte-head= ( string-or-list ch [ quot1 ] [ quot2 ] -- )
#! When the character 'ch' is equal to the head
#! of the string or list, run the quot1 otherwise run quot2.
[ swap phead = ] 2dip ifte ;
: symbol ( ch -- parser )
#! Return a parser that parses the given symbol.
[ ( inp ch -- result )
2dup [
swap ptail cons lunit
] [
2drop [ ]
] ifte-head=
] curry1 ;
: token ( string -- parser )
#! Return a parser that parses the given string.
[ ( inp string -- result )
2dup str-length swap ptake over = [
swap over str-length swap pdrop cons lunit
] [
2drop [ ]
] ifte
] curry1 ;
: satisfy ( p -- parser )
#! Return a parser that succeeds if the predicate 'p',
#! when passed the first character in the input, returns
#! true.
[ ( inp p -- result )
over pempty? [
2drop [ ]
] [
over phead swap call [
ph:t cons lunit
] [
drop [ ]
] ifte
] ifte
] curry1 ;
: satisfy2 ( p r -- parser )
#! Return a parser that succeeds if the predicate 'p',
#! when passed the first character in the input, returns
#! true. On success the word 'r' is called with the
#! successfully parser character on the stack. The result
#! of this is returned as the result of the parser.
[ ( inp p r -- result )
>r over phead swap call [
ph:t swap r> call swons lunit
] [
r> 2drop [ ]
] ifte
] curry2 ;
: epsilon ( -- parser )
#! A parser that parses the empty string.
[ ( inp -- result )
"" swap cons lunit
] ;
: succeed ( r -- parser )
#! A parser that always returns 'r' and consumes no input.
[ ( inp r -- result )
swap cons lunit
] curry1 ;
: fail ( -- parser )
#! A parser that always fails
[
drop [ ]
] ;
USE: prettyprint
USE: unparser
: ensure-list ( a -- [ a ] )
#! If 'a' is not a list, make it one.
dup list? [ unit ] unless ;
: ++ ( a b -- [ a b ] )
#! Join two items into a list.
>r ensure-list r> ensure-list append ;
: <&> ( p1 p2 -- parser )
#! Sequentially combine two parsers, returning a parser
#! that first calls p1, then p2 all remaining results from
#! p1.
[ ( inp p1 p2 -- result )
>r call r> [ ( [ x | xs ] p2 -- result )
>r uncons r> call swap [ ( [ x2 | xs2 ] x -- result )
>r uncons swap r> swap ++ swons
] curry1 lmap
] curry1 lmap lappend*
] curry2 ;
: <|> ( p1 p2 -- parser )
#! Choice operator for parsers. Return a parser that does
#! p1 or p2 depending on which will succeed.
[ ( inp p1 p2 -- result )
rot tuck swap call >r swap call r> lappend
] curry2 ;
: p-abc ( -- parser )
#! Test Parser. Parses the string "abc"
"a" token "b" token "c" token <&> <&> ;
: parse-skipwhite ( string -- string )
dup phead blank? [
ptail parse-skipwhite
] [
] ifte ;
: sp ( parser -- parser )
#! Return a parser that first skips all whitespace before
#! parsing.
[ ( inp parser -- result )
[ parse-skipwhite ] dip call
] curry1 ;
: just ( parser -- parser )
#! Return a parser that works exactly like the input parser
#! but guarantees that the rest string is empty.
[ ( inp parser -- result )
call [ ( [ x | xs ] -- )
cdr str-length 0 =
] lsubset
] curry1 ;
: <@ ( p f -- parser )
#! Given a parser p and a quotation f return a parser
#! that does the same as p but in addition applies f
#! to the resulting parse tree.
[ ( inp p f -- result )
>r call r> [ ( [ x | xs ] f -- [ fx | xs ] )
swap uncons [ swap over [ call ] [ drop ] ifte ] dip cons
] curry1 lmap
] curry2 ;
: p-1 ( -- parser )
"1" token "123" swap call lcar ;
: p-2 ( -- parser )
"1" token [ str>number ] <@ "123" swap call lcar ;
: some ( parser -- det-parser )
#! Given a parser, return a parser that only produces the
#! resulting parse tree of the first successful complete parse.
[ ( inp parser -- result )
just call lcar car
] curry1 ;
: delayed-parser ( [ parser ] -- parser )
[ ( inp [ parser ] -- result )
call call
] curry1 ;
: parens ;
: parens ( -- parser )
#! Parse nested parentheses
"(" token [ parens ] delayed-parser <&>
")" token <&> [ parens ] delayed-parser <&>
epsilon <|> ;
: nesting ( -- parser )
#! Count the maximum depth of nested parentheses.
"(" token [ nesting ] delayed-parser <&> ")" token <&>
[ nesting ] delayed-parser <&> [ .s drop "a" ] <@ epsilon <|> ;
: <& ( parser1 parser2 -- parser )
#! Same as <&> except only return the first item in the parse tree.
<&> [ pfirst ] <@ ;
: &> ( parser1 parser2 -- parser )
#! Same as <&> except only return the second item in the parse tree.
<&> [ psecond ] <@ ;
: lst ( [ x [ xs ] ] -- [x:xs] )
#! I need a good name for this word...
dup cdr [ uncons car cons ] when unit ;
: <*> ( parser -- parser )
#! Return a parser that accepts zero or more occurences of the original
#! parser.
dup [ <*> ] curry1 delayed-parser <&> [ lst ] <@ [ ] succeed <|> ;
: <+> ( parser -- parser )
#! Return a parser that accepts one or more occurences of the original
#! parser.
dup [ <*> ] curry1 delayed-parser <&> [ lst ] <@ ;
: <?> ( parser -- parser )
#! Return a parser where its construct is optional. It may or may not occur.
[ ] succeed <|> ;
: <first> ( parser -- parser )
#! Transform a parser into a parser that only returns the first success.
[
call dup [ lcar lunit ] when
] curry1 ;
: <!*> ( parser -- parser )
#! Version of <*> that only returns the first success.
<*> <first> ;
: <!+> ( parser -- parser )
#! Version of <+> that only returns the first success.
<+> <first> ;
: ab-test
"a" token <*> "b" token <&> "aaaaab" swap call [ . ] leach ;
: ab-test2
"a" token <*> "b" token <&> [ "a" "a" "a" "b" ] swap call [ . ] leach ;
: a "a" token "a" token <&> epsilon <|> ;
: b "b" token epsilon <|> ;
: c "c" token "c" token <&> ;
: d "d" token "d" token <&> ;
: count-a "a" token [ count-a ] delayed-parser &> "b" token <& [ 1 + ] <@ 0 succeed <|> ;
: tca "aaabbb" count-a call [ . ] leach ;
: parse-digit ( -- parser )
#! Return a parser for digits
[ digit? ] satisfy [ CHAR: 0 - ] <@ ;
: (reduce) ( start quot list -- value )
#! Call quot with start and the first value in the list.
#! quot is then called with the result of quot and the
#! next item in the list until the list is exhausted.
uncons >r swap dup dip r> dup [
(reduce)
] [
2drop
] ifte ;
: reduce ( list start quot -- value )
#! Call quot with start and the first value in the list.
#! quot is then called with the result of quot and the
#! next item in the list until the list is exhausted.
rot (reduce) ;
: natural ( -- parser )
#! a parser for natural numbers.
parse-digit <*> [ car 0 [ swap 10 * + ] reduce unit ] <@ ;
: natural2 ( -- parser )
#! a parser for natural numbers.
parse-digit <!+> [ car 0 [ swap 10 * + ] reduce unit ] <@ ;
: integer ( -- parser )
#! A parser that can parser possible negative numbers.
"-" token <?> [ drop -1 ] <@ natural2 <&> [ 1 [ * ] reduce ] <@ ;
: identifier ( -- parser )
#! Parse identifiers
[ letter? ] satisfy <+> [ car cat ] <@ ;
: identifier2 ( -- parser )
#! Parse identifiers
[ letter? ] satisfy <!+> [ car cat ] <@ ;
: ints ( -- parser )
integer "+" token [ drop [ [ + ] ] ] <@ <&>
integer <&> [ call swap call ] <@ ;
: url-quotable ( -- parser )
! [a-zA-Z0-9/_?] re-matches
[ letter? ] satisfy
[ LETTER? ] satisfy <|>
[ digit? ] satisfy <|>
CHAR: / symbol <|>
CHAR: _ symbol <|>
CHAR: ? symbol <|> just ;
: http-header ( -- parser )
[ CHAR: : = not ] satisfy <!+> [ car cat ] <@
": " token [ drop f ] <@ <&>
[ drop t ] satisfy <!+> [ car cat ] <@ <&> just ;
: parse-http-header ( string -- [ name value ] )
http-header call lcar car ;
: get-request ( -- parser )
"GET" token
[ drop t ] satisfy <!+> sp [ car cat ] <@ <&> ;
: post-request ( -- parser )
"POST" token
[ drop t ] satisfy <!+> sp [ car cat ] <@ <&> ;
: all-request ( -- parser )
"POST" token
[ 32 = not ] satisfy <!+> sp [ car cat ] <@ <&>
"HTTP/1.0" token sp <&> ;
: split-url ( -- parser )
"http://" token
[ CHAR: / = not ] satisfy <!*> [ car cat ] <@ <&>
"/" token <&>
[ drop t ] satisfy <!*> [ car cat ] <@ <&> ;

263
contrib/parser-combinators/parser-combinators.html Normal file
View File

@ -0,0 +1,263 @@
<html>
<head>
<title>Parser Combinators</title>
<link rel="stylesheet" type="text/css" href="style.css">
</head>
<body>
<h1>Parsers</h1>
<p class="note">The parser combinator library described here is based
on a library written for the Clean pure functional programming language and
described in chapter 5 of the 'Clean Book'. Based on the description
in that chapter I developed a version for Factor, a concatenative
language.</p>
<p>A parser is a word or quotation that, when called, processes
an input string on the stack, performs some parsing operation on
it, and returns a result indicating the success of the parsing
operation.</p>
<p>The result returned by a parser is known as a 'list of
successes'. It is a lazy list of standard Factor cons cells. Each cons
cell is a result of a parse. The car of the cell is the result of the
parse operation and the cdr of the cell is the remaining input left to
be parsed.</p>
<p>A list is used for the result as a parse operation can potentially
return many successful results. For example, a parser that parses one
or more digits will return more than one result for the input "123". A
successful parse could be "1", "12" or "123".</p>
<p>The list is lazy so if only one parse result is required the
remaining results won't actually be processed if they are not
requested. This improves efficiency.</p>
<p>The car of the result pair can be any value that the parser wishes
to return. It could be the successful portion of the input string
parsed, an abstract syntax tree representing the parsed input, or even
a quotation that should get called for later processing.</p>
<p>A Parser Combinator is a word that takes one or more parsers and
returns a parser that when called uses the original parsers in some
manner.</p>
<h1>Example Parsers</h1>
<p>The following are some very simple parsers that demonstrate how
general parsers work and the 'list of sucesses' that are returned as a
result.</p>
<pre class="code">
(1) : char-a ( inp -- result )
0 over str-nth CHAR: a = [
1 str-tail CHAR: a swons lunit
] [
drop f
] ifte ;
(2) "atest" char-a [ [ . ] leach ] when*
=> [ 97 | "test" ]
(3) "test" char-a [ [ . ] leach ] when*
=>
</pre>
<p>'char-a' is a parser that only accepts the character 'a' in the
input string. When passed an input string with a string with a leading
'a' then the 'list of successes' has 1 result value. The car of that
result value is the character 'a' successfully parsed, and the cdr is
the remaining input string. On failure of the parse an empty list is
returned.</p>
<p>The parser combinator library provides a combinator, <&>, that takes
two parsers off the stack and returns a parser that calls the original
two in sequence. An example of use would be calling 'char-a' twice,
which would then result in an input string expected with two 'a'
characters leading:</p>
<pre class="code">
(1) "aatest" [ char-a ] [ char-a ] <&> call
=> < list of successes >
(2) [ . ] leach
=> [ [ 97 97 ] | "test" ]
</pre>
<h2>Tokens</h2>
<p>Creating parsers for specfic characters and tokens can be a chore
so there is a word that, given a string token on the stack, returns
a parser that parses that particular token:</p>
<pre class="code">
(1) "begin" token
=> < a parser that parses the token "begin" >
(2) dup "this should fail" swap call .
=> f
(3) "begin a successfull parse" swap call
=> < lazy list >
(4) [ . ] leach
=> [ "begin" | " a successfull parse" ]
</pre>
<h2>Predicate matching</h2>
<p>The word 'satisfy' takes a quotation from the top of the stack and
returns a parser than when called will call the quotation with the
first item in the input string on the stack. If the quotation returns
true then the parse is successful, otherwise it fails:</p>
<pre class="code">
(1) : digit-parser ( -- parser )
[ digit? ] satisfy ;
(2) "5" digit-parser call [ . ] leach
=> [ 53 | "" ]
(3) "a" digit-parser call
=> f
</pre>
<p>Note that 'digit-parser' returns a parser, it is not the parser
itself. It is really a parser generating word like 'token'. Whereas
our 'char-a' word defined originally was a parser itself.</p>
<h2>Zero or more matches</h2>
<p>Now that we can parse single digits it would be nice to easily
parse a string of them. The '<*>' parser combinator word will do
this. It accepts a parser on the top of the stack and produces a
parser that parses zero or more of the constructs that the original
parser parsed. The result of the '<*>' generated parser will be a list
of the successful results returned by the original parser.</p>
<pre class="code">
(1) digit-parser <*>
=> < parser >
(2) "123" swap call
=> < lazy list >
(3) [ . ] leach
=> [ [ [ 49 50 51 ] ] | "" ]
[ [ [ 49 50 ] ] | "3" ]
[ [ [ 49 ] ] | "23" ]
[ f | "123" ]
</pre>
<p>In this case there are multiple successful parses. This is because
the occurrence of zero or more digits happens more than once. There is
also the 'f' case where zero digits is parsed. If only the 'longest
match' is required then the lcar of the lazy list can be used and the
remaining parse results are never produced.</p>
<h2>Manipulating parse trees</h2>
<p>The result of the previous parse was the list of characters
parsed. Sometimes you want this to be something else, like an abstract
syntax tree, or some calculation. For the digit case we may want the
actual integer number.</p>
<p>For this we can use the '<@' parser
combinator. This combinator takes a parser and a quotation on the
stack and returns a new parser. When the new parser is called it will
call the original parser to produce the results, then it will call the
quotation on each successfull result, and the result of that quotation
will be the result of the parse:</p>
<pre class="code">
(1) : digit-parser2 ( -- parser )
[ digit? ] satisfy [ CHAR: 0 - ] <@ ;
(2) "5" digit-parser2 call [ . ] leach
=> [ 5 | "" ]
</pre>
<p>Notice that now the result is the actual integer '5' rather than
character code '53'.</p>
<pre class="code">
(1) : natural-parser ( -- parser )
digit-parser2 <*> [ car 0 [ swap 10 * + ] reduce unit ] <@ ;
(2) "123" natural-parser call
=> < lazy list >
(3) [ . ] leach
=> [ [ 123 ] | "" ]
[ [ 12 ] | "3" ]
[ [ 1 ] | "23" ]
[ f | "123" ]
</pre>
<p>The number parsed is the actual integer number due to the operation
of the '<@' word. This allows parsers to not only parse the input
string but perform operations and transformations on the syntax tree
returned.</p>
<h2>Sequential combinator</h2>
<p>To create a full grammar we need a parser combinator that does
sequential compositions. That is, given two parsers, the sequential
combinator will first run the first parser, and then run the second on
the remaining text to be parsed. As the first parser returns a lazy
list, the second parser will be run on each item of the lazy list. Of
course this is done lazily so it only ends up being done when those
list items are requested. The sequential combinator word is <&>.</p>
<pre class="code">
( 1 ) "number:" token
=> < parser that parses the text 'number:' >
( 2 ) natural
=> < parser that parses natural numbers >
( 3 ) <&>
=> < parser that parses 'number:' followed by a natural >
( 4 ) "number:1000" swap call
=> < list of successes >
( 5 ) [ . ] leach
=> [ [ "number:" 1000 ] | "" ]
[ [ "number:" 100 ] | "0" ]
[ [ "number:" 10 ] | "00" ]
[ [ "number:" 1 ] | "000" ]
[ [ "number:" ] | "1000" ]
</pre>
<h2>Choice combinator</h2>
<p>As well as a sequential combinator we need an alternative
combinator. The word for this is <|>. It takes two parsers from the
stack and returns a parser that will first try the first parser. If it
succeeds then the result for that is returned. If it fails then the
second parser is tried and its result returned.</p>
<pre class="code">
( 1 ) "one" token
=> < parser that parses the text 'one' >
( 2 ) "two" token
=> < parser that parses the text 'two' >
( 3 ) <|>
=> < parser that parses 'one' or 'two' >
( 4 ) "one" over call [ . ] leach
=> [ "one" | "" ]
( 5 ) "two" swap call [ . ] leach
=> [ "two" | "" ]
</pre>
<h2>Skipping Whitespace</h2>
<p>A parser transformer exists, the word 'sp', that takes an existing
parser and returns a new one that will first skip any whitespace
before calling the original parser. This makes it easy to write
grammers that avoid whitespace without having to explicitly code it
into the grammar.</p>
<pre class="code">
( 1 ) natural
=> < a parser for natural numbers >
( 2 ) "+" token sp
=> < parser for '+' which ignores leading whitespace >
( 3 ) over sp
=> < a parser for natural numbers skipping leading whitespace >
( 4 ) <&> <&>
=> < a parser for natural + natural >
( 5 ) "1 + 2" over call lcar .
=> [ [ 1 "+" 2 ] | "" ]
( 6 ) "3+4" over call lcar .
=> [ [ 3 "+" 4 ] | "" ]
</pre>
<h2>Eval grammar example</h2>
<p>This example presents a simple grammar that will parse a number
followed by an operator and another number. A factor expression that
computes the entered value will be executed.</p>
<pre class="code">
( 1 ) natural
=> < a parser for natural numbers >
( 2 ) "/" token "*" token "+" token "-" token <|> <|> <|>
=> < a parser for the operator >
( 3 ) sp [ unit [ eval ] append unit ] <@
=> < operator parser that skips whitespace and converts to a
factor expression >
( 4 ) natural sp
=> < a whitespace skipping natural parser >
( 5 ) <&> <&> [ call swap call ] <@
=> < a parser that parsers the expression, converts it to
factor, calls it and puts the result in the parse tree >
( 6 ) "123 + 456" over call lcar .
=> [ 579 | "" ]
( 7 ) "300-100" over call lcar .
=> [ 200 | "" ]
( 8 ) "200/2" over call lcar .
=> [ 100 | "" ]
</pre>
<p>It looks complicated when expanded as above but the entire parser,
factored a little, looks quite readable:</p>
<pre class="code">
( 1 ) : operator ( -- parser )
"/" token
"*" token <|>
"+" token <|>
"-" token <|>
[ unit [ eval ] append unit ] <@ ;
( 2 ) : expression ( -- parser )
natural
operator sp <&>
natural sp <&>
[ call swap call ] <@ ;
( 3 ) "40+2" expression call lcar .
=> [ 42 | "" ]
</pre>
<p class="footer">
News and updates to this software can be obtained from the authors
weblog: <a href="http://radio.weblogs.com/0102385">Chris Double</a>.</p>
<p id="copyright">Copyright (c) 2004, Chris Double. All Rights Reserved.</p>
</body> </html>

28
contrib/parser-combinators/style.css Normal file
View File

@ -0,0 +1,28 @@
body { background: white; color: black; }
p { margin-left: 10%; margin-right: 10%;
font: normal 100% Verdana, Arial, Helvetica; }
td { margin-left: 10%; margin-right: 10%;
font: normal 100% Verdana, Arial, Helvetica; }
table { margin-left: 10%; margin-right: 10%; }
ul { margin-left: 10%; margin-right: 10%;
font: normal 100% Verdana, Arial, Helvetica; }
ol { margin-left: 10%; margin-right: 10%;
font: normal 100% Verdana, Arial, Helvetica; }
h1 { text-align: center; margin-bottom: 0; margin-top: 1em; }
h2 { margin: 0 5% 0 7.5%; font-size: 120%; font-style: italic; }
h3 { border: 2px solid blue; border-width: 2px 0.5em 2px 0.5em;
padding: 0.2em 0.2em 0.2em 0.5em; background: #fafafa;
margin-left: 10%; margin-right: 10%; margin-top: 2em;
font-size: 100%; }
.note { border: 2px solid blue; border-width: 2px 2px 2px 2em;
padding: 0.5em 0.5em 0.5em 1em; background: #ffe; }
.code { border: 1px solid black; border-width: 1px;
padding: 0.5em; background: #ffe;
margin-left: 10%; margin-right: 10%; }
blockquote { margin-left: 25%; margin-right: 25%;
font-style: italic; }
.highlite { color: red; }
.footer { margin-top: 2.5em; border-top: 1px solid gray; color:
#AAA; font-size: 85%; padding-top: 0.33em; }
#copyright { text-align: center; color: #AAA;
font-size: 65%; }

56
doc/alien.txt Normal file
View File

@ -0,0 +1,56 @@
SOME NOTES ON FACTOR'S FFI
The FFI is quite a neat design and I think it is better than JNI and
similar approaches. Also, it offers better performance than libffi et
al. Of course, both of those technologies are great and Factor FFI has
its drawbacks -- namely, its not portable.
All FFI words are in the "alien" vocabulary.
The basic principle is generating machine stubs from C function
prototypes. The main entry point is the 'alien-call' word, which is
defined as simply throwing an error. However, it is given special
compilation behavior. This means it can only be used in compiled words.
Here is an example from sdl-video.factor:
: SDL_LockSurface ( surface -- )
"int" "sdl" "SDL_LockSurface" [ "surface*" ] alien-call ; compiled
The parameters are:
"int" - return type. later it will be surface*
"sdl" - library
"SDL_LockSurface" - function
[ "surface*" ] - parameters
Note the word ends with 'compiled'. This is a hack and won't be needed
later.
Parameters and return values are C type names. C types include the
following:
- char - 1 byte signed
- short - 2 bytes signed
- int - 4 bytes signed
- void* - word-size width field, can only be used as a parameter
Structs can be defined in this fashion:
BEGIN-STRUCT: point
FIELD: int x
FIELD: int y
END-STRUCT
And then referred to in parameter type specifiers as "point*". Struct
return values are not yet supported.
Enumerations can be defined; they simply become words that push
integers:
BEGIN-ENUM: 0
ENUM: int xuzzy
ENUM: int bax
END-ENUM
The parameter to BEGIN-ENUM specifies the starting index.

898
doc/compiler-impl.txt Normal file
View File

@ -0,0 +1,898 @@
IMPLEMENTATION OF THE FACTOR COMPILER
Compilation of Factor is a messy business, driven by heuristics and not
formal theory. The compiler is inherently limited -- some expressions
cannot be compiled by definition. The programmer must take care to
ensure that performance-critical sections of code are written such that
they can be compiled.
=== Introduction
==== The problem
The Factor interpreter introduces a lot of overhead:
- Execution of a quotation involves iteration down a linked list.
- Stack access is not as fast as local variables, since Java
bound-checks all array accesses.
- At the lowest level, everything is expressed as Java reflection calls
to the Factor and Java platform libraries. Java reflection is not as
fast as statically-compiled Java calls.
- Since Factor is dynamically-typed, intermediate values on the stack
are all stored as java.lang.Object types, so type checks and
possibly coercions must be done at each step of the computation.
==== The solution
The following optimizations naturally suggest themselves, and lead to
the implementation of the Factor compiler:
- Compiling Factor code down to Java platform bytecode.
- Using virtual machine local variables instead of an array stack to
store intermediate values.
- Statically compiling in Java calls where the class, method and
variable names are known ahead of time.
- Type inference and soft typing to eliminate unnecessary type checks.
(At the time of writing, this is in progress and is not documented in
this paper.)
=== Preliminaries: interpreter internals
A word object is essentially a property list. The one property we are
concerned with here is "def", which holds a FactorWordDefinition object.
The accessor word "worddef" pushes the "def" slot of a given word name
or word object:
0] "+" worddef .
#<factor.FactorCompoundDefinition: +>
Generally, the word definition is an opaque object, however there are
various ways to deconstruct it, which will not be convered here (see the
worddef>list word if you are interested).
When a word object is being executed, the eval() method of its
definition is invoked. The eval() method takes one parameter, which is
the FactorInterpreter instance. The interpreter instance provides access
to the stacks, global namespace, vocabularies, and so on.
(In this article, we will use the term "word" and "word definition"
somewhat interchangably; this does not cause any confusion. If a "word"
is mentioned where one would expect a definition, simply assume the
"def" slot of the word is being accessed.)
The class FactorWordDefinition is abstract; a number of subclasses
exist:
- FactorCompoundDefinition: a standard colon definition consisting of
a quotation; for example, : sq dup * ; is syntax for a compound
definition named "sq" with quotation [ dup * ].
Of course, its eval() method simply pushes the quotation on the
interpreter's callstack.
- FactorShuffleDefinition: a stack rearrangement word, whose syntax is
described in detail in parser.txt. For example,
~<< swap a b -- b a >>~ is syntax for a shuffle definition named
"swap" that exchanges the top two values on the data stack.
- FactorPrimitiveDefinition: primitive word definitions are written in
Java. Various concrete subclasses of this class in the
factor.primitives package provide implementations of eval().
When a word definition is compiled, the compiler dynamically generates a
new class, creates a new instance, and replaces the "def" slot of the
word in question with the instance of the compiled class.
So the compiler's primary job is to generate appropriate Java bytecode
for the eval() method.
=== Preliminaries: the specimen
Consider the following (naive) implementation of the Fibonacci sequence:
: fib ( n -- nth fibonacci number )
dup 1 <= [
drop 1
] [
pred dup fib swap pred fib +
] ifte ;
A quick overview of the words used here:
- dup: a shuffle word that duplicates the top of the stack.
- <=: compare the top two numbers on the stack.
- drop: remove the top of the stack.
- pred: decrement the top of the stack by one. Indeed, it is defined as
simply : pred 1 - ;.
- swap: exchange the top two stack elements.
- +: add the top two stack elements.
- ifte: execute one of two given quotations, depending on the condition
on the stack.
=== Java reflection
The biggest performance improvement comes from the transformation of
Java reflection calls into static bytecode.
Indeed, when the compiler was first written, the only type of word it
could compile were such simple expressions that interfaced with Java and
nothing else.
In the above definition of "fib", the three key words <= - and + (note
that - is not referenced directly, but rather is a factor of the word
pred). All three of these words are implemented as Java calls into the
Factor math library:
: <= ( a b -- boolean )
[
"java.lang.Number" "java.lang.Number"
] "factor.math.FactorMath" "lessEqual" jinvoke-static ;
: - ( a b -- a-b )
[
"java.lang.Number" "java.lang.Number"
] "factor.math.FactorMath" "subtract" jinvoke-static ;
: + ( a b -- a+b )
[
"java.lang.Number" "java.lang.Number"
] "factor.math.FactorMath" "add" jinvoke-static ;
During interpretation, the execution of one of these words involves a
lot of overhead. First, the argument list is transformed into a Java
Class[] array; then the Class object corresponding to the containing
class is looked up; then the appropriate Method object defined in this
class is looked up; then the method is invoked, by passing it an
Object[] array consisting of arguments from the stack.
As one might guess, this is horribly inefficient. Indeed, look at the
time taken to compute the 25th Fibonacci number using pure
interpretation (of course depending on your hardware, results might
vary):
0] [ 25 fib ] time
24538
One quickly notices that in fact, all the overhead from the reflection
API is unnecessary; the containing class, method name and argument types
are, after all, known ahead of time.
For instance, the word "<=" might be compiled into the following
pseudo-bytecode (the details are a bit more complex in reality; we'll
get to it later):
MOVE datastack[top - 2] to JVM stack // get operands in right order
CHECKCAST java/lang/Number
MOVE datastack[top - 1] to JVM stack
CHECKCAST java/lang/Number
DECREMENT datastack.top 2 // pop the operands
INVOKESTATIC // invoke the method
"factor/FactorMath"
"lessEqual"
"(Ljava/lang/Number;Ljava/lang/Number;)Ljava/lang/Number;"
MOVE JVM stack top to datastack // push return value
Notice that no dynamic class or method lookups are done, and no arrays
are constructed; in fact, a modern Java virtual machine with a native
code compiler should be able to transform an INVOKESTATIC into a simple
subroutine call.
So what how much overhead is eliminated in practice? It is easy to find
out:
5] [ + - <= ] [ compile ] each
1] [ 25 fib ] time
937
This is still quite slow -- however, already we've gained a 26x speed
improvement!
Words consisting entirely of literal parameters to Java primitives such
as jinvoke, jnew, jvar-get/set, or jvar-get/set-static are compiled in a
similar manner; there is nothing new there.
=== First attempt at compiling compound definitions
Now consider the problem of compiling a word that does not directly call
Java primitives, but instead calls other words, which are already been
compiled.
For instance, consider the following word (recall that (...) is a comment!):
: mag2 ( x y -- sqrt[x*x+y*y] )
swap dup * swap dup * + sqrt ;
Lets assume that 'swap', 'dup', '*' and '+' are defined as before, and
that 'sqrt' is an already-compiled word that calls into the math
library.
Assume that the pseudo-bytecode INVOKEWORD <word> invokes the "eval"
method of a FactorWordDefinition instance.
(In reality, it is a bit more complex:
GETFIELD ... some field that stores a FactorWordDefinition instance ...
ALOAD 0 // push interpreter parameter to eval() on the stack
INVOKEVIRTUAL
"factor/FactorWordDefinition"
"eval"
"(Lfactor/FactorInterpreter;)V"
However the above takes up more space and adds no extra information over
the INVOKE notation.)
Now, we have the tools necessary to try compiling "mag2" as follows:
INVOKEWORD swap
INVOKEWORD dup
INVOKEWORD *
INVOKEWORD swap
INVOKEWORD dup
INVOKEWORD *
INVOKEWORD +
INVOKEWORD sqrt
In other words, the words still shuffle values back and forth on the
interpreter data stack as before; however, instead of the interpreter
iterating down a word thread, compiled bytecode invokes words directly.
This might seem like the obvious approach; however, it turns out it
brings very little performance benefit over simply iterating down a
linked list representing a quotation!
What we would like to do is just eliminate use of the interpreter's
stack for intermediate values altogether, and just loading the inputs at
the beginning and storing them at the end.
=== Avoiding the interpreter stack
The JVM is a stack machine, however its semantics are so different that
a direct mapping of interpreter stack use to stack bytecode would not
be feasable:
- No arbitrary stack access is allowed in Java; only a few, fixed stack
bytecodes like POP, DUP, SWAP are provided.
- A Java function receives input parameters in local variables, not in
the JVM stack.
In fact, the second point suggests that it is a better idea is to use
JVM *local variables* for temporary storage in compiled definitions.
Since no indirect addressing of locals is permitted, stack positions
used in computations must be known ahead of time. This process is known
as "stack effect deduction", and is the key concept of the Factor
compiler.
=== Fundamental idea: eval/core split
Earlier, we showed pseudo-bytecode for the word <=, however it was noted
that the reality is a bit more complicated.
Recall that FactorWordDefinition.eval() takes an interpreter instance.
It is the responsibility of this method to marshall and unmarshall
values on the interpreter stack before and after the word performs any
computation on the values.
In actual fact, compiled word definitions have a second method named
core(). Instead of accessing the interpreter data stack directly, this
method takes inputs from formal parameters passed to the method, in the
natural stack order.
So, lets look at possible disassembly for the eval() and core() methods
of the word <=:
void eval(FactorInterpreter interp)
ALOAD 0 // push interpreter instance on JVM stack
MOVE datastack[top - 2] to JVM stack // get operands in right order
CHECKCAST java/lang/Number
MOVE datastack[top - 1] to JVM stack
CHECKCAST java/lang/Number
DECREMENT datastack.top 2 // pop the operands
INVOKESTATIC // invoke the method
... compiled definition class name ...
"core"
"(Lfactor/FactorInterpreter;Ljava/lang/Object;Ljava/lang/Object;)
Ljava/lang/Object;"
MOVE JVM stack top to datastack // push return value
Object core(FactorInterpreter interp, Object x, Object y)
ALOAD 0 // push formal parameters
ALOAD 1
ALOAD 2
INVOKESTATIC // invoke the actual method
"factor/FactorMath"
"lessEqual"
"(Ljava/lang/Number;Ljava/lang/Number;)Ljava/lang/Number;"
ARETURN // pass return value up to eval()
==== Using the JVM stack and locals for intermediates
At first glance it seems nothing was achieved with the eval/core split,
excepting an extra layer of overhead.
However, the new revalation here is that compiled word definitions can
call each other's core methods *directly*, passing in the parameters
through JVM local variables, without the interpreter data stack being
involved!
Instead of pseudo-bytecode, from now on we will consider a very
abstract, high level "register transfer language". The extra verbosity
of bytecode will only distract from the key ideas.
Tentatively, we would like to compile the word 'mag2' as follows:
r0 * r0 -> r0
r1 * r1 -> r1
r0 + r1 -> r0
sqrt r0 -> r0
return r0
However this looks very different from the original, RPN definition; in
particular, we have named values, and the stack operations are gone!
As it turns out, there is a automatic way to transform the stack program
'mag2' into the register transfer program above (the reverse is also
possible, but will not be discussed here).
==== Stack effect deduction
Consider the following quotation:
[ swap dup * swap dup * + sqrt ]
The transformation of the above stack code into register code consists
of two passes.
(A one-pass approach is also possible; however because of the design of
the assembler used by the compiler, an extra pass will be required
elsewhere if this transformation described here is single-pass).
The first pass is simply to determine the total number of input and
output parameters of the quotation (its "stack effect"). We proceed as
follows.
1. Create a 'simulated' datastack. It does not contain actual values,
but rather markers.
Set the input parameter count to zero.
2. Iterate through each element of the quotation, and act as follows:
- If the element is a literal, allocate a simulated stack entry.
- If the element is a word, ensure that the stack has at least as
many items as the word's input parameter count.
If the stack does not have enough items, increment the input
parameter count by the difference between the stack item count and
the word's expected input parameter count, and fill the stack with
the difference.
Decrement the stack pointer by the word's input parameter count.
Increment the stack pointer by the word's output parameter count,
filling the new entries with markers.
3. When the end of the quotation is reached, the output parameter count
is the number of items on the simulated stack. The input parameter
count is the value of the intermediate parameter created in step 1.
Note that this algorithm is recursive -- to determine the stack effect
of a word, the stack effects of all its factors must be known. For now,
assume the stack effects of words that use the Java primitives are
"trivially" known.
A brief walkthrough of the above algorithm for the quotation
[ swap dup * swap dup * + sqrt ]:
swap - the simulated stack is empty but swap expects two parameters,
so the input parameter count becomes 2.
two empty markers are pushed on the simulated stack:
# #
dup - requires one parameter, which is already present.
another empty marker is pushed on the simulated stack:
# # #
* - requires two parameters, and returns one parameter, so the
simulated stack is now:
# #
swap - requires and returns two parameters.
# #
dup - requires one, returns two parameters.
# # #
* - requires two, and returns one parameter.
# #
+ - requires two, and returns one parameter.
#
sqrt - requires one, and returns one parameter.
#
So the input parameter count is two, and the output parameter count is
one (since at the end of the quotation the simulated datastack contains
one item marker).
==== The dataflow algorithm
The second pass of the compiler algorithm relies on the stack effect
already being known. It consists of these steps:
1. Create a new simulated stack. For each input parameter, a new entry
is allocated. This time, entries are not blank markers, but rather
register numbers.
2. Iterate through each element of the quotation, and act as follows:
- If the element is a literal, allocate a simulated stack entry.
This time, allocation finds an unused register number by checking
each stack entry.
- If the element is a shuffle word, apply the shuffle to the
simulated stack *and do not emit any code!*
- If the element is another word, pop the appropriate number of
register numbers from the simulated stack, and emit assembly code
for invoking the word with parameters stored in these registers.
Decrement the simulated stack pointer by the word's input parameter
count.
Increment the simulated stack pointer by the word's output
parameter count, filling the new entries with newly-allocated
register numbers.
Emit assembly code for moving the return values of the word into
the newly allocated registers.
Voila! The 'simulated stack' is a compile time only notion, and the
resulting emitted code does not explicitly reference any stacks at all;
in fact, applying this algorithm to the following quotation:
[ swap dup * swap dup * + sqrt ]
Yields the following output:
r0 * r0 -> r0
r1 * r1 -> r1
r0 + r1 -> r0
sqrt r0 -> r0
return r0
==== Multiple return values
A minor implementation detail is multiple return values. Java does not
support them directly, but a Factor word can return any number of
values. This is implemented by temporarily using the interpreter data
stack to return multiple values. This is the only time the interpreter
data stack is used.
==== The call stack
Sometimes Factor code uses the call stack as an 'extra hand' for
temporary storage:
dup >r + r> *
The dataflow algorithm can be trivially generalized with two simulated
stacks; there is nothing more to be said about this.
=== Questioning assumptions
The dataflow compilation algorithm gives us another nice performance
improvement. However, the algorithm assumes that the stack effect of
each word is known a priori, or can be deduced using the algorithm.
The algorithm falls down when faced with the following more complicated
expressions:
- Combinators calling the 'call' and 'ifte' primitives
- Recursive words
So ironically, this algorithm is unsuitable for code where it would help
the most -- complex code with a lot of branching, and tight loops and
recursions.
=== Eliminating explicit 'call':
As described above, the dataflow algorithm would break when it
encountered the 'call' primitive:
[ 2 + ] 5 swap call
The 'call' primitive executes the quotation at the top of the stack. So
its stack effect depends on its input parameter!
The first problem we faced was compilation of Java reflection
primitives. A critical observation was that all the information to
compile them efficiently was 'already there' in the source.
Our intuitition tells us that in the above code, the occurrence of
'call' *always* receives the parameter of [ 2 + ]; so somehow, the
quotation can be transformed into the following, which we can already
compile:
[ 2 + ] 5 swap drop 2 +
^^^^^^^^
"immediate instantiation" of 'call'
Or indeed, once the unused literal [ 2 + ] is factored out, simply:
5 2 +
==== Generalizing the 'simulated stack'
It might seem surprising that such expressions can be easily compiled,
once the 'simulated stack' is generalized such that it can hold literal
values!
The only change that needs to be made, is that in both passes, when a
literal is encountered, it is pushed directly on the simulated stack.
Also, when the primitive 'call' is encountered, its stack effect is
assumed to be the stack effect of the literal quotation at the top of
the simulated stack.
(What if the top of the simulated stack is a register number? The word
cannot be compiled, since the stack effect can potentially be
arbitrary!)
Being able to compile 'call' whose parameters are literals from the
same word definition doesn't really add nothing new.
A real breakthrough would be compiling "combinators"; words that take
parameters that are themselves quotations.
As it turns out, combinators themselves are not compiled -- however,
specific *instances* of combinators in other word definitions are.
For example, we can rewrite our word 'mag2' as follows:
: mag2 ( x y -- sqrt[x*x+y*y] )
[ sq ] 2apply + sqrt ;
Where 2apply is defined as follows:
: 2apply ( x y [ code ] -- )
2dup 2>r nip call 2r> call ;
How can we compile this new, equivalent, form of 'mag2'?
==== Inline words
Normally, when the dataflow algorithm encounters a word as an element
of a quotation, a call to that word's core() method is emitted. However,
if the word is compiled 'immediately', its definition is substituted in.
Assume for a second that in the new form of 'mag2', the word '2apply' is
compiled inline (ignoring the specifics of how this decision is made).
In other words, it is as if 'mag2' was defined as follows:
: mag2 ( x y -- sqrt[x*x+y*y] )
[ sq ] 2dup 2>r nip call 2r> call + sqrt ;
However, we already have a way of compiling the above code; in fact it
is compiled into the equivalent of:
: mag2 ( x y -- sqrt[x*x+y*y] )
[ sq ] 2dup 2>r nip drop sq 2r> drop sq + sqrt ;
^^^^^^^ ^^^^^^^
immediate instantiation of 'call'
As an aside, recall that the stack words 2dup, 2>r, nip, drop, and 2r>
do not emit any code, and the 'drop' of the literal [ sq ] ensures that
it never makes it to the compiled definition. The end-result is that the
register-transfer code is identical to the earlier definition of 'mag2'
which did not involve 2apply:
r0 * r0 -> r0
r1 * r1 -> r1
r0 + r1 -> r0
sqrt r0 -> r0
return r0
So, how is the decision made to compile a word inline, or not? It is
quite simple. If the word has a deducable stack effect on the simulated
stack of the current compilation, but it does *not* have a deducable
stack effect on an empty simulated stack, it is compiled immediate.
For example, the following word has a deducable stack effect, regardless
of the values of any literals on the simulated stack:
: sq ( x -- x^2 )
dup * ;
So the word 'sq' is always compiled normally.
However, the '2apply' word we saw earlier does not have a deducable
stack effect unless there is a literal quotation at the top of the
simulated stack:
: 2apply ( x y [ code ] -- )
2dup 2>r nip call 2r> call ;
So it is compiled inline.
Sometimes it is desirable to have short non-combinator words inlined.
While this is not necessary (whereas non-inlined combinators do not
compile), it can increase performance, especially if the word returns
multiple values (and without inlining, the interpreter datastack will
need to be used).
To mark a word for inline compilation, use the word 'inline' like so:
: sq ( x -- x^2 )
dup * ; inline
The word 'inline' sets the inline slot of the most recently defined word
object.
(Indeed, to push a reference to the most recently defined word object,
use the word 'word').
=== Branching
The only branching primitive supported by factor is 'ifte'. The syntax
is as follows:
2 2 + 4 = ( condition that leaves boolean on the stack )
[
( code to execute if condition is true )
] [
( code to execute if condition is false )
] ifte
Note that the different components might be spread between words, and
affected by stack operations in transit. Due to the dataflow algorithm
and inlining, all useful cases can be handled correctly.
==== Not all branching forms have a deducable stack effect
The first observation we gain is that if the two branches leave the
stack in inconsistent states, then stack positions used by subsequent
code will depend on the outcome of the branch.
This practice is discouraged anyway -- it leads to hard-to-understand
code -- so it is not supported by the compiler. If you must do it, the
words will always run in the interpreter.
Attempting to compile or balance an expression with such a branch raises
an error:
9] : bad-ifte 3 = [ 1 2 3 ] [ 2 2 + ] ifte ;
10] word effect .
break called.
:r prints the callstack.
:j prints the Java stack.
:x returns to top level.
:s returns to top level, retaining the data stack.
:g continues execution (but expect another error).
ERROR: Stack effect of [ 1 2 3 ] ( java.lang.Object -- java.lang.Object
java.lang.Object java.lang.Object ) is inconsistent with [ 2 2 + ] (
java.lang.Object -- java.lang.Object )
Head is ( java.lang.Object -- )
Recursive state:
[ #<ifte,base=null,effect=( java.lang.Object -- boolean java.lang.Object
java.lang.Object ); null.null()> #<bad-ifte,base=null,effect=( -- );
null.null()> ]
==== Merging
Lets return to our register transfer language, and add a branching
notation:
- two-instruction sequence to branch to <label> if <register> is null
ALOAD <register>
IFNULL <label>
- unconditional goto to <label>
GOTO <label>
So a simple conditional
rot [
(true)
] [
(false)
] ifte
Will be compiled as follows, where the inputs are in registers 1, 2, 3
1 ALOAD 1
2 IFNULL 5
3 (true)
4 GOTO 6
5 (false)
6 RETURN
However the question arises, what becomes of the simulated stack after
the branches are done.
For example, consider this snippet:
random-int random-int random-boolean [
swap
] [
] ifte
The first three words followed by the branch itself are compiled like
so:
1 1 <- random-int
2 2 <- random-int
3 3 <- random-boolean
4 ALOAD 3
5 IFNULL 8
However, a problem arises because if the true branch is taken, the
simulated stack contains register 1 at the top, and register 2 below;
but if the false branch is taken, it is the opposite!
The solution is to "merge" the stacks at the end of each branch. So
the remainder of our code might be compiled as follows:
6 1 <-> 2 // new notation: exchange registers 1 and 2
7 GOTO 8
8 RETURN
=== Recursion
Consider our old friend 'fib':
: fib ( n -- nth fibonacci number )
dup 1 <= [
drop 1
] [
pred dup fib swap pred fib +
] ifte ;
Using the tools we have, we cannot deduce its stack effect yet, since
the false branch of the 'ifte' refers to the word 'fib' itself.
A critical observation is if the word is to complete, eventually, the
test will fail and 'drop 1' will be executed.
Note that this implies that when given a parameter of 0 or 1, the
stack effect of 'fib' is ( X -- X ).
==== What is the stack effect?
To see how to deduce the stack effect of the recursive case, it is
necessary to make a mental leap. Consider the case where the parameter
to fib is 2. The word recurses twice, and in each case, the parameter
to the recursive call is <= 1, so 'drop 1' is executed.
So when the parameter is 2, the stack effect is also ( X -- X )!
In fact it is not hard to usee that if the stack effect of 'fib' with
parameter n-1 and n-2 is ( X -- X ), then the stack effect of 'fib' with
parameter n is also ( X -- X ).
Therefore by induction, for any input, 'fib' has stack effect
( X -- X ).
Once the stack effect is known, it is easy enough to compile; just treat
the two recursive calls like calls to any other word with stack effect
( X -- X ).
==== Not all recursive forms have a deducable stack effect
Consider the following word:
: push ( list -- ... )
dup [
uncons push
] unless ;
If the top of the stack is null, the word returns. So the base case is (
X -- X ).
However if the top of the stack is a list of one element, the word has
stack effect ( X -- X X ), since 'uncons' has stack effect ( X -- X X )
and the base case is ( X -- X ).
If we proceed, we find that if the top of the stack is a list of two
elements, the stack effect of the word is ( X -- X X X ).
The stack positions used for intermediate values can no longer be
determined ahead of time.
A word whose stack effect depends on input is said to 'diverge'. Since
it is generally good practice to only write converging recursive words,
it is not a big loss that the compiler does not support them. Of course,
such words still work in the interpreter.
==== Auxiliary methods
So far, we can compile recursive words such as 'fib' and tail-recursive
words such as 'list?'. Now, lets try applying our techniques to a word
that calls a recursive combinator:
: reverse ( list -- list )
[ ] swap [ swons ] each ;
Recall that 'swons' creates a cons cell with stack effect
( cdr car -- [ car , cdr ] ) -- the opposite order of 'cons', which has stack effect ( car cdr -- [ car , cdr ] ).
The combinator 'each' is defined as follows:
: each ( [ list ] [ quotation ] -- )
over [
>r uncons r> tuck 2>r call 2r> each
] [
2drop
] ifte ;
If we apply our previous inling technique, however, the end result is
absurd, since the recursive call to 'each' remains:
: reverse ( list -- list )
f swap [ swons ] over [
>r uncons r> tuck 2>r call 2r> each
] [
2drop
] ifte ;
However, if the recursive call is changed to 'reverse', then the result
is also incorrect, since '[ ] swap' would be executed on each iteration.
The solution is to place instances of recursive combinators in an
'auxiliary method' in the same class as the definition being compiled.
So in fact, 'reverse' is compiled as three methods, eval(), core(), and
aux_each_0().
==== Wrapping up
There are two implementation details not covered here; they are not
really 'interesting' and best described by the source code anyway:
- tail-recursive words are compiled with a GOTO not a method invocation
at the end of the recursive case.
- some extra steps are needed to normalize the stack after recursive
calls, and when auxiliary methods are being generated.
=== Conclusion
Finally, lets see what kind of improvement we get over naive
interpretation when our old friend the 'fib' word is compiled using all
the techniques mentioned above:
3] "fib" compile
4] [ 25 fib ] time
123
That's right -- a 200x improvement over pure interpretation.

2404
doc/devel-guide.tex Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
doc/devel-guide/blueball.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 333 B

BIN
doc/devel-guide/ch_beg_r.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 165 B

BIN
doc/devel-guide/ch_begin.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 174 B

BIN
doc/devel-guide/ch_del_r.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 288 B

BIN
doc/devel-guide/ch_delet.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 288 B

BIN
doc/devel-guide/ch_end.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 171 B

BIN
doc/devel-guide/ch_end_r.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 155 B

BIN
doc/devel-guide/contents.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 278 B

BIN
doc/devel-guide/crossref.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 147 B

BIN
doc/devel-guide/footnote.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 190 B

BIN
doc/devel-guide/greenball.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 333 B

BIN
doc/devel-guide/image.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 244 B

BIN
doc/devel-guide/index.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 246 B

BIN
doc/devel-guide/next.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 245 B

BIN
doc/devel-guide/next_g.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 272 B

BIN
doc/devel-guide/nx_grp.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 314 B

BIN
doc/devel-guide/nx_grp_g.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 386 B

BIN
doc/devel-guide/orangeball.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 333 B

BIN
doc/devel-guide/pinkball.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 332 B

BIN
doc/devel-guide/prev.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 279 B

BIN
doc/devel-guide/prev_g.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 327 B

BIN
doc/devel-guide/purpleball.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 332 B

BIN
doc/devel-guide/pv_grp.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 352 B

BIN
doc/devel-guide/pv_grp_g.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 430 B

BIN
doc/devel-guide/redball.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 332 B

BIN
doc/devel-guide/up.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 211 B

BIN
doc/devel-guide/up_g.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 231 B

BIN
doc/devel-guide/whiteball.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 229 B

BIN
doc/devel-guide/yellowball.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 333 B

BIN
doc/jedit/complete.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.8 KiB

BIN
doc/jedit/describe.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
doc/jedit/edit-word.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.3 KiB

BIN
doc/jedit/error.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.1 KiB

173
doc/jedit/index.html Normal file
View File

@ -0,0 +1,173 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head><title>Factor plugin</title>
<style>
.fancy-heading { background: #c0d0ff; border: 1px solid #2040ff; }
div.fancy-heading { padding: 1px; margin: 0px 0px 3px 0px; }
.nice-box {
padding: 4px;
border-width: 1px;
border-style: dashed;
}
.syntax0 {
color: #000000;
}
.syntax1 {
color: #cc0000;
}
.syntax2 {
color: #ff8400;
}
.syntax3 {
color: #6600cc;
}
.syntax4 {
color: #cc6600;
}
.syntax5 {
color: #ff0000;
}
.syntax6 {
color: #9966ff;
}
.syntax7 {
background: #ffffcc;
color: #ff0066;
}
.syntax8 {
color: #006699;
font-weight: bold;
}
.syntax9 {
color: #009966;
font-weight: bold;
}
.syntax10 {
color: #0099ff;
font-weight: bold;
}
.syntax11 {
color: #66ccff;
font-weight: bold;
}
.syntax12 {
color: #02b902;
}
.syntax13 {
color: #ff00cc;
}
.syntax14 {
color: #cc00cc;
}
.syntax15 {
color: #9900cc;
}
.syntax16 {
color: #6600cc;
}
.syntax17 {
color: #0000ff;
}
.syntax18 {
color: #000000;
font-weight: bold;
}
.gutter {
background: #dbdbdb;
color: #000000;
}
.gutterH {
background: #dbdbdb;
color: #666699;
}
</style>
</head>
<body>
<h1 align="center">Factor plugin</h1>
<p><a href="http://factor.sourceforge.net">Factor</a> is a programming language with postfix syntax. The Factor plugin for <a href="http://www.jedit.org">jEdit</a> provides many nifty time-saving features for working with Factor code.<p>
<h2 class="fancy-heading">Introduction</h2>
If Factor is compiled with the jEdit classes in the class path, the resulting <code>Factor.jar</code> can then be placed in <code>$HOME/.jedit/jars/</code> and loaded by jEdit.<p>
Note that while the Factor plugin requires jEdit 4.2pre15, you will need to download and install the Factor edit mode separately from the <a href="http://factor.sf.net">Factor home page</a>. If you are running jEdit 4.2final, this edit mode is already included.
<h2 class="fancy-heading">Embedded interpreter</h2>
<p>The plugin embeds a Factor interpreter inside jEdit that gets lazily loaded when first used. The interpreter communicates with the plugin and vice versa to perform various useful tasks.</p>
<p>The <b>Run current file</b> and <b>Evaluate selection</b> commands can be used to send text from jEdit to the interpreter.<p>
<img class="nice-box" src="listener.png">
<p>If you have CFactor installed, it is possible to embed it in jEdit using the <code>inferior.factor</code> socket protocol. Add the following to your <code>$HOME/.factor-rc</code>:
<PRE class="nice-box"><SPAN CLASS="syntax17">USE:</SPAN><SPAN CLASS="syntax17"> </SPAN><SPAN CLASS="syntax17">telnetd</SPAN>
<SPAN CLASS="syntax17">:</SPAN><SPAN CLASS="syntax17"> </SPAN><SPAN CLASS="syntax17">inf</SPAN> <SPAN CLASS="syntax5">9999</SPAN> telnetd <SPAN CLASS="syntax17">;</SPAN>
<SPAN CLASS="syntax17">:</SPAN><SPAN CLASS="syntax17"> </SPAN><SPAN CLASS="syntax17">cfactor</SPAN> <SPAN CLASS="syntax13">&quot;</SPAN><SPAN CLASS="syntax13">localhost</SPAN><SPAN CLASS="syntax13">&quot;</SPAN> <SPAN CLASS="syntax5">9999</SPAN> &lt;client&gt; inferior-client <SPAN CLASS="syntax17">;</SPAN>
</PRE>
</div>
<p>Now, start CFactor and type the following phrase:</p>
<pre class="nice-box">inf</pre>
<p>Then open the Factor listener window in jEdit, and type the following phrase:</p>
<pre class="nice-box">cfactor</pre>
<p>You will now be talking to the CFactor interpreter prompt. Styled text output and hyperlinks will be transmitted using the <code>inferior.factor</code> socket protocol.</p>
<h2 class="fancy-heading">Cross-referencing</h2>
<p>The <b>Edit word at caret</b> command opens the source file containing the definition of the word at the caret. <b>See word at caret</b> shows the definition of the word at the caret in the Factor listener window.</p>
<p>The <b>Edit word</b> command opens a dialog box where the name of a word can be typed -- while the word is being typed, the possible completions is instantly updated, and selecting one opens the source file containing the definition of that word:</p>
<img class="nice-box" src="edit-word.png">
<p>To be able to edit definitions of standard library words, add a phrase like the following to your <code>$HOME/.factor-rc</code>:</p>
<pre class="nice-box"><SPAN CLASS="syntax13">&quot;</SPAN><SPAN CLASS="syntax13">/home/slava/Factor/</SPAN><SPAN CLASS="syntax13">&quot;</SPAN> <SPAN CLASS="syntax13">&quot;</SPAN><SPAN CLASS="syntax13">resource-path</SPAN><SPAN CLASS="syntax13">&quot;</SPAN> set
</PRE>
<p>The <b>Word usages at caret</b> command displays a list of words that refer to the word at the caret in the Factor listener window. Clicking on words in the listener shows a popup menu with various useful actions.</p>
<img class="nice-box" src="usages.png">
<p>Here we see the result of selecting <b>Describe</b>.</p>
<img class="nice-box" src="describe.png">
<h2 class="fancy-heading">Error checking</h2>
<p>Factor files are parsed in a background thread and checked for errors, using the framework provided by the SideKick plugin. Errors are underlined in the text area (and listed in the <b>ErrorList</b> plugin window).</p>
<img class="nice-box" src="error.png">
<p>A common error is a missing <code>USE:</code> declaration. The <b>Use word at caret</b> command searches for the word at the caret in all vocabularies, and adds a <code>USE:</code> declaration for the vocabulary to the start of the source file -- in this case, <code>ifte</code> is found in the <code>combinators</code> vocabulary, and the parse error instantly goes away:</p>
<img class="nice-box" src="word-use.png">
<h2 class="fancy-heading">Completion and browsing</h2>
<p>The stack effect of the word at the caret is shown in the status bar.</p>
<img class="nice-box" src="status.png">
<p>Invoking <b>Plugins</b>&gt;<b>SideKick</b>&gt;<b>Show Completion Popup</b> displays a popup of possible completions for the word at the caret -- bind this to <code>C+SPACE</code> for quick access:</p>
<img class="nice-box" src="complete.png">
<p>The <b>Plugins</b>&gt;<b>SideKick</b>&gt;<b>Structure Browser</b> displays a list of all words defined in the current buffer:</p>
<img class="nice-box" src="word-list.png">
</body>
</html>

BIN
doc/jedit/listener.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 17 KiB

BIN
doc/jedit/status.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.9 KiB

BIN
doc/jedit/usages.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 8.9 KiB

BIN
doc/jedit/word-list.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.5 KiB

BIN
doc/jedit/word-use.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.7 KiB

307
doc/math.txt Normal file
View File

@ -0,0 +1,307 @@
FACTOR MATH WORDS
=== Basics
The following expressions demonstrate basic arithmetic in Factor.
0] 2 2 + .
4
1] 10 4.5 - .
5.5
2] 12.5 3 * .
37.5
3] 6 20 / .
3/10
4] 6 20 /f .
0.3
5] 0.354 neg .
-0.354
6] 5 recip .
0.2
Arithmetic operators appear after their oprands, and intermediate values
are stored on a stack -- this is called postfix syntax.
The word . prints the value at the top of the stack.
There are no operator precedence levels, and expressions can always be
reprepsented unambiguously without parantheses, unlike traditional
algebraic syntax.
For example, (3 + 2) * (1 - 6) is written as:
3 2 + 1 6 - *
However, 3 + (2 * 1) - 6 is written as:
3 2 1 * + 6 -
=== The number tower
Factor supports operations with many types of numbers, transparently
converting results from one type to another. The following informal
diagram can be helpful in understanding the various types of numbers.
+--------+ +--------+
|=fixnum=| |=bignum=|
+--------+ +--------+
+-------------------+ +-------+
| integer | |=ratio=|
+-------------------+ +-------+
+-----------------------------+ +-------+
| rational | |=float=|
+-----------------------------+ +-------+
+---------------------------------------+ +---------+
| real | |=complex=|
+---------------------------------------+ +---------+
+---------------------------------------------------+
| number |
+---------------------------------------------------+
Types on the same row are disjoint.
Each type is a subtype of all types directly below.
Types whose boxes are marked with '=' are disjoint concrete types.
Type upgrades are performed through the concrete types, from the top
left down to the bottom right.
Ratios and complex numbers are compound types; ratios consist of a pair
of integers, complex numbers consist of a pair of real numbers.
=== Types of numbers
All number entry is in base 10.
The predicate word number? tests if the top of the stack is a number.
Numbers are partitioned into two disjoint subsets; real numbers and
complex numbers. (In math, the reals are a subset of the complex
numbers. In Factor, a number whose imaginary part is zero is *not* a
complex number).
Real numbers are partitioned into three disjoint subsets: integers,
ratios and floats.
==== Integers: 12 -100 340282366920938463463374607431768211456
The predicate word integer? tests if the top of the stack is an integer.
The integers are partitioned into two disjoint types:
- signed 32-bit fixnums (predicate: fixnum?)
- signed arbitrary precision bignums (predicate: bignum?)
Fixnums are automatically upgraded as necessary to bignums.
For example:
8] 1073741824 fixnum? .
t
9] 128 fixnum? .
t
10] 1073741824 128 * .
137438953472
11] 1073741824 128 * bignum? .
t
In the above example, the result of multiply those two fixnums exceeds
2^31-1, and the result is upgraded to a bignum.
When given integer operands, + - and * always return integers.
==== Ratios: 1/10 -37/78 10/3
A ratio is the result of a division of two integers where the
denimonator is not a multiple of the numerator.
The predicate word ratio? tests if the top of the stack is a ratio.
Ratios are always reduced to lowest terms, and the denominator is always
positive. The numerator never equals zero since dividing zero by a
non-zero integer always results in the integer zero.
The accessor words numerator and denominator deconstruct a ratio. Given
an integer, numerator is a no-op and denominator always returns 1.
14] 100 -30 / numerator .
-10
15] 100 -30 / denominator .
3
16] 12 numerator .
12
The numerator and denominator are integers, and hence either fixnums or
bignums (there is no requirement for them to be of the same type).
The result of dividing two integers as a floating point number can be
obtained using the word /f. For example:
17] 1 3 /f .
0.3333333333333333
When arithmetic operators are given a ratio and an integer as
parameters, the result is also a ratio or an integer.
==== Floats: -1.3 1.5e-6 0.003
Floats are entered as double-precision. Single-precision floats can be
constructed via coercion. They are converted to double-precision by
arithmetic operands.
The predicate word float? tests if the top of the stack is a single or
double precision float.
When at least one of the parameters to an arithmetic operator is a
float, the result is always a (double precision) float.
==== Complex numbers: #{ 2 2.5 } #{ 1/2 1/3 }
A complex number has a real and imaginary part. The syntax is to write
#{ followed by the real part, followed by the imaginary part, and
finally terminated with }. Each token must be separted with whitespace.
The predicate word complex? tests if the top of the stack is a single or
double precision float.
For example, what is commonly written as 2-3.5i in textbooks is
expressed as #{ 2 2.5 } in Factor.
The real and imaginary parts can be either integers, ratios or floats.
There is no requirement for them to be of the same type.
The accessor words real and imaginary deconstruct a complex number. The
real part followed by the imaginary part can both be pushed at once
using the word >rect, and a new complex number can be constructed from a
real and imaginary part using the word rect>.
4] -i sqrt >rect .s
-0.7071067811865475
0.7071067811865476
5] 1 2 rect> .
#{ 1 2 }
A complex number with an imaginary component of zero is automatically
downgraded to an integer, a ratio or a float (depending on the type of
its real component.)
6] 10 0 rect> .
10
7] #{ 5 -10 } #{ 2 10 } + .
7
Complex numbers never arise as results of arithmetic operators with real
operands. However, various irrational functions return complex values
for some real inputs.
=== Mathematical functions
==== Square root, squaring, arbitrary powers
These are pretty much self-explanatory.
10] 36 sq sqrt .
36.0
11] -2 sqrt sq .
-2.0000000000000004
12] 10 15 ^ .
1.0E15
13] e pi i * ^ .
#{ -1.0 1.2246467991473532E-16 }
==== Exponential, logarithm
The function e^x and its inverse.
15] e .
2.718281828459045
16] 2 exp .
7.38905609893065
17] 5 log 2 log - exp .
2.5
Note that the complex logarithm is infinitely-valued. The principle
value is chosen such that the complex part is in the interval (-pi,pi].
18] -10 log .
#{ 2.302585092994046 3.141592653589793 }
==== Trigonometric and hyperbolic functions
The full complement of trigonometric and hyperbolic functions and their
inverses is provided:
sin cos tan
asin acos atan
cosec sec cot
acosec asec acot
sinh cosh tanh
asinh acosh atanh
cosech sech coth
acosech asech acoth
Complex arguments are supported. The specific branch cuts used by the
inverse functions are undocumented by can be deduced from the
definitions of those functions, and the branch cuts taken by 'log' and
'sqrt'.
==== Polar co-ordinates
Complex numbers can be converted to/from polar co-ordinate
representations using the words >polar and polar>.
41] #{ 1 1 } >polar .s
0.7853981633974483
1.4142135623730951
42] -5 pi 3 / polar> .
#{ -2.5000000000000004 -4.330127018922193 }
==== Miscellaneous integer functions
Factorial, fibonacci sequence, harmonic numbers.
33] 128 2^ .
340282366920938463463374607431768211456
34] 30 fib .
1346269
35] 100 harmonic >float 100 log - .
0.5822073316515288
36] 1000 fac .
402387260077093773543702433923003985719374864210714632543799910429938512
398629020592044208486969404800479988610197196058631666872994808558901323
829669944590997424504087073759918823627727188732519779505950995276120874
975462497043601418278094646496291056393887437886487337119181045825783647
849977012476632889835955735432513185323958463075557409114262417474349347
553428646576611667797396668820291207379143853719588249808126867838374559
731746136085379534524221586593201928090878297308431392844403281231558611
036976801357304216168747609675871348312025478589320767169132448426236131
412508780208000261683151027341827977704784635868170164365024153691398281
264810213092761244896359928705114964975419909342221566832572080821333186
116811553615836546984046708975602900950537616475847728421889679646244945
160765353408198901385442487984959953319101723355556602139450399736280750
137837615307127761926849034352625200015888535147331611702103968175921510
907788019393178114194545257223865541461062892187960223838971476088506276
862967146674697562911234082439208160153780889893964518263243671616762179
168909779911903754031274622289988005195444414282012187361745992642956581
746628302955570299024324153181617210465832036786906117260158783520751516
284225540265170483304226143974286933061690897968482590125458327168226458
066526769958652682272807075781391858178889652208164348344825993266043367
660176999612831860788386150279465955131156552036093988180612138558600301
435694527224206344631797460594682573103790084024432438465657245014402821
885252470935190620929023136493273497565513958720559654228749774011413346
962715422845862377387538230483865688976461927383814900140767310446640259
899490222221765904339901886018566526485061799702356193897017860040811889
729918311021171229845901641921068884387121855646124960798722908519296819
372388642614839657382291123125024186649353143970137428531926649875337218
940694281434118520158014123344828015051399694290153483077644569099073152
433278288269864602789864321139083506217095002597389863554277196742822248
757586765752344220207573630569498825087968928162753848863396909959826280
956121450994871701244516461260379029309120889086942028510640182154399457
156805941872748998094254742173582401063677404595741785160829230135358081
840096996372524230560855903700624271243416909004153690105933983835777939
410970027753472000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000

78
doc/naming.txt Normal file
View File

@ -0,0 +1,78 @@
FACTOR CODING CONVENTIONS.
=== Naming words
foo. - perform "foo", but instead of pushing the result on the
stack, print it in a human-readable form suitable for
interactive use.
Eg: words. vocabs.
.X - four words to print the contents of the stacks:
.s - data stack
.r - call stack
.n - name stack
.c - catch stack
foo* - a variation of "foo" that takes more parameters.
Eg: index-of* parse* random-element*
- a lower-level word used in the implementation of "foo".
Eg: compile* prettyprint*
- a word that is a variation on "foo", but is more specialized
and less frequently used.
Eg: last* get*
(foo) - a word that is only useful in the implementation of "foo".
Eg: (vector=) (split)
>to - convert object to type "to".
Eg: >str >lower >upper >fixnum >realnum
- move top of data stack "to" stack.
Eg: >r >n >c
from> - convert object from type "from".
Eg: dec> oct> hex>
- move top of "from" stack to data stack.
Eg: r> n> c>
one>two - convert object of type "one" to "two".
Eg: stream>str stack>list worddef>list
- transfer values between stacks.
Eg: >r r> 2>r 2r> >n
<type> - create an object of "type".
Eg: <namespace> <sbuf> <stream>
foo@ - get the value of a variable at the top of the stack;
operate on the value with "foo"; store the value back in the
variable.
Eg: +@ *@ -@ /@ cons@ append@
foo-iter - a tail-recursive word used in the implementatin of "foo".
Eg: nreverse-iter partition-iter
nfoo - on lists, a destructive (non-consing) version of "foo".
Eg: nappend nreverse
2foo - like foo but with two operands taken from stack.
Eg: 2drop 2dup 2each

40
doc/tutorial/numbers-game.factor Normal file
View File

@ -0,0 +1,40 @@
! Numbers game example
IN: numbers-game
USE: combinators
USE: kernel
USE: math
USE: parser
USE: random
USE: stdio
USE: stack
: read-number ( -- n ) read parse-number ;
: guess-banner
"I'm thinking of a number between 0 and 100." print ;
: guess-prompt "Enter your guess: " write ;
: too-high "Too high" print ;
: too-low "Too low" print ;
: correct "Correct - you win!" print ;
: inexact-guess ( actual guess -- )
< [ too-high ] [ too-low ] ifte ;
: judge-guess ( actual guess -- ? )
2dup = [
2drop correct f
] [
inexact-guess t
] ifte ;
: number-to-guess ( -- n ) 0 100 random-int ;
: numbers-game-loop ( actual -- )
dup guess-prompt read-number judge-guess [
numbers-game-loop
] [
drop
] ifte ;
: numbers-game number-to-guess numbers-game-loop ;

74
doc/tutorial/timesheet.factor Normal file
View File

@ -0,0 +1,74 @@
! Contractor timesheet example
IN: timesheet
USE: combinators
USE: errors
USE: format
USE: kernel
USE: lists
USE: math
USE: parser
USE: stack
USE: stdio
USE: strings
USE: unparser
USE: vectors
! Adding a new entry to the time sheet.
: measure-duration ( -- duration )
millis
read drop
millis swap - 1000 /i 60 /i ;
: add-entry-prompt ( -- duration description )
"Start work on the task now. Press ENTER when done." print
measure-duration
"Please enter a description:" print
read ;
: add-entry ( timesheet -- )
add-entry-prompt cons swap vector-push ;
! Printing the timesheet.
: hh ( duration -- str ) 60 /i ;
: mm ( duration -- str ) 60 mod unparse 2 digits ;
: hh:mm ( millis -- str ) <% dup hh % ":" % mm % %> ;
: print-entry ( duration description -- )
dup write
60 swap pad-string write
hh:mm print ;
: print-timesheet ( timesheet -- )
"TIMESHEET:" print
[ uncons print-entry ] vector-each ;
! Displaying a menu
: print-menu ( menu -- )
terpri [ cdr car print ] each terpri
"Enter a letter between ( ) to execute that action." print ;
: menu-prompt ( menu -- )
read swap assoc dup [
cdr call
] [
"Invalid input: " swap unparse cat2 throw
] ifte ;
: menu ( menu -- )
dup print-menu menu-prompt ;
! Main menu
: main-menu ( timesheet -- )
[
[ "e" "(E)xit" drop ]
[ "a" "(A)dd entry" dup add-entry main-menu ]
[ "p" "(P)rint timesheet" dup print-timesheet main-menu ]
] menu ;
: timesheet-app ( -- )
10 <vector> main-menu ;

12
dockables.xml Normal file
View File

@ -0,0 +1,12 @@
<?xml version="1.0"?>
<!-- For jEdit plugin -->
<!DOCTYPE DOCKABLES SYSTEM "dockables.dtd">
<DOCKABLES>
<DOCKABLE NAME="factor">
new factor.listener.FactorListenerPanel(
factor.jedit.FactorPlugin.getInterpreter());
</DOCKABLE>
</DOCKABLES>

39
factor/FactorArray.java
View File

@ -198,8 +198,43 @@ public class FactorArray implements FactorExternalizable, PublicCloneable
return new FactorArray();
else
{
return new FactorArray(
FactorLib.cloneArray(stack),top);
Object[] newArray = new Object[stack.length];
System.arraycopy(stack,0,newArray,0,top);
return new FactorArray(newArray,top);
}
} //}}}
//{{{ hashCode() method
public int hashCode()
{
int hashCode = 0;
for(int i = 0; i < Math.min(top,4); i++)
{
Object obj = stack[i];
if(obj != null)
hashCode ^= obj.hashCode();
}
return hashCode;
} //}}}
//{{{ equals() method
public boolean equals(Object obj)
{
if(obj instanceof FactorArray)
{
FactorArray a = (FactorArray)obj;
if(a.top != top)
return false;
for(int i = 0; i < top; i++)
{
if(!FactorLib.equal(stack[i],a.stack[i]))
return false;
}
return true;
}
else
return false;
} //}}}
}

3
factor/FactorCompoundDefinition.java
View File

@ -96,7 +96,8 @@ public class FactorCompoundDefinition extends FactorWordDefinition
RecursiveState recursiveCheck) throws Exception
{
// Each word has its own class loader
FactorClassLoader loader = new FactorClassLoader();
FactorClassLoader loader = new FactorClassLoader(
getClass().getClassLoader());
StackEffect effect = getStackEffect(interp);

347
factor/FactorCompoundDefinition.java.new Normal file
View File

@ -0,0 +1,347 @@
/* :folding=explicit:collapseFolds=1: */
/*
* $Id$
*
* Copyright (C) 2003, 2004 Slava Pestov.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
* FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
* DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
package factor;
import factor.compiler.*;
import factor.db.Workspace;
import factor.db.PersistenceException;
import java.lang.reflect.*;
import java.io.FileOutputStream;
import java.util.*;
import org.objectweb.asm.*;
/**
* : name ... ;
*/
public class FactorCompoundDefinition extends FactorWordDefinition
{
private static int compileCount;
public Cons definition;
private Cons endOfDocs;
//{{{ FactorCompoundDefinition constructor
/**
* A new definition.
*/
public FactorCompoundDefinition(FactorWord word, Cons definition,
FactorInterpreter interp) throws PersistenceException
{
super(word,interp.workspace);
fromList(definition,interp);
if(interp.workspace != null)
interp.workspace.put(this);
} //}}}
//{{{ FactorCompoundDefinition constructor
/**
* A blank definition, about to be unpickled.
*/
public FactorCompoundDefinition(Workspace workspace, long id)
{
super(workspace,id);
} //}}}
//{{{ eval() method
public void eval(FactorInterpreter interp)
throws Exception
{
interp.call(word,endOfDocs);
} //}}}
//{{{ getClassName() method
private static String getClassName(String name)
{
return FactorJava.getSanitizedName(name)
+ "_" + (compileCount++);
} //}}}
//{{{ compile() method
/**
* Compile the given word, returning a new word definition.
*/
FactorWordDefinition compile(FactorInterpreter interp,
RecursiveState recursiveCheck) throws Exception
{
// Each word has its own class loader
FactorClassLoader loader = new FactorClassLoader(
interp.workspace);
StackEffect effect = getStackEffect(interp,
new RecursiveState());
if(effect.inR != 0 || effect.outR != 0)
throw new FactorCompilerException("Compiled code cannot manipulate call stack frames");
String className = getClassName(word.name);
ClassWriter cw = new ClassWriter(true);
cw.visit(ACC_PUBLIC, className,
"factor/compiler/CompiledDefinition",
null, null);
compileConstructor(cw,className);
FactorCompiler compiler = compileEval(interp,cw,loader,
className,effect,recursiveCheck);
// Generate auxiliary methods
compiler.generateAuxiliary(cw);
// Generate fields for storing literals and
// word references
compiler.generateFields(cw);
compileToList(interp,compiler,cw);
compileGetStackEffect(cw,effect);
// gets the bytecode of the class, and loads it
// dynamically
byte[] code = cw.toByteArray();
if(interp.dump)
{
FileOutputStream fos = new FileOutputStream(
className + ".class");
try
{
fos.write(code);
}
finally
{
fos.close();
}
}
String javaClassName = className.replace('/','.');
word.setCompiledInfo(compiler.loader,javaClassName);
Class compiledWordClass = loader.addClass(
javaClassName,code,0,code.length);
return CompiledDefinition.create(interp,word,compiledWordClass);
} //}}}
//{{{ compileConstructor() method
private void compileConstructor(ClassVisitor cw, String className)
{
// creates a MethodWriter for the constructor
CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
"<init>",
"(Lfactor/FactorWord;)V",
null, null);
// pushes the 'this' variable
mw.visitVarInsn(ALOAD, 0);
// pushes the word parameter
mw.visitVarInsn(ALOAD, 1);
// invokes the super class constructor
mw.visitMethodInsn(INVOKESPECIAL,
"factor/compiler/CompiledDefinition", "<init>",
"(Lfactor/FactorWord;)V");
mw.visitInsn(RETURN);
mw.visitMaxs(0,0);
} //}}}
//{{{ compileToList() method
private void compileToList(FactorInterpreter interp,
FactorCompiler compiler, ClassVisitor cw)
{
// creates a MethodWriter for the toList() method
CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
"toList",
"(Lfactor/FactorInterpreter;)Lfactor/Cons;",
null, null);
// push unparsed string representation of this word and parse it
compiler.generateParse(mw,toList(interp),1);
mw.visitTypeInsn(CHECKCAST,"factor/Cons");
mw.visitInsn(ARETURN);
mw.visitMaxs(0,0);
} //}}}
//{{{ compileGetStackEffect() method
private void compileGetStackEffect(ClassVisitor cw, StackEffect effect)
{
// creates a MethodWriter for the getStackEffect() method
CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
"getStackEffect",
"(Lfactor/compiler/RecursiveState;"
+ "Lfactor/compiler/FactorCompiler;)V",
null, null);
mw.visitVarInsn(ALOAD,2);
mw.visitTypeInsn(NEW,"factor/compiler/StackEffect");
mw.visitInsn(DUP);
mw.visitLdcInsn(new Integer(effect.inD));
mw.visitLdcInsn(new Integer(effect.outD));
mw.visitLdcInsn(new Integer(effect.inR));
mw.visitLdcInsn(new Integer(effect.outR));
mw.visitMethodInsn(INVOKESPECIAL,"factor/compiler/StackEffect",
"<init>","(IIII)V");
mw.visitMethodInsn(INVOKEVIRTUAL,"factor/compiler/FactorCompiler",
"apply","(Lfactor/compiler/StackEffect;)V");
mw.visitInsn(RETURN);
mw.visitMaxs(0,0);
} //}}}
//{{{ compileEval() method
/**
* Write the definition of the eval() method in the compiled word.
* Local 0 -- this
* Local 1 -- interpreter
*/
protected FactorCompiler compileEval(FactorInterpreter interp,
ClassWriter cw, FactorClassLoader loader,
String className, StackEffect effect,
RecursiveState recursiveCheck)
throws Exception
{
cw.visitField(ACC_PRIVATE | ACC_STATIC, "initialized", "Z",
null, null);
// creates a MethodWriter for the 'eval' method
CodeVisitor mw = cw.visitMethod(ACC_PUBLIC,
"eval", "(Lfactor/FactorInterpreter;)V",
null, null);
// eval() method calls core
mw.visitVarInsn(ALOAD,1);
compileDataStackToJVMStack(effect,mw);
mw.visitMethodInsn(INVOKESTATIC,className,"core",
effect.getCorePrototype());
compileJVMStackToDataStack(effect,mw);
mw.visitInsn(RETURN);
mw.visitMaxs(0,0);
// generate core
FactorCompiler compiler = new FactorCompiler(interp,word,
className,loader);
compiler.init(1,effect.inD,effect.inR,"core");
compiler.compileCore(endOfDocs,cw,effect,recursiveCheck);
return compiler;
} //}}}
//{{{ compileDataStackToJVMStack() method
private void compileDataStackToJVMStack(StackEffect effect,
CodeVisitor mw)
{
if(effect.inD != 0)
{
mw.visitVarInsn(ALOAD,1);
mw.visitFieldInsn(GETFIELD,
"factor/FactorInterpreter", "datastack",
"Lfactor/FactorArrayStack;");
// ensure the stack has enough elements
mw.visitInsn(DUP);
mw.visitIntInsn(BIPUSH,effect.inD);
mw.visitMethodInsn(INVOKEVIRTUAL,
"factor/FactorArrayStack", "ensurePop",
"(I)V");
// datastack.stack -> 2
mw.visitInsn(DUP);
mw.visitFieldInsn(GETFIELD,
"factor/FactorArrayStack", "stack",
"[Ljava/lang/Object;");
mw.visitVarInsn(ASTORE,2);
// datastack.top-args.length -> 3
mw.visitInsn(DUP);
mw.visitFieldInsn(GETFIELD,
"factor/FactorArrayStack", "top",
"I");
mw.visitIntInsn(BIPUSH,effect.inD);
mw.visitInsn(ISUB);
// datastack.top -= args.length
mw.visitInsn(DUP_X1);
mw.visitFieldInsn(PUTFIELD,
"factor/FactorArrayStack", "top",
"I");
mw.visitVarInsn(ISTORE,3);
for(int i = 0; i < effect.inD; i++)
{
mw.visitVarInsn(ALOAD,2);
mw.visitVarInsn(ILOAD,3);
mw.visitInsn(AALOAD);
if(i != effect.inD - 1)
mw.visitIincInsn(3,1);
}
}
} //}}}
//{{{ compileJVMStackToDataStack() method
private void compileJVMStackToDataStack(StackEffect effect,
CodeVisitor mw)
{
if(effect.outD == 1)
{
// ( datastack )
mw.visitVarInsn(ALOAD,1);
mw.visitFieldInsn(GETFIELD,
"factor/FactorInterpreter", "datastack",
"Lfactor/FactorArrayStack;");
mw.visitInsn(SWAP);
mw.visitMethodInsn(INVOKEVIRTUAL,
"factor/FactorArrayStack", "push",
"(Ljava/lang/Object;)V");
}
} //}}}
//{{{ fromList() method
public void fromList(Cons definition, FactorInterpreter interp)
{
this.definition = definition;
if(definition == null)
endOfDocs = null;
else
{
endOfDocs = definition;
while(endOfDocs != null
&& endOfDocs.car instanceof FactorDocComment)
endOfDocs = endOfDocs.next();
}
} //}}}
//{{{ toList() method
public Cons toList(FactorInterpreter interp)
{
return definition;
} //}}}
}

2
factor/FactorDocComment.java
View File

@ -49,7 +49,7 @@ public class FactorDocComment implements FactorExternalizable
if(stack)
return "( " + msg + " )\n";
else
return "#!" + msg + "\n";
return "#! " + msg + "\n";
}
public boolean isStackComment()

124
factor/FactorInterpreter.java
View File

@ -35,7 +35,11 @@ import java.io.*;
public class FactorInterpreter implements FactorObject, Runnable
{
public static final String VERSION = "0.60.8";
public static final String VERSION = "0.66";
public static final Cons DEFAULT_USE = new Cons("builtins",
new Cons("syntax",new Cons("scratchpad",null)));
public static final String DEFAULT_IN = "scratchpad";
// command line arguments are stored here.
public Cons args;
@ -63,25 +67,19 @@ public class FactorInterpreter implements FactorObject, Runnable
/**
* Vocabulary search path for interactive parser.
*/
public Cons use;
public Cons use = DEFAULT_USE;
/**
* Vocabulary to define new words in.
*/
public String in;
/**
* Kernel vocabulary. Re-created on each startup, contains
* primitives and parsing words.
*/
public FactorNamespace builtins;
public String in = DEFAULT_IN;
/**
* Most recently defined word.
*/
public FactorWord last;
public FactorNamespace global;
public FactorNamespace global = new FactorNamespace();
private FactorNamespace interpNamespace;
@ -91,7 +89,7 @@ public class FactorInterpreter implements FactorObject, Runnable
public static void main(String[] args) throws Exception
{
FactorInterpreter interp = new FactorInterpreter();
interp.init(args,null);
interp.init(args);
interp.run();
} //}}}
@ -110,13 +108,13 @@ public class FactorInterpreter implements FactorObject, Runnable
this.vocabularies = interp.vocabularies;
this.use = interp.use;
this.in = interp.in;
this.builtins = interp.builtins;
this.last = interp.last;
this.global = interp.global;
this.startupDone = true;
} //}}}
//{{{ init() method
public void init(String[] args, Object root) throws Exception
public void init(String[] args) throws Exception
{
for(int i = 0; i < args.length; i++)
{
@ -138,7 +136,7 @@ public class FactorInterpreter implements FactorObject, Runnable
vocabularies = new FactorNamespace();
initBuiltinDictionary();
initNamespace(root);
initNamespace();
topLevel();
runBootstrap();
@ -147,81 +145,73 @@ public class FactorInterpreter implements FactorObject, Runnable
//{{{ initBuiltinDictionary() method
private void initBuiltinDictionary() throws Exception
{
builtins = new FactorNamespace();
vocabularies.setVariable("builtins",builtins);
in = "builtins";
use = new Cons(in,null);
vocabularies.setVariable("builtins",new FactorNamespace());
vocabularies.setVariable("combinators",new FactorNamespace());
vocabularies.setVariable("syntax",new FactorNamespace());
/* comments */
FactorWord lineComment = define("builtins","!");
FactorWord lineComment = define("syntax","!");
lineComment.parsing = new LineComment(lineComment,false);
FactorWord stackComment = define("builtins","(");
FactorWord stackComment = define("syntax","(");
stackComment.parsing = new StackComment(stackComment);
FactorWord docComment = define("builtins","#!");
FactorWord docComment = define("syntax","#!");
docComment.parsing = new LineComment(docComment,true);
/* strings */
FactorWord str = define("builtins","\"");
FactorWord str = define("syntax","\"");
str.parsing = new StringLiteral(str,true);
FactorWord ch = define("builtins","CHAR:");
FactorWord ch = define("syntax","CHAR:");
ch.parsing = new CharLiteral(ch);
FactorWord raw = define("builtins","#\"");
raw.parsing = new StringLiteral(raw,false);
/* constants */
FactorWord t = define("builtins","t");
FactorWord t = define("syntax","t");
t.parsing = new T(t);
FactorWord f = define("builtins","f");
FactorWord f = define("syntax","f");
f.parsing = new F(f);
FactorWord complex = define("builtins","#{");
FactorWord complex = define("syntax","#{");
complex.parsing = new ComplexLiteral(complex,"}");
/* lists */
FactorWord bra = define("builtins","[");
FactorWord bra = define("syntax","[");
bra.parsing = new Bra(bra);
FactorWord ket = define("builtins","]");
FactorWord ket = define("syntax","]");
ket.parsing = new Ket(bra,ket);
FactorWord bar = define("builtins","|");
FactorWord bar = define("syntax","|");
bar.parsing = new Bar(bar);
/* vectors */
FactorWord beginVector = define("syntax","{");
beginVector.parsing = new BeginVector(beginVector);
FactorWord endVector = define("syntax","}");
endVector.parsing = new EndVector(beginVector,endVector);
/* word defs */
FactorWord def = define("builtins",":");
FactorWord def = define("syntax",":");
def.parsing = new Def(def);
def.getNamespace().setVariable("doc-comments",Boolean.TRUE);
FactorWord ine = define("builtins",";");
FactorWord ine = define("syntax",";");
ine.parsing = new Ine(def,ine);
FactorWord shuffle = define("builtins","~<<");
FactorWord shuffle = define("syntax","~<<");
shuffle.parsing = new Shuffle(shuffle,">>~");
FactorWord symbol = define("syntax","SYMBOL:");
symbol.parsing = new Symbol(symbol);
/* reading numbers with another base */
FactorWord bin = define("builtins","BIN:");
FactorWord bin = define("syntax","BIN:");
bin.parsing = new Base(bin,2);
FactorWord oct = define("builtins","OCT:");
FactorWord oct = define("syntax","OCT:");
oct.parsing = new Base(oct,8);
FactorWord hex = define("builtins","HEX:");
FactorWord hex = define("syntax","HEX:");
hex.parsing = new Base(hex,16);
/* specials */
FactorWord dispatch = define("builtins","#");
dispatch.parsing = new Dispatch(dispatch);
FactorWord unreadable = define("builtins","#<");
unreadable.parsing = new Unreadable(unreadable);
// #: is not handled with a special dispatch. instead, when
// a word starting with #: is passed to intern(), it creates
// a new symbol
FactorWord passthru = define("builtins","#:");
passthru.parsing = new PassThrough(passthru);
/* vocabulary parsing words */
FactorWord noParsing = define("builtins","POSTPONE:");
FactorWord noParsing = define("syntax","POSTPONE:");
noParsing.parsing = new NoParsing(noParsing);
FactorWord defer = define("builtins","DEFER:");
FactorWord defer = define("syntax","DEFER:");
defer.parsing = new Defer(defer);
FactorWord in = define("builtins","IN:");
FactorWord in = define("syntax","IN:");
in.parsing = new In(in);
FactorWord use = define("builtins","USE:");
FactorWord use = define("syntax","USE:");
use.parsing = new Use(use);
FactorWord interpreterGet = define("builtins","interpreter");
@ -265,21 +255,19 @@ public class FactorInterpreter implements FactorObject, Runnable
define.def = new Define(define);
// combinators
FactorWord execute = define("builtins","execute");
FactorWord execute = define("words","execute");
execute.def = new Execute(execute);
FactorWord call = define("builtins","call");
FactorWord call = define("combinators","call");
call.def = new Call(call);
call.inline = true;
FactorWord ifte = define("builtins","ifte");
FactorWord ifte = define("combinators","ifte");
ifte.def = new Ifte(ifte);
ifte.inline = true;
} //}}}
//{{{ initNamespace() method
private void initNamespace(Object root) throws Exception
private void initNamespace() throws Exception
{
global = new FactorNamespace(null,root);
global.setVariable("interpreter",this);
global.setVariable("verbose-compile",
@ -298,7 +286,6 @@ public class FactorInterpreter implements FactorObject, Runnable
"args",
"dump",
"interactive",
"builtins",
"in",
"last",
"use"
@ -502,7 +489,6 @@ public class FactorInterpreter implements FactorObject, Runnable
//{{{ getVocabulary() method
public FactorNamespace getVocabulary(String name)
throws Exception
{
Object value = vocabularies.getVariable(name);
if(value instanceof FactorNamespace)
@ -513,7 +499,6 @@ public class FactorInterpreter implements FactorObject, Runnable
//{{{ defineVocabulary() method
public void defineVocabulary(String name)
throws Exception
{
Object value = vocabularies.getVariable(name);
if(value == null)
@ -584,8 +569,6 @@ public class FactorInterpreter implements FactorObject, Runnable
if(isUninterned(name))
return new FactorWord(null,name);
try
{
FactorNamespace v = getVocabulary(vocabulary);
if(v == null)
{
@ -604,12 +587,6 @@ public class FactorInterpreter implements FactorObject, Runnable
v.setVariable(name,word);
return word;
}
}
catch(Exception e)
{
// should not happen!
throw new RuntimeException(e);
}
} //}}}
//{{{ topLevel() method
@ -627,9 +604,12 @@ public class FactorInterpreter implements FactorObject, Runnable
define("kernel","exit*");
catchstack.push(new Cons(new Integer(1),
new Cons(searchVocabulary("kernel","exit*"),null)));
define("continuations","suspend");
define("errors","default-error-handler");
catchstack.push(new Cons(searchVocabulary("errors",
"default-error-handler"),null));
"default-error-handler"),
new Cons(searchVocabulary("continuations","suspend"),
null)));
callframe = null;
} //}}}
}

56
factor/FactorLib.java
View File

@ -49,29 +49,6 @@ public class FactorLib
return o3;
} //}}}
//{{{ cloneArray() method
public static Object[] cloneArray(Object[] array)
{
Object[] newArray = new Object[array.length];
System.arraycopy(array,0,newArray,0,array.length);
return newArray;
} //}}}
//{{{ deepCloneArray() method
public static Object[] deepCloneArray(Object[] array)
{
Object[] newArray = new Object[array.length];
for(int i = 0; i < array.length; i++)
{
Object o = array[i];
if(o instanceof PublicCloneable)
newArray[i] = ((PublicCloneable)o).clone();
else
newArray[i] = o;
}
return newArray;
} //}}}
//{{{ error() method
public static void error(Object obj) throws Throwable
{
@ -151,13 +128,14 @@ public class FactorLib
} //}}}
//{{{ exec() method
public static int exec(String[] args) throws Exception
public static int exec(String[] args, String dir) throws Exception
{
int exitCode = -1;
try
{
Process process = Runtime.getRuntime().exec(args);
Process process = Runtime.getRuntime().exec(args,
null,new File(dir));
process.getInputStream().close();
process.getOutputStream().close();
process.getErrorStream().close();
@ -181,17 +159,7 @@ public class FactorLib
*/
public static boolean objectsEqual(Object o1, Object o2)
{
if(o1 == null)
{
if(o2 == null)
return true;
else
return false;
}
else if(o2 == null)
return false;
else
return o1.equals(o2);
return (o1 == null ? o2 == null : o1.equals(o2));
} //}}}
//{{{ copy() method
@ -200,6 +168,8 @@ public class FactorLib
*/
public static void copy(InputStream in, OutputStream out)
throws IOException
{
try
{
byte[] buf = new byte[4096];
@ -213,9 +183,12 @@ public class FactorLib
out.write(buf,0,count);
}
}
finally
{
in.close();
out.close();
}
} //}}}
//{{{ readLine() method
@ -243,6 +216,11 @@ public class FactorLib
break;
buf.append((char)b);
}
/* EOF? */
if(b == -1 && buf.length() == 0)
return null;
else
return buf.toString();
} //}}}
@ -255,7 +233,7 @@ public class FactorLib
int read = 0;
while((read = in.read(bytes,offset,count - offset)) > 0)
offset += read;
return new String(bytes,"ASCII");
return new String(bytes,0,offset,"ASCII");
} //}}}
//{{{ readCount() method
@ -267,6 +245,6 @@ public class FactorLib
int read = 0;
while((read = in.read(chars,offset,count - offset)) > 0)
offset += read;
return new String(chars);
return new String(chars,0,offset);
} //}}}
}

38
factor/FactorNamespace.java
View File

@ -81,7 +81,6 @@ public class FactorNamespace implements PublicCloneable, FactorObject
* Cloning constructor.
*/
public FactorNamespace(Map words, Object obj)
throws Exception
{
this.words = new TreeMap();
@ -94,7 +93,13 @@ public class FactorNamespace implements PublicCloneable, FactorObject
Map.Entry entry = (Map.Entry)iter.next();
Object key = entry.getKey();
Object value = entry.getValue();
if(!(value instanceof VarBinding))
if(value instanceof VarBinding)
{
VarBinding b = (VarBinding)value;
if(b.instance != null)
continue;
}
this.words.put(key,value);
}
}
@ -140,7 +145,7 @@ public class FactorNamespace implements PublicCloneable, FactorObject
} //}}}
//{{{ isDefined() method
public synchronized boolean isDefined(String name) throws Exception
public synchronized boolean isDefined(String name)
{
Object o = words.get(name);
if(o instanceof VarBinding)
@ -165,7 +170,7 @@ public class FactorNamespace implements PublicCloneable, FactorObject
} //}}}
//{{{ getVariable() method
public synchronized Object getVariable(String name) throws Exception
public synchronized Object getVariable(String name)
{
Object o = words.get(name);
if(o instanceof VarBinding)
@ -194,7 +199,6 @@ public class FactorNamespace implements PublicCloneable, FactorObject
//{{{ setVariable() method
public synchronized void setVariable(String name, Object value)
throws Exception
{
if(name == null)
throw new NullPointerException();
@ -227,7 +231,7 @@ public class FactorNamespace implements PublicCloneable, FactorObject
if(!constraint.isAssignableFrom(
value.getClass()))
{
throw new FactorRuntimeException(
throw new RuntimeException(
"Can only store "
+ constraint
+ " in " + this);
@ -314,7 +318,7 @@ public class FactorNamespace implements PublicCloneable, FactorObject
/**
* Returns a list of variable values.
*/
public synchronized Cons toValueList() throws Exception
public synchronized Cons toValueList()
{
initAllFields();
@ -342,7 +346,7 @@ public class FactorNamespace implements PublicCloneable, FactorObject
/**
* Returns a list of pairs of variable names, and their values.
*/
public synchronized Cons toVarValueList() throws Exception
public synchronized Cons toVarValueList()
{
initAllFields();
@ -384,17 +388,31 @@ public class FactorNamespace implements PublicCloneable, FactorObject
this.instance = instance;
}
public Object get() throws Exception
public Object get()
{
try
{
return FactorJava.convertFromJavaType(
field.get(instance));
}
catch(Exception e)
{
throw new RuntimeException(e);
}
}
public void set(Object value) throws Exception
public void set(Object value)
{
try
{
field.set(instance,FactorJava.convertToJavaType(
value,field.getType()));
}
catch(Exception e)
{
throw new RuntimeException(e);
}
}
} //}}}
//{{{ toString() method

32
factor/FactorParseException.java
View File

@ -31,12 +31,20 @@ package factor;
public class FactorParseException extends FactorException
{
private String filename;
private int lineno;
private int position;
private String msg;
public FactorParseException(
String filename,
int lineno,
String str)
{
super(filename + ":" + lineno + ": " + str);
this.filename = filename;
this.lineno = lineno;
this.msg = str;
}
public FactorParseException(
@ -48,6 +56,30 @@ public class FactorParseException extends FactorException
{
super(filename + ":" + lineno + ": " + str
+ "\n" + getDetailMessage(line,position));
this.filename = filename;
this.lineno = lineno;
this.position = position;
this.msg = str;
}
public String getFileName()
{
return filename;
}
public int getLineNumber()
{
return lineno;
}
public int getPosition()
{
return position;
}
public String getParserMessage()
{
return msg;
}
private static String getDetailMessage(String line, int position)

119
factor/FactorReader.java
View File

@ -38,36 +38,6 @@ import java.util.*;
*/
public class FactorReader
{
public static final Cons DEFAULT_USE = new Cons("builtins",
new Cons("scratchpad",null));
public static final String DEFAULT_IN = "scratchpad";
public static final ReadTable DEFAULT_READTABLE;
//{{{ Class initializer
static
{
DEFAULT_READTABLE = new ReadTable();
DEFAULT_READTABLE.setCharacterType('\t',ReadTable.WHITESPACE);
DEFAULT_READTABLE.setCharacterType('\n',ReadTable.WHITESPACE);
// ^L
DEFAULT_READTABLE.setCharacterType((char)12,ReadTable.WHITESPACE);
DEFAULT_READTABLE.setCharacterType('\r',ReadTable.WHITESPACE);
DEFAULT_READTABLE.setCharacterType(' ',ReadTable.WHITESPACE);
DEFAULT_READTABLE.setCharacterType('!',ReadTable.CONSTITUENT);
DEFAULT_READTABLE.setCharacterType('"',ReadTable.DISPATCH);
DEFAULT_READTABLE.setCharacterType('#',ReadTable.DISPATCH);
DEFAULT_READTABLE.setCharacterRange('$','[',ReadTable.CONSTITUENT);
DEFAULT_READTABLE.setCharacterType('\\',ReadTable.SINGLE_ESCAPE);
DEFAULT_READTABLE.setCharacterRange(']','~',ReadTable.CONSTITUENT);
DEFAULT_READTABLE.setCharacterType('!',ReadTable.DISPATCH);
DEFAULT_READTABLE.setCharacterType('(',ReadTable.CONSTITUENT);
} //}}}
private FactorInterpreter interp;
private FactorScanner scanner;
private Cons states;
@ -153,7 +123,7 @@ public class FactorReader
buf.append("\\0");
break;
default:
if(DEFAULT_READTABLE.getCharacterType(ch)
if(ReadTable.DEFAULT_READTABLE.getCharacterType(ch)
== ReadTable.INVALID)
{
buf.append("\\u");
@ -248,7 +218,12 @@ public class FactorReader
|| obj instanceof FactorExternalizable)
return obj.toString();
else if(obj instanceof Character)
return "\"" + charsToEscapes(obj.toString()) + "\"";
{
if(((Character)obj).charValue() == ' ')
return "CHAR: \\s";
else
return "CHAR: " + charsToEscapes(obj.toString());
}
else
return getUnreadableString(obj.toString());
} //}}}
@ -269,15 +244,25 @@ public class FactorReader
boolean alwaysDocComments,
boolean interactive,
FactorInterpreter interp)
{
this(new FactorScanner(filename,in),alwaysDocComments,
interactive,interp);
} //}}}
//{{{ FactorReader constructor
public FactorReader(
FactorScanner scanner,
boolean alwaysDocComments,
boolean interactive,
FactorInterpreter interp)
{
this.interp = interp;
scanner = new FactorScanner(filename,in);
scanner.setReadTable(DEFAULT_READTABLE);
this.scanner = scanner;
pushState(toplevel,null);
this.alwaysDocComments = alwaysDocComments;
this.interactive = interactive;
this.in = DEFAULT_IN;
this.use = DEFAULT_USE;
this.in = FactorInterpreter.DEFAULT_IN;
this.use = FactorInterpreter.DEFAULT_USE;
} //}}}
//{{{ getScanner() method
@ -331,12 +316,7 @@ public class FactorReader
if(interp.getVocabulary(name) == null)
error("Undefined vocabulary: " + name);
Cons use = getUse();
if(!Cons.contains(use,name))
use = new Cons(name,use);
setUse(use);
setUse(new Cons(name,getUse()));
} //}}}
//{{{ parse() method
@ -346,6 +326,8 @@ public class FactorReader
*/
public Cons parse() throws Exception
{
scanner.nextLine();
for(;;)
{
if(next())
@ -378,21 +360,30 @@ public class FactorReader
*/
public FactorWord nextWord(boolean define) throws Exception
{
Object next = next(true,false);
if(next == FactorScanner.EOF)
{
scanner.error("Unexpected EOF");
// can't happen
return null;
}
else if(next instanceof Number)
// remember the position before the word name
int line = scanner.getLineNumber();
int col = scanner.getColumnNumber();
Object next = nextNonEOL(true,false);
if(next instanceof Number)
{
scanner.error("Unexpected " + next);
// can't happen
return null;
}
else if(next instanceof String)
{
FactorWord w = intern((String)next,define);
if(define && w != null)
{
w.line = line;
w.col = col;
w.file = scanner.getFileName();
}
return w;
}
else
return intern((String)next,define);
return null;
} //}}}
//{{{ next() method
@ -401,16 +392,23 @@ public class FactorReader
boolean start)
throws IOException, FactorParseException
{
return scanner.next(readNumbers,start,base);
Object next = scanner.next(readNumbers,start,base);
if(next == FactorScanner.EOL)
{
scanner.nextLine();
return next(readNumbers,start);
}
else
return next;
} //}}}
//{{{ nextNonEOF() method
public Object nextNonEOF(
//{{{ nextNonEOL() method
public Object nextNonEOL(
boolean readNumbers,
boolean start)
throws IOException, FactorParseException
{
return scanner.nextNonEOF(readNumbers,start,base);
return scanner.nextNonEOL(readNumbers,start,base);
} //}}}
//{{{ next() method
@ -427,6 +425,12 @@ public class FactorReader
{
FactorWord word = intern((String)next,
!getCurrentState().warnUndefined);
if(word == null)
{
/* We're ignoring errors */
return false;
}
if(word.parsing != null)
{
word.parsing.eval(interp,this);
@ -477,9 +481,8 @@ public class FactorReader
{
ParseState state = getCurrentState();
if(state.start != start)
{
scanner.error(end + " does not close " + state.start);
}
else
states = states.next();
return state;
} //}}}
@ -564,7 +567,7 @@ public class FactorReader
if(comma)
{
if(last.cdr != null)
scanner.error("Only one token allowed after ,");
scanner.error("Only one token allowed after |");
last.cdr = obj;
}
else

109
factor/FactorScanner.java
View File

@ -42,6 +42,11 @@ public class FactorScanner
*/
public static final Object EOF = new Object();
/**
* Special object returned on EOL.
*/
public static final Object EOL = new Object();
private String filename;
private BufferedReader in;
@ -73,6 +78,7 @@ public class FactorScanner
this.filename = filename;
this.in = in;
buf = new StringBuffer();
setReadTable(ReadTable.DEFAULT_READTABLE);
} //}}}
//{{{ getReadTable() method
@ -87,8 +93,26 @@ public class FactorScanner
this.readtable = readtable;
} //}}}
//{{{ getLineNumber() method
public int getLineNumber()
{
return lineNo;
} //}}}
//{{{ getColumnNumber() method
public int getColumnNumber()
{
return position;
} //}}}
//{{{ getFileName() method
public String getFileName()
{
return filename;
} //}}}
//{{{ nextLine() method
private void nextLine() throws IOException
public void nextLine() throws IOException
{
lineNo++;
line = in.readLine();
@ -97,8 +121,45 @@ public class FactorScanner
nextLine();
} //}}}
//{{{ isEOL() method
private boolean isEOL()
{
return position >= line.length();
} //}}}
//{{{ skipWhitespace() method
/**
* The Factor parser is so much nicer in Factor than Java!
*/
public void skipWhitespace() throws FactorParseException
{
for(;;)
{
if(isEOL())
return;
char ch = line.charAt(position++);
int type = readtable.getCharacterType(ch);
switch(type)
{
case ReadTable.INVALID:
error("Invalid character in input: " + ch);
break;
case ReadTable.WHITESPACE:
break;
default:
position--;
return;
}
}
} //}}}
//{{{ next() method
/**
* Read a word name. Note that no escaping of characters is done.
*
* @param readNumbers If true, will return either a Number or a
* String. Otherwise, only Strings are returned.
* @param start If true, dispatches will be handled by their parsing
@ -112,21 +173,20 @@ public class FactorScanner
int base)
throws IOException, FactorParseException
{
if(line == null || position == line.length())
nextLine();
if(line == null)
return EOF;
if(position == line.length())
return EOL;
for(;;)
{
if(position == line.length())
if(position >= line.length())
{
// EOL
if(buf.length() != 0)
return word(readNumbers,base);
nextLine();
if(line == null)
return EOF;
else
return EOL;
}
char ch = line.charAt(position++);
@ -151,29 +211,32 @@ public class FactorScanner
return word(readNumbers,base);
}
case ReadTable.CONSTITUENT:
buf.append(ch);
break;
case ReadTable.SINGLE_ESCAPE:
buf.append(escape());
buf.append(ch);
break;
}
}
} //}}}
//{{{ nextNonEOF() method
public Object nextNonEOF(
//{{{ nextNonEOL() method
public Object nextNonEOL(
boolean readNumbers,
boolean start,
int base)
throws IOException, FactorParseException
{
Object next = next(readNumbers,start,base);
if(next == EOL)
error("Unexpected EOL");
if(next == EOF)
error("Unexpected EOF");
return next;
} //}}}
//{{{ readUntil() method
/**
* Characters are escaped.
*/
public String readUntil(char start, char end, boolean escapesAllowed)
throws IOException, FactorParseException
{
@ -181,11 +244,17 @@ public class FactorScanner
for(;;)
{
if(position == line.length())
if(isEOL())
{
error("Expected " + end + " before EOL");
break;
}
if(line == null)
{
error("Expected " + end + " before EOF");
break;
}
char ch = line.charAt(position++);
@ -221,10 +290,16 @@ public class FactorScanner
//{{{ readNonEOF() method
public char readNonEOF() throws FactorParseException, IOException
{
if(position == line.length())
if(isEOL())
{
error("Unexpected EOL");
return '\0';
}
if(line == null)
{
error("Unexpected EOF");
return '\0';
}
return line.charAt(position++);
} //}}}
@ -242,7 +317,7 @@ public class FactorScanner
//{{{ atEndOfWord() method
public boolean atEndOfWord() throws IOException
{
if(position == line.length())
if(isEOL())
return true;
if(line == null)
return true;
@ -278,7 +353,10 @@ public class FactorScanner
return '\0';
case 'u':
if(line.length() - position < 4)
{
error("Unexpected EOL");
return '\0';
}
String hex = line.substring(position,position + 4);
@ -295,7 +373,6 @@ public class FactorScanner
return '\0';
default:
error("Unknown escape: " + ch);
// can't happen
return '\0';
}
} //}}}

96
factor/FactorSymbolDefinition.java Normal file
View File

@ -0,0 +1,96 @@
/* :folding=explicit:collapseFolds=1: */
/*
* $Id$
*
* Copyright (C) 2004 Slava Pestov.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
* FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
* DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
package factor;
import factor.compiler.*;
import org.objectweb.asm.*;
/**
* SYMBOL: name
*
* Pushes word named.
*/
public class FactorSymbolDefinition extends FactorWordDefinition
{
public Object symbol;
//{{{ FactorSymbolDefinition constructor
/**
* A new definition.
*/
public FactorSymbolDefinition(FactorWord word, Object symbol)
{
super(word);
this.symbol = symbol;
} //}}}
//{{{ eval() method
public void eval(FactorInterpreter interp)
throws Exception
{
interp.datastack.push(symbol);
} //}}}
//{{{ getStackEffect() method
public void getStackEffect(RecursiveState recursiveCheck,
FactorCompiler compiler) throws Exception
{
compiler.pushLiteral(symbol,recursiveCheck);
} //}}}
//{{{ compile() method
/**
* Compile the given word, returning a new word definition.
*/
FactorWordDefinition compile(FactorInterpreter interp,
RecursiveState recursiveCheck) throws Exception
{
return this;
} //}}}
//{{{ compileCallTo() method
public void compileCallTo(CodeVisitor mw, FactorCompiler compiler,
RecursiveState recursiveCheck) throws FactorStackException
{
compiler.pushLiteral(symbol,recursiveCheck);
} //}}}
//{{{ fromList() method
public void fromList(Cons definition, FactorInterpreter interp)
{
this.symbol = definition.car;
} //}}}
//{{{ toList() method
public Cons toList(FactorInterpreter interp)
{
return new Cons(symbol,null);
} //}}}
}

12
factor/FactorWord.java
View File

@ -73,6 +73,13 @@ public class FactorWord implements FactorExternalizable, FactorObject
public FactorClassLoader loader;
public String className;
/**
* For text editor integration.
*/
public String file;
public int line;
public int col;
private FactorNamespace namespace;
//{{{ FactorWord constructor
@ -82,7 +89,7 @@ public class FactorWord implements FactorExternalizable, FactorObject
* intern() method instead.
*/
public FactorWord(String vocabulary, String name,
FactorWordDefinition def) throws Exception
FactorWordDefinition def)
{
this.vocabulary = vocabulary;
this.name = name;
@ -191,7 +198,6 @@ public class FactorWord implements FactorExternalizable, FactorObject
//{{{ toString() method
public String toString()
{
return name == null ? "#<unnamed>"
: FactorReader.charsToEscapes(name);
return name == null ? "#<unnamed>" : name;
} //}}}
}

9
factor/FactorWordDefinition.java
View File

@ -39,8 +39,7 @@ import org.objectweb.asm.*;
*/
public abstract class FactorWordDefinition implements Constants
{
protected FactorWord word;
public FactorWord word;
public boolean compileFailed;
//{{{ FactorWordDefinition constructor
@ -55,12 +54,6 @@ public abstract class FactorWordDefinition implements Constants
public abstract void eval(FactorInterpreter interp)
throws Exception;
//{{{ getWord() method
public FactorWord getWord(FactorInterpreter interp)
{
return word;
} //}}}
//{{{ fromList() method
public void fromList(Cons cons, FactorInterpreter interp)
throws FactorRuntimeException

444
factor/FactorWordDefinition.java.new Normal file
View File

@ -0,0 +1,444 @@
/* :folding=explicit:collapseFolds=1: */
/*
* $Id$
*
* Copyright (C) 2003, 2004 Slava Pestov.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
* FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
* DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
package factor;
import factor.db.*;
import factor.compiler.*;
import java.io.*;
import java.util.*;
import org.objectweb.asm.*;
/**
* A word definition.
*
* The pickled form is an unparsed list. The car of the list is the word,
* the cdr is toList().
*/
public abstract class FactorWordDefinition
implements Constants, PersistentObject
{
public static final String ENCODING = "UTF8";
private Workspace workspace;
private long id;
public FactorWord word;
public boolean compileFailed;
//{{{ FactorWordDefinition constructor
/**
* A new definition.
*/
public FactorWordDefinition(FactorWord word, Workspace workspace)
{
this(workspace,workspace == null
? 0L : workspace.nextID());
this.word = word;
} //}}}
//{{{ FactorWordDefinition constructor
/**
* A blank definition, about to be unpickled.
*/
public FactorWordDefinition(Workspace workspace, long id)
{
this.workspace = workspace;
this.id = id;
} //}}}
//{{{ FactorWordDefinition constructor
/**
* A definition that is not saved in the current workspace.
*/
public FactorWordDefinition(FactorWord word)
{
this.word = word;
} //}}}
public abstract void eval(FactorInterpreter interp)
throws Exception;
//{{{ fromList() method
public void fromList(Cons cons, FactorInterpreter interp)
throws FactorRuntimeException, PersistenceException
{
throw new PersistenceException("Cannot unpickle " + this);
} //}}}
//{{{ toList() method
public Cons toList(FactorInterpreter interp)
{
return new Cons(new FactorWord(null,getClass().getName()),null);
} //}}}
//{{{ getStackEffect() method
public final StackEffect getStackEffect(FactorInterpreter interp)
throws Exception
{
return getStackEffect(interp,new RecursiveState());
} //}}}
//{{{ getStackEffect() method
public final StackEffect getStackEffect(FactorInterpreter interp,
RecursiveState recursiveCheck)
throws Exception
{
FactorCompiler compiler = new FactorCompiler(interp);
recursiveCheck.add(word,new StackEffect(),null,null,null);
compileCallTo(null,compiler,recursiveCheck);
recursiveCheck.remove(word);
return compiler.getStackEffect();
} //}}}
/*
//{{{ getStackEffect() method
public void getStackEffect(RecursiveState recursiveCheck,
FactorCompiler compiler) throws Exception
{
compileCallTo(null,compiler,recursiveCheck);
} //}}}
*/
//{{{ compile() method
FactorWordDefinition compile(FactorInterpreter interp,
RecursiveState recursiveCheck) throws Exception
{
return this;
} //}}}
//{{{ getDefinition() method
protected Cons getDefinition(FactorInterpreter interp)
throws FactorCompilerException
{
Cons definition = toList(interp);
while(definition != null
&& definition.car instanceof FactorDocComment)
definition = definition.next();
return definition;
} //}}}
//{{{ compileCallTo() method
/**
* Compile a call to this word. Returns maximum JVM stack use.
*/
public void compileCallTo(CodeVisitor mw, FactorCompiler compiler,
RecursiveState recursiveCheck) throws Exception
{
// normal word
String defclass;
String defmethod;
StackEffect effect;
FactorClassLoader loader;
RecursiveForm rec = recursiveCheck.get(word);
if(rec != null && rec.active)
{
if(compiler.interp.verboseCompile)
System.err.println("Recursive call to " + rec);
effect = StackEffect.decompose(rec.effect,rec.baseCase);
// are we recursing back on a form inside the current
// method?
RecursiveForm last = recursiveCheck.last();
if(mw != null
&& recursiveCheck.allTails(rec)
&& last.className.equals(rec.className)
&& last.method.equals(rec.method))
{
if(compiler.interp.verboseCompile)
System.err.println(word + " is tail recursive");
// GOTO instad of INVOKEVIRTUAL; ie a loop!
compiler.normalizeStacks(mw);
mw.visitJumpInsn(GOTO,rec.label);
compiler.apply(effect);
return;
}
/* recursive method call! */
defclass = rec.className;
defmethod = rec.method;
loader = rec.loader;
if(mw != null && !defclass.equals(compiler.className))
compiler.loader.addDependency(defclass,loader);
}
else if(mw == null)
{
Cons definition = getDefinition(compiler.interp);
compiler.getStackEffect(definition,recursiveCheck);
return;
}
// not a recursive call but we're still not compiled
// its a bug in the compiler.
else if(this instanceof FactorCompoundDefinition)
{
throw new FactorCompilerException("You are an idiot!");
}
/* ordinary method call! */
else
{
defclass = getClass().getName().replace('.','/');
defmethod = "core";
effect = getStackEffect(compiler.interp,
new RecursiveState());
ClassLoader l = getClass().getClassLoader();
if(l instanceof FactorClassLoader)
{
loader = (FactorClassLoader)l;
compiler.loader.addDependency(
getClass().getName(),loader);
}
else
loader = null;
}
if(mw == null)
compiler.apply(effect);
else
{
mw.visitVarInsn(ALOAD,0);
compiler.generateArgs(mw,effect.inD,effect.inR,null);
String signature = effect.getCorePrototype();
mw.visitMethodInsn(INVOKESTATIC,defclass,defmethod,signature);
compiler.generateReturn(mw,effect.outD,effect.outR);
}
} //}}}
//{{{ compileNonRecursiveImmediate() method
/**
* Non-recursive immediate words are inlined.
*/
protected void compileNonRecursiveImmediate(CodeVisitor mw,
FactorCompiler compiler,
RecursiveState recursiveCheck,
StackEffect immediateEffect) throws Exception
{
Cons definition = toList(compiler.getInterpreter());
Cons endOfDocs = definition;
while(endOfDocs != null
&& endOfDocs.car instanceof FactorDocComment)
endOfDocs = endOfDocs.next();
compiler.compile(endOfDocs,mw,recursiveCheck);
} //}}}
//{{{ compileRecursiveImmediate() method
/**
* Recursive immediate words are compiled to an auxiliary method
* inside the compiled class definition.
*
* This must be done so that recursion has something to jump to.
*/
protected void compileRecursiveImmediate(CodeVisitor mw,
FactorCompiler compiler,
RecursiveState recursiveCheck,
StackEffect immediateEffect) throws Exception
{
Cons definition = toList(compiler.getInterpreter());
Cons endOfDocs = definition;
while(endOfDocs != null
&& endOfDocs.car instanceof FactorDocComment)
endOfDocs = endOfDocs.next();
String method = compiler.auxiliary(word,
endOfDocs,immediateEffect,recursiveCheck);
mw.visitVarInsn(ALOAD,0);
compiler.generateArgs(mw,immediateEffect.inD,
immediateEffect.inR,null);
String signature = immediateEffect.getCorePrototype();
mw.visitMethodInsn(INVOKESTATIC,compiler.className,
method,signature);
compiler.generateReturn(mw,
immediateEffect.outD,
immediateEffect.outR);
} //}}}
//{{{ compileImmediate() method
/**
* Compile a call to this word. Returns maximum JVM stack use.
*/
public void compileImmediate(CodeVisitor mw, FactorCompiler compiler,
RecursiveState recursiveCheck) throws Exception
{
Cons definition = getDefinition(compiler.interp);
if(mw == null)
{
compiler.compile(definition,null,recursiveCheck);
return;
}
// determine stack effect of this instantiation, and if its
// recursive.
FactorArrayStack savedDatastack = (FactorArrayStack)
compiler.datastack.clone();
FactorCallStack savedCallstack = (FactorCallStack)
compiler.callstack.clone();
StackEffect savedEffect = compiler.getStackEffect();
RecursiveState _recursiveCheck = (RecursiveState)
recursiveCheck.clone();
_recursiveCheck.last().effect = compiler.getStackEffect();
compileImmediate(null,compiler,_recursiveCheck);
boolean recursive = (_recursiveCheck.last().baseCase != null);
StackEffect effect = compiler.getStackEffect();
StackEffect immediateEffect = StackEffect.decompose(
savedEffect,compiler.getStackEffect());
// restore previous state.
FactorArrayStack afterDatastack = (FactorArrayStack)
compiler.datastack.clone();
FactorCallStack afterCallstack = (FactorCallStack)
compiler.callstack.clone();
compiler.datastack = (FactorArrayStack)savedDatastack.clone();
compiler.callstack = (FactorCallStack)savedCallstack.clone();
compiler.effect = savedEffect;
if(!recursive)
{
// not recursive; inline.
compileNonRecursiveImmediate(mw,compiler,recursiveCheck,
immediateEffect);
}
else
{
// recursive; must generate auxiliary method.
compileRecursiveImmediate(mw,compiler,recursiveCheck,
immediateEffect);
mergeStacks(savedDatastack,afterDatastack,compiler.datastack);
mergeStacks(savedCallstack,afterCallstack,compiler.callstack);
}
} //}}}
//{{{ mergeStacks() method
private void mergeStacks(FactorArrayStack s1, FactorArrayStack s2,
FactorArrayStack into)
{
for(int i = 0; i < s2.top; i++)
{
if(s1.top <= i)
break;
if(FactorLib.objectsEqual(s1.stack[i],
s2.stack[i]))
{
into.stack[i] = s1.stack[i];
}
}
} //}}}
//{{{ getWorkspace() method
/**
* Each persistent object is stored in one workspace only.
*/
public Workspace getWorkspace()
{
return workspace;
} //}}}
//{{{ getID() method
/**
* Each persistent object has an associated ID.
*/
public long getID()
{
return id;
} //}}}
//{{{ pickle() method
/**
* Each persistent object can turn itself into a byte array.
*/
public byte[] pickle(FactorInterpreter interp)
throws PersistenceException
{
try
{
ByteArrayOutputStream bytes = new ByteArrayOutputStream();
Cons pickle = new Cons(word,toList(interp));
bytes.write((FactorReader.getVocabularyDeclaration(pickle)
+ FactorReader.unparseDBObject(pickle))
.getBytes(ENCODING));
return bytes.toByteArray();
}
catch(Exception e)
{
// should not happen with byte array stream
throw new PersistenceException("Unexpected error",e);
}
} //}}}
//{{{ unpickle() method
/**
* Each persistent object can set its state to that in a byte array.
*/
public void unpickle(byte[] bytes, int offset, FactorInterpreter interp)
throws PersistenceException
{
try
{
String unparsed = new String(bytes,offset,
bytes.length - offset,ENCODING);
Cons pickle = (Cons)FactorReader.parseObject(unparsed,
interp);
word = (FactorWord)pickle.car;
fromList(pickle.next(),interp);
}
catch(Exception e)
{
// should not happen with byte array stream
throw new PersistenceException("Unexpected error",e);
}
} //}}}
//{{{ toString() method
public String toString()
{
return getClass().getName() + ": " + word;
} //}}}
}

22
factor/ReadTable.java
View File

@ -34,6 +34,28 @@ package factor;
*/
public class ReadTable
{
public static final ReadTable DEFAULT_READTABLE;
//{{{ Class initializer
static
{
DEFAULT_READTABLE = new ReadTable();
DEFAULT_READTABLE.setCharacterType('\t',ReadTable.WHITESPACE);
DEFAULT_READTABLE.setCharacterType('\n',ReadTable.WHITESPACE);
DEFAULT_READTABLE.setCharacterType('\r',ReadTable.WHITESPACE);
DEFAULT_READTABLE.setCharacterType(' ',ReadTable.WHITESPACE);
DEFAULT_READTABLE.setCharacterType('!',ReadTable.CONSTITUENT);
DEFAULT_READTABLE.setCharacterType('"',ReadTable.DISPATCH);
DEFAULT_READTABLE.setCharacterRange('#','[',ReadTable.CONSTITUENT);
DEFAULT_READTABLE.setCharacterType('\\',ReadTable.SINGLE_ESCAPE);
DEFAULT_READTABLE.setCharacterRange(']','~',ReadTable.CONSTITUENT);
DEFAULT_READTABLE.setCharacterType('!',ReadTable.DISPATCH);
DEFAULT_READTABLE.setCharacterType('(',ReadTable.CONSTITUENT);
} //}}}
/**
* Invalid character.
*/

15
factor/compiler/FactorClassLoader.java
View File

@ -42,6 +42,13 @@ public class FactorClassLoader extends ClassLoader
{
private long id;
private FactorNamespace table = new FactorNamespace();
private ClassLoader delegate;
//{{{ FactorClassLoader constructor
public FactorClassLoader(ClassLoader delegate)
{
this.delegate = delegate;
} //}}}
//{{{ addDependency() method
public void addDependency(String name, FactorClassLoader loader)
@ -88,7 +95,15 @@ public class FactorClassLoader extends ClassLoader
System.err.println("WARNING: unknown object in class loader table for " + this + ": " + obj);
}
if(delegate == null)
return super.loadClass(name,resolve);
else
{
c = delegate.loadClass(name);
if(resolve)
resolveClass(c);
return c;
}
}
catch(ClassNotFoundException e)
{

983
factor/compiler/FactorCompiler.java.new Normal file
View File

@ -0,0 +1,983 @@
/* :folding=explicit:collapseFolds=1: */
/*
* $Id$
*
* Copyright (C) 2004 Slava Pestov.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
* FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
* DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
package factor.compiler;
import factor.*;
import java.lang.reflect.*;
import java.util.*;
import org.objectweb.asm.*;
public class FactorCompiler implements Constants
{
public final FactorInterpreter interp;
public final FactorWord word;
public final String className;
public final FactorClassLoader loader;
public String method;
private int base;
private int allotD;
private int allotR;
public FactorArrayStack datastack;
public FactorCallStack callstack;
private int literalCount;
private Map literals;
public StackEffect effect;
/**
* getStackEffect() turns these into arrays and places them in the
* returned object.
*/
private Cons inDtypes, inRtypes;
private Cons aux;
private int auxCount;
//{{{ FactorCompiler constructor
/**
* For balancing.
*/
public FactorCompiler(FactorInterpreter interp)
{
this(interp,null,null,null);
init(0,0,0,null);
} //}}}
//{{{ FactorCompiler constructor
/**
* For compiling.
*/
public FactorCompiler(FactorInterpreter interp,
FactorWord word, String className,
FactorClassLoader loader)
{
this.interp = interp;
this.word = word;
this.className = className;
this.loader = loader;
literals = new HashMap();
datastack = new FactorArrayStack();
callstack = new FactorCallStack();
} //}}}
//{{{ getInterpreter() method
public FactorInterpreter getInterpreter()
{
return interp;
} //}}}
//{{{ init() method
public void init(int base, int allotD, int allotR, String method)
{
effect = new StackEffect();
this.base = base;
datastack.top = 0;
callstack.top = 0;
for(int i = 0; i < allotD; i++)
{
Result r = new Result(base + i,this,null,
Object.class);
datastack.push(r);
inDtypes = new Cons(r,inDtypes);
}
for(int i = 0; i < allotR; i++)
{
Result r = new Result(base + allotD + i,this,null,
Object.class);
callstack.push(r);
inRtypes = new Cons(r,inRtypes);
}
this.allotD = allotD;
this.allotR = allotR;
effect.inD = allotD;
effect.inR = allotR;
this.method = method;
} //}}}
//{{{ getAllotedEffect() method
public StackEffect getAllotedEffect()
{
return new StackEffect(allotD,allotR,0,0);
} //}}}
//{{{ ensure() method
public void ensure(FactorArrayStack stack, Class type)
{
if(stack.top == 0)
{
Result r = new Result(allocate(),this,null,type);
if(stack == datastack)
{
inDtypes = new Cons(r,inDtypes);
effect.inD++;
}
else if(stack == callstack)
{
inRtypes = new Cons(r,inRtypes);
effect.inR++;
}
stack.push(r);
}
} //}}}
//{{{ ensure() method
/**
* Ensure stack has at least 'count' elements.
* Eg, if count is 4 and stack is A B,
* stack will become RESULT RESULT A B.
* Used when deducing stack effects.
*/
public void ensure(FactorArrayStack stack, int count)
{
Class[] types = new Class[count];
for(int i = 0; i < types.length; i++)
types[i] = Object.class;
ensure(stack,types);
} //}}}
//{{{ ensure() method
/**
* Ensure stack has at least 'count' elements.
* Eg, if count is 4 and stack is A B,
* stack will become RESULT RESULT A B.
* Used when deducing stack effects.
*/
public void ensure(FactorArrayStack stack, Class[] types)
{
int top = stack.top;
if(top < types.length)
{
Cons typespec = null;
if(stack == datastack)
effect.inD += (types.length - top);
else if(stack == callstack)
effect.inR += (types.length - top);
stack.ensurePush(types.length - top);
System.arraycopy(stack.stack,0,stack.stack,
types.length - top,top);
for(int i = 0; i < types.length - top; i++)
{
int local = allocate();
Result r = new Result(
local,this,null,types[i]);
stack.stack[i] = r;
typespec = new Cons(r,typespec);
}
stack.top = types.length;
if(stack == datastack)
inDtypes = Cons.nappend(inDtypes,typespec);
else if(stack == callstack)
inRtypes = Cons.nappend(inRtypes,typespec);
}
} //}}}
//{{{ consume() method
public void consume(FactorArrayStack stack, int count)
{
ensure(stack,count);
stack.top -= count;
} //}}}
//{{{ produce() method
public void produce(FactorArrayStack stack, int count)
{
for(int i = 0; i < count; i++)
{
int local = allocate();
stack.push(new Result(local,this,null,Object.class));
}
} //}}}
//{{{ apply() method
public void apply(StackEffect se)
{
consume(datastack,se.inD);
produce(datastack,se.outD);
consume(callstack,se.inR);
produce(callstack,se.outR);
} //}}}
//{{{ getTypeSpec() method
private Class[] getTypeSpec(Cons list)
{
if(list == null)
return new Class[0];
int length = list.length();
Class[] typespec = new Class[length];
int i = 0;
while(list != null)
{
typespec[length - i - 1]
= ((FlowObject)list.car).getType();
i++;
list = list.next();
}
return typespec;
} //}}}
//{{{ getStackEffect() method
public StackEffect getStackEffect()
{
effect.inDtypes = getTypeSpec(inDtypes);
effect.outD = datastack.top;
effect.outDtypes = new Class[datastack.top];
for(int i = 0; i < datastack.top; i++)
{
effect.outDtypes[i] = ((FlowObject)datastack.stack[i])
.getType();
}
effect.inRtypes = getTypeSpec(inRtypes);
effect.outR = callstack.top;
effect.outRtypes = new Class[callstack.top];
for(int i = 0; i < callstack.top; i++)
{
effect.outRtypes[i] = ((FlowObject)callstack.stack[i])
.getType();
}
return (StackEffect)effect.clone();
} //}}}
//{{{ getStackEffect() method
public void getStackEffect(Cons definition,
RecursiveState recursiveCheck)
throws Exception
{
while(definition != null)
{
Object obj = definition.car;
if(obj instanceof FactorWord)
getStackEffectOfWord((FactorWord)obj,recursiveCheck);
else
pushLiteral(obj,recursiveCheck);
definition = definition.next();
}
} //}}}
//{{{ getStackEffectOfWord() method
private void getStackEffectOfWord(FactorWord word,
RecursiveState recursiveCheck)
throws Exception
{
RecursiveForm rec = recursiveCheck.get(word);
try
{
boolean recursiveCall;
if(rec == null)
{
recursiveCall = false;
recursiveCheck.add(word,
getStackEffect(),
className,loader,
"core");
/* recursiveCheck.last().tail
= (word.def instanceof FactorPrimitiveDefinition); */
}
else
{
recursiveCall = true;
rec.active = true;
}/*
if(rec == null)
recursiveCheck.add(word,getStackEffect(),null,null,null);
else
rec.active = true; */
compileCallTo(word,null,recursiveCheck,false);
}
finally
{
if(rec == null)
recursiveCheck.remove(word);
else
{
rec.active = false;
rec.tail = false;
}
}
} //}}}
//{{{ compileCore() method
public void compileCore(Cons definition, ClassWriter cw,
StackEffect effect, RecursiveState recursiveCheck)
throws Exception
{
RecursiveForm last = recursiveCheck.last();
last.method = "core";
last.className = className;
last.loader = loader;
compileMethod(definition,cw,"core",effect,word,recursiveCheck,true);
} //}}}
//{{{ compileFieldInit() method
private void compileFieldInit(CodeVisitor mw, Label start)
{
mw.visitFieldInsn(GETSTATIC,className,"initialized","Z");
mw.visitJumpInsn(IFNE,start);
mw.visitInsn(ICONST_1);
mw.visitFieldInsn(PUTSTATIC,className,"initialized","Z");
mw.visitVarInsn(ALOAD,0);
mw.visitMethodInsn(INVOKESTATIC,className,"setFields",
"(Lfactor/FactorInterpreter;)V");
} //}}}
//{{{ compileReturn() method
/**
* Once the word finishes executing, any return values need to be
* passed up.
*/
private void compileReturn(CodeVisitor mw, Label end,
StackEffect effect) throws Exception
{
// special case where return value is passed on
// JVM operand stack
// note: in each branch, must visit end label before RETURN!
if(effect.outD == 0 && effect.outR == 0)
{
mw.visitLabel(end);
mw.visitInsn(RETURN);
}
else if(effect.outD == 1 && effect.outR == 0)
{
pop(datastack,mw,Object.class);
mw.visitLabel(end);
mw.visitInsn(ARETURN);
}
else
{
// store datastack in a local
mw.visitVarInsn(ALOAD,0);
mw.visitFieldInsn(GETFIELD,
"factor/FactorInterpreter",
"datastack",
"Lfactor/FactorArrayStack;");
int datastackLocal = allocate();
mw.visitVarInsn(ASTORE,datastackLocal);
for(int i = 0; i < datastack.top; i++)
{
mw.visitVarInsn(ALOAD,datastackLocal);
((FlowObject)datastack.stack[i])
.pop(mw,Object.class);
mw.visitMethodInsn(INVOKEVIRTUAL,
"factor/FactorArrayStack",
"push",
"(Ljava/lang/Object;)V");
}
datastack.top = 0;
// store callstack in a local
mw.visitVarInsn(ALOAD,0);
mw.visitFieldInsn(GETFIELD,
"factor/FactorInterpreter",
"callstack",
"Lfactor/FactorCallStack;");
int callstackLocal = allocate();
mw.visitVarInsn(ASTORE,callstackLocal);
for(int i = 0; i < callstack.top; i++)
{
mw.visitVarInsn(ALOAD,callstackLocal);
((FlowObject)callstack.stack[i])
.pop(mw,Object.class);
mw.visitMethodInsn(INVOKEVIRTUAL,
"factor/FactorCallStack",
"push",
"(Ljava/lang/Object;)V");
}
callstack.top = 0;
mw.visitLabel(end);
mw.visitInsn(RETURN);
}
} //}}}
//{{{ compileMethod() method
/**
* Compiles a method.
*/
public void compileMethod(Cons definition, ClassWriter cw,
String methodName, StackEffect effect, FactorWord word,
RecursiveState recursiveCheck, boolean fieldInit)
throws Exception
{
String signature = effect.getCorePrototype();
CodeVisitor mw = cw.visitMethod(ACC_PUBLIC | ACC_STATIC,
methodName,signature,null,null);
Label start = recursiveCheck.get(word).label;
if(fieldInit)
compileFieldInit(mw,start);
mw.visitLabel(start);
compile(definition,mw,recursiveCheck);
Label end = new Label();
compileReturn(mw,end,effect);
compileExceptionHandler(mw,start,end,word);
mw.visitMaxs(0,0);
} //}}}
//{{{ compileExceptionHandler() method
private void compileExceptionHandler(CodeVisitor mw,
Label start, Label end, FactorWord word)
{
// otherwise no code can throw exception etc
if(start.getOffset() != end.getOffset())
{
// Now compile exception handler.
Label target = new Label();
mw.visitLabel(target);
mw.visitVarInsn(ASTORE,1);
mw.visitVarInsn(ALOAD,0);
mw.visitFieldInsn(GETSTATIC,className,literal(word),
"Ljava/lang/Object;");
mw.visitTypeInsn(CHECKCAST,"factor/FactorWord");
mw.visitVarInsn(ALOAD,1);
mw.visitMethodInsn(INVOKEVIRTUAL,"factor/FactorInterpreter",
"compiledException",
"(Lfactor/FactorWord;Ljava/lang/Throwable;)V");
mw.visitVarInsn(ALOAD,1);
mw.visitInsn(ATHROW);
mw.visitTryCatchBlock(start,end,target,"java/lang/Throwable");
}
} //}}}
//{{{ compile() method
/**
* Compiles a quotation.
*/
public void compile(Cons definition, CodeVisitor mw,
RecursiveState recursiveCheck) throws Exception
{
while(definition != null)
{
Object obj = definition.car;
if(obj instanceof FactorWord)
{
compileWord((FactorWord)obj,mw,recursiveCheck,
definition.cdr == null);
}
else
pushLiteral(obj,recursiveCheck);
definition = definition.next();
}
} //}}}
//{{{ compileWord() method
private void compileWord(FactorWord w, CodeVisitor mw,
RecursiveState recursiveCheck,
boolean tail) throws Exception
{
if(tail && interp.verboseCompile)
System.err.println("Tail: " + recursiveCheck.last());
recursiveCheck.last().tail = tail;
RecursiveForm rec = recursiveCheck.get(w);
try
{
boolean recursiveCall;
if(rec == null)
{
recursiveCall = false;
recursiveCheck.add(w,
new StackEffect(),
className,loader,
"core");
recursiveCheck.last().tail
= (w.def instanceof FactorPrimitiveDefinition);
}
else
{
recursiveCall = true;
rec.active = true;
}
compileCallTo(w,mw,recursiveCheck,recursiveCall);
}
finally
{
if(rec == null)
recursiveCheck.remove(w);
else
{
rec.active = false;
rec.tail = false;
}
}
} //}}}
//{{{ compileCallTo() method
private void compileCallTo(FactorWord w, CodeVisitor mw,
RecursiveState recursiveCheck,
boolean recursiveCall) throws Exception
{
if(w.def == null)
throw new FactorUndefinedWordException(w);
FactorWordDefinition d = w.def;
if(!recursiveCall)
{
StackEffect effect = getStackEffectOrNull(d);
if(w.inline)
{
d.compileImmediate(mw,this,recursiveCheck);
return;
}
else if(d instanceof FactorCompoundDefinition
&& mw != null)
{
w.compile(interp,recursiveCheck);
if(d == w.def)
{
throw new FactorCompilerException(word + " depends on " + w + " which cannot be compiled");
}
d = w.def;
}
w.compileRef = true;
}
d.compileCallTo(mw,this,recursiveCheck);
} //}}}
//{{{ push() method
/**
* Generates code for pushing the top of the JVM stack onto the
* data stack. Also generates code for converting this value to
* the given type.
*/
public void push(FactorArrayStack stack, CodeVisitor mw, Class type)
throws Exception
{
int local = allocate();
Result r = new Result(local,this,null,type);
stack.push(r);
r.push(mw,type);
} //}}}
//{{{ pushLiteral() method
public void pushLiteral(Object literal, RecursiveState recursiveCheck)
{
if(literal == null)
datastack.push(new Null(this,recursiveCheck));
else if(literal instanceof Cons)
{
datastack.push(new CompiledList((Cons)literal,this,
recursiveCheck));
}
else if(literal instanceof String)
{
datastack.push(new ConstantPoolString((String)literal,
this,recursiveCheck));
}
else
{
datastack.push(new Literal(literal,this,
recursiveCheck));
}
} //}}}
//{{{ pop() method
/**
* Generates code for popping the top of the data stack onto
* the JVM stack. Also generates code for converting this value to
* the given type.
*/
public void pop(FactorArrayStack stack, CodeVisitor mw, Class type)
throws Exception
{
FlowObject obj = (FlowObject)datastack.pop();
obj.pop(mw,type);
} //}}}
//{{{ popLiteral() method
/**
* Pops a literal off the datastack or throws an exception.
*/
public Object popLiteral() throws FactorException
{
FlowObject obj = (FlowObject)datastack.pop();
return obj.getLiteral();
} //}}}
//{{{ allocate() method
/**
* Allocate a local variable.
*/
public int allocate()
{
// inefficient!
int i = base;
for(;;)
{
if(allocate(i,datastack) && allocate(i,callstack))
return i;
else
i++;
}
} //}}}
//{{{ allocate() method
/**
* Return true if not in use, false if in use.
*/
private boolean allocate(int local, FactorArrayStack stack)
{
for(int i = 0; i < stack.top; i++)
{
FlowObject obj = (FlowObject)stack.stack[i];
if(obj.usingLocal(local))
return false;
}
return true;
} //}}}
//{{{ literal() method
public String literal(Object obj)
{
Integer i = (Integer)literals.get(obj);
int literal;
if(i == null)
{
literal = literalCount++;
literals.put(obj,new Integer(literal));
}
else
literal = i.intValue();
return "literal_" + literal;
} //}}}
//{{{ auxiliary() method
public String auxiliary(FactorWord word, Cons code, StackEffect effect,
RecursiveState recursiveCheck) throws Exception
{
FactorArrayStack savedDatastack = (FactorArrayStack)
datastack.clone();
FactorCallStack savedCallstack = (FactorCallStack)
callstack.clone();
String method = "aux_" + FactorJava.getSanitizedName(word.name)
+ "_" + (auxCount++);
recursiveCheck.last().method = method;
aux = new Cons(new AuxiliaryQuotation(
method,savedDatastack,savedCallstack,
code,effect,word,this,recursiveCheck),aux);
return method;
} //}}}
//{{{ generateAuxiliary() method
public void generateAuxiliary(ClassWriter cw) throws Exception
{
while(aux != null)
{
AuxiliaryQuotation q = (AuxiliaryQuotation)aux.car;
// order of these two important, in case
// compilation of q adds more quotations to aux list
aux = aux.next();
q.compile(this,cw);
}
} //}}}
//{{{ normalizeStacks() method
public void normalizeStacks(CodeVisitor mw)
throws Exception
{
int datastackTop = datastack.top;
datastack.top = 0;
int callstackTop = callstack.top;
callstack.top = 0;
localsToStack(callstack,callstackTop,mw);
localsToStack(datastack,datastackTop,mw);
stackToLocals(datastack,datastackTop,mw);
stackToLocals(callstack,callstackTop,mw);
} //}}}
//{{{ localsToStack() method
private void localsToStack(FactorArrayStack stack, int top,
CodeVisitor mw)
{
for(int i = top - 1; i >= 0; i--)
{
FlowObject obj = (FlowObject)stack.stack[i];
obj.pop(mw);
}
} //}}}
//{{{ stackToLocals() method
private void stackToLocals(FactorArrayStack stack, int top,
CodeVisitor mw) throws Exception
{
for(int i = 0; i < top; i++)
push(stack,mw,Object.class);
} //}}}
//{{{ generateArgs() method
/**
* Generate instructions for copying arguments from the allocated
* local variables to the JVM stack, doing type conversion in the
* process.
*/
public void generateArgs(CodeVisitor mw, int inD, int inR, Class[] args)
throws Exception
{
for(int i = 0; i < inD; i++)
{
FlowObject obj = (FlowObject)datastack.stack[
datastack.top - inD + i];
obj.pop(mw,args == null ? Object.class : args[i]);
}
datastack.top -= inD;
for(int i = 0; i < inR; i++)
{
FlowObject obj = (FlowObject)callstack.stack[
callstack.top - inR + i];
obj.pop(mw,args == null ? Object.class : args[i]);
}
callstack.top -= inR;
} //}}}
//{{{ generateReturn() method
public void generateReturn(CodeVisitor mw, int outD, int outR)
throws Exception
{
if(outD == 0 && outR == 0)
{
// do nothing
}
else if(outD == 1 && outR == 0)
{
push(datastack,mw,Object.class);
}
else
{
// transfer from data stack to JVM locals
// allocate the appropriate number of locals
if(outD != 0)
{
produce(datastack,outD);
// store the datastack instance somewhere
mw.visitVarInsn(ALOAD,0);
mw.visitFieldInsn(GETFIELD,
"factor/FactorInterpreter",
"datastack",
"Lfactor/FactorArrayStack;");
int datastackLocal = allocate();
mw.visitVarInsn(ASTORE,datastackLocal);
// put all elements from the real datastack
// into locals
for(int i = 0; i < outD; i++)
{
mw.visitVarInsn(ALOAD,datastackLocal);
mw.visitMethodInsn(INVOKEVIRTUAL,
"factor/FactorArrayStack",
"pop",
"()Ljava/lang/Object;");
Result destination = (Result)
datastack.stack[
datastack.top - i - 1];
destination.push(mw,Object.class);
}
}
if(outR != 0)
{
produce(callstack,outR);
mw.visitVarInsn(ALOAD,0);
mw.visitFieldInsn(GETFIELD,
"factor/FactorInterpreter",
"callstack",
"Lfactor/FactorCallStack;");
int callstackLocal = allocate();
mw.visitVarInsn(ASTORE,callstackLocal);
// put all elements from the real callstack
// into locals
for(int i = 0; i < outR; i++)
{
mw.visitVarInsn(ALOAD,callstackLocal);
mw.visitMethodInsn(INVOKEVIRTUAL,
"factor/FactorCallStack",
"pop",
"()Ljava/lang/Object;");
Result destination = (Result)
callstack.stack[
callstack.top - i - 1];
destination.push(mw,Object.class);
}
}
}
} //}}}
//{{{ generateFields() method
public void generateFields(ClassWriter cw)
throws Exception
{
for(int i = 0; i < literalCount; i++)
{
cw.visitField(ACC_PRIVATE | ACC_STATIC,"literal_" + i,
"Ljava/lang/Object;",null,null);
}
CodeVisitor mw = cw.visitMethod(ACC_PRIVATE | ACC_STATIC,
"setFields","(Lfactor/FactorInterpreter;)V",null,null);
Iterator entries = literals.entrySet().iterator();
while(entries.hasNext())
{
Map.Entry entry = (Map.Entry)entries.next();
Object literal = entry.getKey();
int index = ((Integer)entry.getValue()).intValue();
generateParse(mw,literal,0);
mw.visitFieldInsn(PUTSTATIC,
className,
"literal_" + index,
"Ljava/lang/Object;");
}
mw.visitInsn(RETURN);
mw.visitMaxs(0,0);
} //}}}
//{{{ generateParse() method
public void generateParse(CodeVisitor mw, Object obj, int interpLocal)
{
mw.visitLdcInsn(FactorReader.getVocabularyDeclaration(obj)
+ FactorReader.unparseObject(obj));
mw.visitVarInsn(ALOAD,interpLocal);
mw.visitMethodInsn(INVOKESTATIC,
"factor/FactorReader",
"parseObject",
"(Ljava/lang/String;Lfactor/FactorInterpreter;)"
+ "Ljava/lang/Object;");
} //}}}
//{{{ getStackEffectOrNull() method
public StackEffect getStackEffectOrNull(FactorWordDefinition def)
{
try
{
return def.getStackEffect(interp,
new RecursiveState());
}
catch(Exception e)
{
//System.err.println("WARNING: " + e);
//System.err.println(def);
return null;
}
} //}}}
//{{{ getStackEffectOrNull() method
public StackEffect getStackEffectOrNull(FlowObject obj,
RecursiveState recursiveCheck,
boolean decompose)
{
try
{
obj.getStackEffect(recursiveCheck);
StackEffect effect = getStackEffect();
if(decompose)
{
effect = StackEffect.decompose(
recursiveCheck.last().effect,
effect);
}
return effect;
}
catch(Exception e)
{
//System.err.println("WARNING: " + e);
//System.err.println(obj);
return null;
}
} //}}}
}

24
factor/compiler/FlowObject.java
View File

@ -173,11 +173,25 @@ implements Constants, FactorExternalizable, PublicCloneable
}
else
{
mw.visitMethodInsn(INVOKESTATIC,
"factor/FactorJava",
methodName,
"(Ljava/lang/Object;)"
+ FactorJava.javaClassToVMClass(type));
String signature;
if(type.isArray())
{
signature = "(Ljava/lang/Object;)"
+ "[Ljava/lang/Object;";
}
else
{
signature = "(Ljava/lang/Object;)"
+ FactorJava.javaClassToVMClass(type);
}
mw.visitMethodInsn(INVOKESTATIC,"factor/FactorJava",
methodName,signature);
/* if(type.isArray())
{
mw.visitTypeInsn(CHECKCAST,
type.getName()
.replace('.','/'));
} */
}
} //}}}

192
factor/jedit/EditWordDialog.java Normal file
View File

@ -0,0 +1,192 @@
/* :folding=explicit:collapseFolds=1: */
/*
* $Id$
*
* Copyright (C) 2004 Slava Pestov.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* 1. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright notice,
* this list of conditions and the following disclaimer in the documentation
* and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
* FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
* DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
package factor.jedit;
import factor.*;
import javax.swing.border.*;
import javax.swing.event.*;
import javax.swing.text.Document;
import javax.swing.*;
import java.awt.event.*;
import java.awt.*;
import java.util.List;
import org.gjt.sp.jedit.gui.EnhancedDialog;
import org.gjt.sp.jedit.*;
public class EditWordDialog extends WordListDialog
{
private JTextField field;
private Timer timer;
//{{{ EditWordDialog constructor
public EditWordDialog(View view, FactorSideKickParser parser)
{
super(view,parser,jEdit.getProperty("factor.edit-word.title"));
Box top = new Box(BoxLayout.X_AXIS);
top.add(new JLabel(jEdit.getProperty(
"factor.edit-word.caption")));
top.add(Box.createHorizontalStrut(12));
top.add(field = new JTextField(16));
field.getDocument().addDocumentListener(new DocumentHandler());
field.addKeyListener(new KeyHandler());
getContentPane().add(BorderLayout.NORTH,top);
list.setFixedCellHeight(list.getFontMetrics(list.getFont())
.getHeight());
list.addKeyListener(new KeyHandler());
timer = new Timer(0,new UpdateTimer());
pack();
setLocationRelativeTo(view);
setVisible(true);
} //}}}
//{{{ ok() method
public void ok()
{
FactorWord word = (FactorWord)list.getSelectedValue();
if(word == null)
{
getToolkit().beep();
return;
}
String code = FactorPlugin.factorWord(word);
FactorPlugin.eval(view,code + " jedit");
dispose();
} //}}}
//{{{ cancel() method
public void cancel()
{
dispose();
} //}}}
//{{{ updateListWithDelay() method
private void updateListWithDelay()
{
timer.stop();
String text = field.getText();
if(text.length() <= 1)
list.setListData(new Object[0]);
else
{
timer.setInitialDelay(100);
timer.setRepeats(false);
timer.start();
}
} //}}}
//{{{ updateList() method
private void updateList()
{
List completions = FactorPlugin.getCompletions(
field.getText(),true);
FactorWord[] completionArray
= (FactorWord[])completions.toArray(
new FactorWord[completions.size()]);
list.setListData(completionArray);
if(completionArray.length != 0)
{
list.setSelectedIndex(0);
list.ensureIndexIsVisible(0);
}
} //}}}
//{{{ UpdateTimer class
class UpdateTimer implements ActionListener
{
public void actionPerformed(ActionEvent evt)
{
updateList();
}
} //}}}
//{{{ KeyHandler class
class KeyHandler extends KeyAdapter
{
public void keyPressed(KeyEvent evt)
{
switch(evt.getKeyCode())
{
case KeyEvent.VK_UP:
int selected = list.getSelectedIndex();
if(selected == 0)
selected = list.getModel().getSize() - 1;
else if(getFocusOwner() == list)
return;
else
selected = selected - 1;
list.setSelectedIndex(selected);
list.ensureIndexIsVisible(selected);
evt.consume();
break;
case KeyEvent.VK_DOWN:
/* int */ selected = list.getSelectedIndex();
if(selected == list.getModel().getSize() - 1)
selected = 0;
else if(getFocusOwner() == list)
return;
else
selected = selected + 1;
list.setSelectedIndex(selected);
list.ensureIndexIsVisible(selected);
evt.consume();
break;
}
}
} //}}}
//{{{ DocumentHandler class
class DocumentHandler implements DocumentListener
{
public void insertUpdate(DocumentEvent evt)
{
updateListWithDelay();
}
public void removeUpdate(DocumentEvent evt)
{
updateListWithDelay();
}
public void changedUpdate(DocumentEvent evt)
{
}
} //}}}
}

Some files were not shown because too many files have changed in this diff Show More