-Main-Class: factor.listener.FactorDesktop
+Main-Class: factor.FactorInterpreter
CC = gcc
-DEFAULT_CFLAGS = -Os -Wall -export-dynamic -fomit-frame-pointer $(SITE_CFLAGS)
+DEFAULT_CFLAGS = -Wall -export-dynamic -g $(SITE_CFLAGS)
DEFAULT_LIBS = -lm
STRIP = strip
f: $(OBJS)
$(CC) $(LIBS) $(CFLAGS) -o $@ $(OBJS)
- $(STRIP) $@
+ # $(STRIP) $@
clean:
rm -f $(OBJS)
FFI:\r
+\r
++ compiler/ffi:\r
+\r
- is signed -vs- unsigned pointers an issue?\r
- bitfields in C structs\r
- SDL_Rect** type\r
- struct membres that are not *\r
- float types\r
-- SDL_MapRGB broken\r
-\r
-- command line parsing cleanup\r
-- > 1 ( ) inside word def\r
-- parsing-word test fails\r
-\r
-- when* compilation in jvm\r
- compile word twice; no more 'cannot compile' error!\r
-- doc comments in image, inferior\r
- compiler: drop literal peephole optimization\r
- compiling when*\r
- compiling unless*\r
- getenv/setenv: if literal arg, compile as a load/store\r
- inline words\r
- perhaps /i should work with all numbers\r
-- profiler is inaccurate: wrong word on cs\r
-- buffer change handler in sidekick is screwed\r
-- eval with multilien strings and #!\r
-- quit responder breaks with multithreading\r
-- nicer way to combine two paths\r
-- don't show listener on certain commands\r
-- plugin should not exit jEdit on fatal errors\r
-- wordpreview: don't show for string literals and comments\r
-- alist -vs- assoc terminology\r
-- file responder: don't show full path in title\r
-\r
-- clean up listener's action popups\r
-- jedit ==> jedit-word, jedit takes a file name\r
-- add a socket timeout\r
-- fix error postoning -- not all errors thrown by i/o code are\r
- postponed\r
-- some way to run httpd from command line\r
-\r
-+ bignums:\r
-\r
-- move some s48_ functions into bignum.c\r
-- remove unused functions\r
-\r
-- >lower, >upper for strings\r
-- accept multi-line input in listener\r
\r
+ docs:\r
\r
- explain how log uses >polar and rect>\r
-- when* unless*\r
- simple i/o section\r
- unparse examples, and difference from prettyprint\r
- review doc formatting with latex2html\r
multitasking\r
unit testing\r
\r
-+ tests:\r
-\r
-- java factor: equal numbers have non-equal hashcodes!\r
-- FactorLib.equal() not very good\r
-- investigate mandel.factor\r
-\r
+ listener/plugin:\r
\r
+- clean up listener's action popups\r
+- accept multi-line input in listener\r
+- don't show listener on certain commands\r
+- wordpreview: don't show for string literals and comments\r
- NPE in ErrorHighlight\r
- some way to not have previous definitions from a source file\r
clutter the namespace\r
- special completion for USE:/IN:\r
- inspector links when describe called without object path\r
\r
-+ native:\r
++ kernel:\r
\r
+- profiler is inaccurate: wrong word on cs\r
- better i/o scheduler\r
-\r
-+ JVM compiler:\r
-\r
-- compiled stack traces broken\r
-- save classes to disk\r
-- tail call optimization broken again\r
-- don't compile inline words\r
-- recursive words with code after ifte\r
-- less unnecessary args to auxiliary methods\r
-- inlining tail-recursive immediates\r
-- direct stack access leaks memory on stack\r
-- unnecessary local allocation: max is instance var, but several methods\r
- get compiled.\r
+- move some s48_ functions into bignum.c\r
+- remove unused functions\r
+- >lower, >upper for strings\r
+- add a socket timeout\r
+- fix error postoning -- not all errors thrown by i/o code are\r
+ postponed\r
+- don't rehash strings on every startup\r
\r
+ misc:\r
\r
-- don't rehash strings on every startup\r
+- jedit ==> jedit-word, jedit takes a file name\r
- 'cascading' styles\r
-- ditch expand\r
+- command line parsing cleanup\r
+- > 1 ( ) inside word def\r
+- parsing-word test fails\r
+- doc comments in image, inferior\r
+- eval with multilien strings and #!\r
+- nicer way to combine two paths\r
+- alist -vs- assoc terminology\r
\r
+ httpd:\r
\r
+- file responder: don't show full path in title\r
- wiki responder:\r
- port to native\r
- text styles\r
- log with date\r
basic authentication, using httpdAuth function from a config file\r
- file responder; last-modified field\r
+- quit responder breaks with multithreading\r
+\r
++ java factor is going away:\r
+\r
+- compiled stack traces broken\r
+- save classes to disk\r
+- tail call optimization broken again\r
+- don't compile inline words\r
+- recursive words with code after ifte\r
+- less unnecessary args to auxiliary methods\r
+- inlining tail-recursive immediates\r
+- direct stack access leaks memory on stack\r
+- unnecessary local allocation: max is instance var, but several methods\r
+ get compiled.\r
+- ditch expand\r
+- when* compilation in jvm\r
+- plugin should not exit jEdit on fatal errors\r
+- java factor: equal numbers have non-equal hashcodes!\r
+- FactorLib.equal() not very good\r
] with-pixels ;
: mandel ( -- )
- 1280 1024 32 SDL_HWSURFACE SDL_FULLSCREEN bitor SDL_SetVideoMode drop
+ 640 480 32 SDL_HWSURFACE SDL_FULLSCREEN bitor SDL_SetVideoMode drop
[
3 zoom-fact set
-0.65 center set
- 50 nb-iter set
+ 100 nb-iter set
[ render ] time
"Done." print flush
] with-surface
-% :indentSize=4:tabSize=4:noTabs=true:
+% :indentSize=4:tabSize=4:noTabs=true:mode=tex:
\documentclass[english]{article}
\usepackage[T1]{fontenc}
\newpage
\section*{Introduction}
-Factor is an imperative programming language with functional and object-oriented
+Factor is a programming language with functional and object-oriented
influences. Factor borrows heavily from Forth, Joy and Lisp. Programmers familiar with these languages will recognize many similarities with Factor.
Factor is \emph{interactive}. This means it is possible to run a Factor interpreter that reads from the keyboard, and immediately executes expressions as they are entered. This allows words to be defined and tested one at a time.
USE: strings
\end{alltt}
-\subsection{Booleans and logic}
+\section{PRACTICAL: Numbers game}
-Words that return a boolean truth value are known as \emph{predicates}. Predicates are usually used to decide what to execute next at branch points. In Factor, there is no special boolean data type
--- instead, a special object \texttt{f} is the only object with a
-``false'' boolean value. Every other object is a boolean ``true''.
-The special object \texttt{t} is the ``canonical'' truth value. Note that words that return booleans don't return \texttt{t} as a rule; any object that is not equal to \texttt{f} can be returned as the true value.
+In this section, basic input/output and flow control is introduced.
+We construct a program that repeatedly prompts the user to guess a
+number -- they are informed if their guess is correct, too low, or
+too high. The game ends on a correct guess.
-The usual boolean operations are found in the \texttt{logic} vocabulary. Note that these are not integer bitwise operations; bitwise operations are described in the next chapter.
+\begin{alltt}
+numbers-game
+\emph{I'm thinking of a number between 0 and 100.}
+\emph{Enter your guess:} 25
+\emph{Too low}
+\emph{Enter your guess:} 38
+\emph{Too high}
+\emph{Enter your guess:} 31
+\emph{Correct - you win!}
+\end{alltt}
-\texttt{not ( ?~-{}- ?~)} returns \texttt{t} if the top of stack is \texttt{f}, and \texttt{f} otherwise.
+\subsection{Getting started}
-\texttt{and ( ?~?~-{}- ?~)} returns a true value if both input parameters are true.
+Start a text editor and create a file named \texttt{numbers-game.factor}.
-\texttt{or ( ?~?~-{}- ?~)} returns a true value if at least one of the input parameters is true.
+Write a short comment at the top of the file. Two examples of commenting style supported by Factor:
-\texttt{xor ( ?~?~-{}- ?~)} returns a true value if exactly one of the input parameters is true.
+\begin{alltt}
+! Numbers game.
+( The great numbers game )
+\end{alltt}
+
+It is always a good idea to comment your code. Try to write simple
+code that does not need detailed comments to describe; similarly,
+avoid redundant comments. These two principles are hard to quantify
+in a concrete way, and will become more clear as your skills with
+Factor increase.
+
+We will be defining new words in the \texttt{numbers-game} vocabulary; add
+an \texttt{IN:} statement at the top of the source file:
\begin{alltt}
-t t and .
+IN: numbers-game
+\end{alltt}
+Also in order to be able to test the words, issue a \texttt{USE:}
+statement in the interactive interpreter:
+
+\begin{alltt}
+USE: numbers-game
+\end{alltt}
+This section will develop the numbers game in an incremental fashion.
+After each addition, issue a command like the following to load the
+source file into the Factor interpreter:
+
+\begin{alltt}
+"numbers-game.factor" run-file
+\end{alltt}
+
+\subsection{Reading a number from the keyboard}
+
+A fundamental operation required for the numbers game is to be able
+to read a number from the keyboard. The \texttt{read} word \texttt{(
+-{}- str )} reads a line of input and pushes it on the stack.
+The \texttt{parse-number} word \texttt{( str -{}- n )} turns a decimal
+string representation of an integer into the integer itself. These
+two words can be combined into a single colon definition:
+
+\begin{alltt}
+: read-number ( -{}- n ) read parse-number ;
+\end{alltt}
+You should add this definition to the source file, and try loading
+the file into the interpreter. As you will soon see, this raises an
+error! The problem is that the two words \texttt{read} and \texttt{parse-number}
+are not part of the default, minimal, vocabulary search path used
+when reading files. The solution is to use \texttt{apropos.} to find
+out which vocabularies contain those words, and add the appropriate
+\texttt{USE:} statements to the source file:
+
+\begin{alltt}
+USE: parser
+USE: stdio
+\end{alltt}
+After adding the above two statements, the file should now parse,
+and testing should confirm that the \texttt{read-number} word works correctly.%
+\footnote{There is the possibility of an invalid number being entered at the
+keyboard. In this case, \texttt{parse-number} returns \texttt{f},
+the boolean false value. For the sake of simplicity, we ignore this
+case in the numbers game example. However, proper error handling is
+an essential part of any large program and is covered later.%
+}
+
+
+\subsection{Printing some messages}
+
+Now we need to make some words for printing various messages. They
+are given here without further ado:
+
+\begin{alltt}
+: 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 ;
+\end{alltt}
+Note that in the above, stack effect comments are omitted, since they
+are obvious from context. You should ensure the words work correctly
+after loading the source file into the interpreter.
+
+
+\subsection{Taking action based on a guess}
+
+The next logical step is to write a word \texttt{judge-guess} that
+takes the user's guess along with the actual number to be guessed,
+and prints one of the messages \texttt{too-high}, \texttt{too-low},
+or \texttt{correct}. This word will also push a boolean flag, indicating
+if the game should continue or not -- in the case of a correct guess,
+the game does not continue.
+
+This description of judge-guess is a mouthful -- and it suggests that
+it may be best to split it into two words. The first word we write
+handles the more specific case of an \emph{inexact} guess -- so it
+prints either \texttt{too-low} or \texttt{too-high}.
+
+\begin{alltt}
+: inexact-guess ( actual guess -{}- )
+ < {[} too-high {]} {[} too-low {]} ifte ;
+\end{alltt}
+Note that the word gives incorrect output if the two parameters are
+equal. However, it will never be called this way.
+
+With this out of the way, the implementation of judge-guess is an
+easy task to tackle. Using the words \texttt{inexact-guess}, \texttt{2dup}, \texttt{2drop} and \texttt{=}, we can write:
+
+\begin{alltt}
+: judge-guess ( actual guess -{}- ? )
+ 2dup = {[}
+ 2drop correct f
+ {]} {[}
+ inexact-guess t
+ {]} ifte ;
+\end{alltt}
+
+The word \texttt{=} is found in the \texttt{kernel} vocabulary, and the words \texttt{2dup} and \texttt{2drop} are found in the \texttt{stack} vocabulary. Since \texttt{=}
+consumes both its inputs, we must first duplicate the \texttt{actual} and \texttt{guess} parameters using \texttt{2dup}. The word \texttt{correct} does not need to do anything with these two numbers, so they are popped off the stack using \texttt{2drop}. Try evaluating the following
+in the interpreter to see what's going on:
+
+\begin{alltt}
+clear 1 2 2dup = .s
+\emph{\{ 1 2 f \}}
+clear 4 4 2dup = .s
+\emph{\{ 4 4 t \}}
+\end{alltt}
+
+Test \texttt{judge-guess} with a few inputs:
+
+\begin{alltt}
+1 10 judge-guess .
+\emph{Too low}
\emph{t}
-5 f and .
-\emph{f}
-f "hi" or .
-\emph{"hi"}
-f f or .
-\emph{f}
-t t xor .
-\emph{f}
-t f xor .
+89 43 judge-guess .
+\emph{Too high}
\emph{t}
+64 64 judge-guess .
+\emph{Correct}
+\emph{f}
\end{alltt}
-\texttt{?~( cond~true false -{}- obj~)} returns the second argument if the first argument is true, and returns the third argument if the first argument is false.
+\subsection{Generating random numbers}
+
+The \texttt{random-int} word \texttt{( min max -{}- n )} pushes a
+random number in a specified range. The range is inclusive, so both
+the minimum and maximum indexes are candidate random numbers. Use
+\texttt{apropos.} to determine that this word is in the \texttt{random}
+vocabulary. For the purposes of this game, random numbers will be
+in the range of 0 to 100, so we can define a word that generates a
+random number in the range of 0 to 100:
\begin{alltt}
-: sgn 0 < -1 1 ? ;
--10 sgn .
-\emph{-1}
-5 sgn .
-\emph{1}
+: number-to-guess ( -{}- n ) 0 100 random-int ;
\end{alltt}
+Add the word definition to the source file, along with the appropriate
+\texttt{USE:} statement. Load the source file in the interpreter,
+and confirm that the word functions correctly, and that its stack
+effect comment is accurate.
-\subsection{\label{sub:Conditionals}Conditionals}
-\texttt{ifte} \texttt{( cond true false -{}- )} executes either the
-\texttt{true} or \texttt{false} quotations, depending on the boolean
-value of \texttt{cond}. A quotation a list of objects that can be executed. Quotations are input
-using the following syntax:
+\subsection{The game loop}
+
+The game loop consists of repeated calls to \texttt{guess-prompt},
+\texttt{read-number} and \texttt{judge-guess}. If \texttt{judge-guess}
+returns \texttt{f}, the loop stops, otherwise it continues. This is
+realized with a recursive implementation:
\begin{alltt}
-{[} 2 3 + . {]}
+: numbers-game-loop ( actual -{}- )
+ dup guess-prompt read-number judge-guess {[}
+ numbers-game-loop
+ {]} {[}
+ drop
+ {]} ifte ;
\end{alltt}
+In Factor, tail-recursive words consume a bounded amount of call stack
+space. This means you are free to pick recursion or iteration based
+on their own merits when solving a problem. In many other languages,
+the usefulness of recursion is severely limited by the lack of tail-recursive
+call optimization.
-Here is an example of \texttt{ifte} usage:
+
+\subsection{Finishing off}
+
+The last task is to combine everything into the main \texttt{numbers-game}
+word. This is easier than it seems:
\begin{alltt}
-1 2 < {[} "1 is less than 2." print {]} {[} "bug!" print {]} ifte
+: numbers-game number-to-guess numbers-game-loop ;
\end{alltt}
+Try it out! Simply invoke the \texttt{numbers-game} word in the interpreter.
+It should work flawlessly, assuming you tested each component of this
+design incrementally!
-Compare the order of parameters here with the order of parameters in
-the stack effect of \texttt{ifte}.
-The stack effects of the two \texttt{ifte} branches should be
-the same. If they differ, the word becomes harder to document and
-debug.
+\subsection{The complete program}
+
+\begin{verbatim}
+! Numbers game example
+
+IN: numbers-game
+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 ;
-\texttt{when} \texttt{( cond true -{}- )} and \texttt{unless} \texttt{( cond false -{}- )} are variations of \texttt{ifte} with only one active branch. The branches should produce as many values as they consume; this ensures that the stack effect of the entire \texttt{when} or \texttt{unless} expression is consistent regardless of which branch was taken.
+: numbers-game number-to-guess numbers-game-loop ;
+\end{verbatim}
-\section{Numbers}
+\section{More about numbers}
Factor provides a rich set of math words. Factor numbers more closely model the mathematical concept of a number than other languages. Where possible, exact answers are given -- for example, adding or multiplying two integers never results in overflow, and dividing two integers yields a fraction rather than a truncated result. Complex numbers are supported, allowing many functions to be computed with parameters that would raise errors or return ``not a number'' in other languages.
The \texttt{math} vocabulary provides a rich library of mathematical functions that covers exponentiation, logarithms, trigonometry, and hyperbolic functions. All functions accept and return complex number arguments where appropriate. These functions all return floating point values, or complex numbers whose real and imaginary components are floating point values.
-\texttt{\^{} ( x y -- x\^{}y )} raises \texttt{x} to the power of \texttt{y}. In the cases of \texttt{y} being equal to $1/2$, -1, or 2, respectively, the words \texttt{sqrt}, \texttt{recip} and \texttt{sq} can be used instead.
-
-\begin{alltt}
-2 4 \^ .
-\emph{16.0}
-i i \^ .
-\emph{0.2078795763507619}
-\end{alltt}
-
-All remaining functions have a stack effect \texttt{( x -{}- y )}, it won't be repeated for brevity.
-
-\texttt{exp} raises the number $e$ to a specified power. The number $e$ can be pushed on the stack with the \texttt{e} word, so \texttt{exp} could have been defined as follows:
-
-\begin{alltt}
-: exp ( x -- e^x ) e swap \^ ;
-\end{alltt}
-
-However, it is actually defined otherwise, for efficiency.\footnote{In fact, the word \texttt{\^{}} is actually defined in terms of \texttt{exp}, to correctly handle complex number arguments.}
-
-\texttt{log} computes the natural (base $e$) logarithm. This is the inverse of the \texttt{exp} function.
-
-\begin{alltt}
--1 log .
-\emph{\#\{ 0.0 3.141592653589793 \}}
-e log .
-\emph{1.0}
-\end{alltt}
-
-\texttt{sin}, \texttt{cos} and \texttt{tan} are the familiar trigonometric functions, and \texttt{asin}, \texttt{acos} and \texttt{atan} are their inverses.
-
-The reciprocals of the sine, cosine and tangent are defined as \texttt{sec}, \texttt{cosec} and \texttt{cot}, respectively. Their inverses are \texttt{asec}, \texttt{acosec} and \texttt{acot}.
-
-\texttt{sinh}, \texttt{cosh} and \texttt{tanh} are the hyperbolic functions, and \texttt{asinh}, \texttt{acosh} and \texttt{atanh} are their inverses.
-
-Similarly, the reciprocals of the hyperbolic functions are defined as \texttt{sech}, \texttt{cosech} and \texttt{coth}, respectively. Their inverses are \texttt{asech}, \texttt{acosech} and \texttt{acoth}.
-
-\subsection{Modular arithmetic}
-
-In addition to the standard division operator \texttt{/}, there are a few related functions that are useful when working with integers.
-
-\texttt{/i ( x y -{}- x/y )} performs a truncating integer division. It could have been defined as follows:
-
-\begin{alltt}
-: /i / >integer ;
-\end{alltt}
-
-However, the actual definition is a bit more efficient than that.
-
-\texttt{mod ( x y -{}- x\%y )} computes the remainder of dividing \texttt{x} by \texttt{y}. If the result is 0, then \texttt{x} is a multiple of \texttt{y}.
-
-\texttt{/mod ( x y -{}- x/y x\%y )} pushes both the quotient and remainder.
-
-\begin{alltt}
-100 3 mod .
-\emph{1}
--546 34 mod .
-\emph{-2}
-\end{alltt}
-
-\texttt{gcd ( x y -{}- z )} pushes the greatest common divisor of two integers; that is, the largest number that both integers could be divided by and still yield integers as results. This word is used behind the scenes to reduce rational numbers to lowest terms when doing ratio arithmetic.
-
-\subsection{Bitwise operations}
-
-There are two ways of looking at an integer -- as a mathematical entity, or as a string of bits. The latter representation faciliates the so-called \emph{bitwise operations}.
-
-\texttt{bitand ( x y -{}- x\&y )} returns a new integer where each bit is set if and only if the corresponding bit is set in both $x$ and $y$. If you're considering an integer as a sequence of bit flags, taking the bitwise-and with a mask switches off all flags that are not explicitly set in the mask.
-
-\begin{alltt}
-BIN: 101 BIN: 10 bitand .b
-\emph{0}
-BIN: 110 BIN: 10 bitand .b
-\emph{10}
-\end{alltt}
-
-\texttt{bitor ( x y -{}- x|y )} returns a new integer where each bit is set if and only if the corresponding bit is set in at least one of $x$ or $y$. If you're considering an integer as a sequence of bit flags, taking the bitwise-or with a mask switches on all flags that are set in the mask.
-
-\begin{alltt}
-BIN: 101 BIN: 10 bitor .b
-\emph{111}
-BIN: 110 BIN: 10 bitor .b
-\emph{110}
-\end{alltt}
-
-\texttt{bitxor ( x y -{}- x\^{}y )} returns a new integer where each bit is set if and only if the corresponding bit is set in exactly one of $x$ or $y$. If you're considering an integer as a sequence of bit flags, taking the bitwise-xor with a mask toggles on all flags that are set in the mask.
-
-\begin{alltt}
-BIN: 101 BIN: 10 bitxor .b
-\emph{111}
-BIN: 110 BIN: 10 bitxor .b
-\emph{100}
-\end{alltt}
-
-\texttt{shift ( x n -{}- y )} returns a new integer consisting of the bits of the first integer, shifted to the left by $n$ positions. If $n$ is negative, the bits are shifted to the right instead, and bits that ``fall off'' are discarded.
-
-\begin{alltt}
-BIN: 101 5 shift .b
-\emph{10100000}
-BIN: 11111 -2 shift .b
-\emph{111}
-\end{alltt}
-
-The attentive reader will notice that shifting to the left is equivalent to multiplying by a power of two, and shifting to the right is equivalent to performing a truncating division by a power of two.
-
-\section{PRACTICAL: Numbers game}
-
-In this section, basic input/output and flow control is introduced.
-We construct a program that repeatedly prompts the user to guess a
-number -- they are informed if their guess is correct, too low, or
-too high. The game ends on a correct guess.
-
-\begin{alltt}
-numbers-game
-\emph{I'm thinking of a number between 0 and 100.}
-\emph{Enter your guess:} 25
-\emph{Too low}
-\emph{Enter your guess:} 38
-\emph{Too high}
-\emph{Enter your guess:} 31
-\emph{Correct - you win!}
-\end{alltt}
-
-\subsection{Getting started}
-
-Start a text editor and create a file named \texttt{numbers-game.factor}.
-
-Write a short comment at the top of the file. Two examples of commenting style supported by Factor:
-
-\begin{alltt}
-! Numbers game.
-( The great numbers game )
-\end{alltt}
-
-It is always a good idea to comment your code. Try to write simple
-code that does not need detailed comments to describe; similarly,
-avoid redundant comments. These two principles are hard to quantify
-in a concrete way, and will become more clear as your skills with
-Factor increase.
-
-We will be defining new words in the \texttt{numbers-game} vocabulary; add
-an \texttt{IN:} statement at the top of the source file:
-
-\begin{alltt}
-IN: numbers-game
-\end{alltt}
-Also in order to be able to test the words, issue a \texttt{USE:}
-statement in the interactive interpreter:
-
-\begin{alltt}
-USE: numbers-game
-\end{alltt}
-This section will develop the numbers game in an incremental fashion.
-After each addition, issue a command like the following to load the
-source file into the Factor interpreter:
-
-\begin{alltt}
-"numbers-game.factor" run-file
-\end{alltt}
-
-\subsection{Reading a number from the keyboard}
-
-A fundamental operation required for the numbers game is to be able
-to read a number from the keyboard. The \texttt{read} word \texttt{(
--{}- str )} reads a line of input and pushes it on the stack.
-The \texttt{parse-number} word \texttt{( str -{}- n )} turns a decimal
-string representation of an integer into the integer itself. These
-two words can be combined into a single colon definition:
-
-\begin{alltt}
-: read-number ( -{}- n ) read parse-number ;
-\end{alltt}
-You should add this definition to the source file, and try loading
-the file into the interpreter. As you will soon see, this raises an
-error! The problem is that the two words \texttt{read} and \texttt{parse-number}
-are not part of the default, minimal, vocabulary search path used
-when reading files. The solution is to use \texttt{apropos.} to find
-out which vocabularies contain those words, and add the appropriate
-\texttt{USE:} statements to the source file:
-
-\begin{alltt}
-USE: parser
-USE: stdio
-\end{alltt}
-After adding the above two statements, the file should now parse,
-and testing should confirm that the \texttt{read-number} word works correctly.%
-\footnote{There is the possibility of an invalid number being entered at the
-keyboard. In this case, \texttt{parse-number} returns \texttt{f},
-the boolean false value. For the sake of simplicity, we ignore this
-case in the numbers game example. However, proper error handling is
-an essential part of any large program and is covered later.%
-}
-
-
-\subsection{Printing some messages}
-
-Now we need to make some words for printing various messages. They
-are given here without further ado:
-
-\begin{alltt}
-: 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 ;
-\end{alltt}
-Note that in the above, stack effect comments are omitted, since they
-are obvious from context. You should ensure the words work correctly
-after loading the source file into the interpreter.
-
-
-\subsection{Taking action based on a guess}
-
-The next logical step is to write a word \texttt{judge-guess} that
-takes the user's guess along with the actual number to be guessed,
-and prints one of the messages \texttt{too-high}, \texttt{too-low},
-or \texttt{correct}. This word will also push a boolean flag, indicating
-if the game should continue or not -- in the case of a correct guess,
-the game does not continue.
-
-This description of judge-guess is a mouthful -- and it suggests that
-it may be best to split it into two words. The first word we write
-handles the more specific case of an \emph{inexact} guess -- so it
-prints either \texttt{too-low} or \texttt{too-high}.
-
-\begin{alltt}
-: inexact-guess ( actual guess -{}- )
- < {[} too-high {]} {[} too-low {]} ifte ;
-\end{alltt}
-Note that the word gives incorrect output if the two parameters are
-equal. However, it will never be called this way.
-
-With this out of the way, the implementation of judge-guess is an
-easy task to tackle. Using the words \texttt{inexact-guess}, \texttt{2dup}, \texttt{2drop} and \texttt{=}, we can write:
-
-\begin{alltt}
-: judge-guess ( actual guess -{}- ? )
- 2dup = {[}
- 2drop correct f
- {]} {[}
- inexact-guess t
- {]} ifte ;
-\end{alltt}
-
-The word \texttt{=} is found in the \texttt{kernel} vocabulary, and the words \texttt{2dup} and \texttt{2drop} are found in the \texttt{stack} vocabulary. Since \texttt{=}
-consumes both its inputs, we must first duplicate the \texttt{actual} and \texttt{guess} parameters using \texttt{2dup}. The word \texttt{correct} does not need to do anything with these two numbers, so they are popped off the stack using \texttt{2drop}. Try evaluating the following
-in the interpreter to see what's going on:
+\texttt{\^{} ( x y -- x\^{}y )} raises \texttt{x} to the power of \texttt{y}. In the cases of \texttt{y} being equal to $1/2$, -1, or 2, respectively, the words \texttt{sqrt}, \texttt{recip} and \texttt{sq} can be used instead.
\begin{alltt}
-clear 1 2 2dup = .s
-\emph{\{ 1 2 f \}}
-clear 4 4 2dup = .s
-\emph{\{ 4 4 t \}}
+2 4 \^ .
+\emph{16.0}
+i i \^ .
+\emph{0.2078795763507619}
\end{alltt}
-Test \texttt{judge-guess} with a few inputs:
+All remaining functions have a stack effect \texttt{( x -{}- y )}, it won't be repeated for brevity.
+
+\texttt{exp} raises the number $e$ to a specified power. The number $e$ can be pushed on the stack with the \texttt{e} word, so \texttt{exp} could have been defined as follows:
\begin{alltt}
-1 10 judge-guess .
-\emph{Too low}
-\emph{t}
-89 43 judge-guess .
-\emph{Too high}
-\emph{t}
-64 64 judge-guess .
-\emph{Correct}
-\emph{f}
+: exp ( x -- e^x ) e swap \^ ;
\end{alltt}
-\subsection{Generating random numbers}
+However, it is actually defined otherwise, for efficiency.\footnote{In fact, the word \texttt{\^{}} is actually defined in terms of \texttt{exp}, to correctly handle complex number arguments.}
-The \texttt{random-int} word \texttt{( min max -{}- n )} pushes a
-random number in a specified range. The range is inclusive, so both
-the minimum and maximum indexes are candidate random numbers. Use
-\texttt{apropos.} to determine that this word is in the \texttt{random}
-vocabulary. For the purposes of this game, random numbers will be
-in the range of 0 to 100, so we can define a word that generates a
-random number in the range of 0 to 100:
+\texttt{log} computes the natural (base $e$) logarithm. This is the inverse of the \texttt{exp} function.
\begin{alltt}
-: number-to-guess ( -{}- n ) 0 100 random-int ;
+-1 log .
+\emph{\#\{ 0.0 3.141592653589793 \}}
+e log .
+\emph{1.0}
\end{alltt}
-Add the word definition to the source file, along with the appropriate
-\texttt{USE:} statement. Load the source file in the interpreter,
-and confirm that the word functions correctly, and that its stack
-effect comment is accurate.
+\texttt{sin}, \texttt{cos} and \texttt{tan} are the familiar trigonometric functions, and \texttt{asin}, \texttt{acos} and \texttt{atan} are their inverses.
-\subsection{The game loop}
+The reciprocals of the sine, cosine and tangent are defined as \texttt{sec}, \texttt{cosec} and \texttt{cot}, respectively. Their inverses are \texttt{asec}, \texttt{acosec} and \texttt{acot}.
-The game loop consists of repeated calls to \texttt{guess-prompt},
-\texttt{read-number} and \texttt{judge-guess}. If \texttt{judge-guess}
-returns \texttt{f}, the loop stops, otherwise it continues. This is
-realized with a recursive implementation:
+\texttt{sinh}, \texttt{cosh} and \texttt{tanh} are the hyperbolic functions, and \texttt{asinh}, \texttt{acosh} and \texttt{atanh} are their inverses.
+
+Similarly, the reciprocals of the hyperbolic functions are defined as \texttt{sech}, \texttt{cosech} and \texttt{coth}, respectively. Their inverses are \texttt{asech}, \texttt{acosech} and \texttt{acoth}.
+
+\subsection{Modular arithmetic}
+
+In addition to the standard division operator \texttt{/}, there are a few related functions that are useful when working with integers.
+
+\texttt{/i ( x y -{}- x/y )} performs a truncating integer division. It could have been defined as follows:
\begin{alltt}
-: numbers-game-loop ( actual -{}- )
- dup guess-prompt read-number judge-guess {[}
- numbers-game-loop
- {]} {[}
- drop
- {]} ifte ;
+: /i / >integer ;
\end{alltt}
-In Factor, tail-recursive words consume a bounded amount of call stack
-space. This means you are free to pick recursion or iteration based
-on their own merits when solving a problem. In many other languages,
-the usefulness of recursion is severely limited by the lack of tail-recursive
-call optimization.
+However, the actual definition is a bit more efficient than that.
-\subsection{Finishing off}
+\texttt{mod ( x y -{}- x\%y )} computes the remainder of dividing \texttt{x} by \texttt{y}. If the result is 0, then \texttt{x} is a multiple of \texttt{y}.
-The last task is to combine everything into the main \texttt{numbers-game}
-word. This is easier than it seems:
+\texttt{/mod ( x y -{}- x/y x\%y )} pushes both the quotient and remainder.
\begin{alltt}
-: numbers-game number-to-guess numbers-game-loop ;
+100 3 mod .
+\emph{1}
+-546 34 mod .
+\emph{-2}
\end{alltt}
-Try it out! Simply invoke the \texttt{numbers-game} word in the interpreter.
-It should work flawlessly, assuming you tested each component of this
-design incrementally!
+\texttt{gcd ( x y -{}- z )} pushes the greatest common divisor of two integers; that is, the largest number that both integers could be divided by and still yield integers as results. This word is used behind the scenes to reduce rational numbers to lowest terms when doing ratio arithmetic.
-\subsection{The complete program}
+\subsection{Bitwise operations}
-\begin{verbatim}
-! Numbers game example
+There are two ways of looking at an integer -- as a mathematical entity, or as a string of bits. The latter representation faciliates the so-called \emph{bitwise operations}.
-IN: numbers-game
-USE: kernel
-USE: math
-USE: parser
-USE: random
-USE: stdio
-USE: stack
+\texttt{bitand ( x y -{}- x\&y )} returns a new integer where each bit is set if and only if the corresponding bit is set in both $x$ and $y$. If you're considering an integer as a sequence of bit flags, taking the bitwise-and with a mask switches off all flags that are not explicitly set in the mask.
-: read-number ( -- n ) read parse-number ;
+\begin{alltt}
+BIN: 101 BIN: 10 bitand .b
+\emph{0}
+BIN: 110 BIN: 10 bitand .b
+\emph{10}
+\end{alltt}
-: 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 ;
+\texttt{bitor ( x y -{}- x|y )} returns a new integer where each bit is set if and only if the corresponding bit is set in at least one of $x$ or $y$. If you're considering an integer as a sequence of bit flags, taking the bitwise-or with a mask switches on all flags that are set in the mask.
-: inexact-guess ( actual guess -- )
- < [ too-high ] [ too-low ] ifte ;
+\begin{alltt}
+BIN: 101 BIN: 10 bitor .b
+\emph{111}
+BIN: 110 BIN: 10 bitor .b
+\emph{110}
+\end{alltt}
-: judge-guess ( actual guess -- ? )
- 2dup = [
- 2drop correct f
- ] [
- inexact-guess t
- ] ifte ;
+\texttt{bitxor ( x y -{}- x\^{}y )} returns a new integer where each bit is set if and only if the corresponding bit is set in exactly one of $x$ or $y$. If you're considering an integer as a sequence of bit flags, taking the bitwise-xor with a mask toggles on all flags that are set in the mask.
-: number-to-guess ( -- n ) 0 100 random-int ;
+\begin{alltt}
+BIN: 101 BIN: 10 bitxor .b
+\emph{111}
+BIN: 110 BIN: 10 bitxor .b
+\emph{100}
+\end{alltt}
-: numbers-game-loop ( actual -- )
- dup guess-prompt read-number judge-guess [
- numbers-game-loop
- ] [
- drop
- ] ifte ;
+\texttt{shift ( x n -{}- y )} returns a new integer consisting of the bits of the first integer, shifted to the left by $n$ positions. If $n$ is negative, the bits are shifted to the right instead, and bits that ``fall off'' are discarded.
-: numbers-game number-to-guess numbers-game-loop ;
-\end{verbatim}
+\begin{alltt}
+BIN: 101 5 shift .b
+\emph{10100000}
+BIN: 11111 -2 shift .b
+\emph{111}
+\end{alltt}
+
+The attentive reader will notice that shifting to the left is equivalent to multiplying by a power of two, and shifting to the right is equivalent to performing a truncating division by a power of two.
\section{Sequences}
List manipulation words usually return newly-created
lists only. The original parameters are not modified. This may seem
inefficient, however the absence of side effects makes code much easier
-to test and debug.%
-\footnote{Side effect-free code is the fundamental idea underlying functional
-programming languages.
+to test and debug.
\texttt{append ( list list -{}- list )} Append two lists at the
top of the stack:
Essentially, the interpreter iterates through code quotations, pushing literals and executing words. When a word is executed, one of two things happen -- either the word has a colon definition, and the interpreter is invoked recursively on the definition, or the word is primitive, and it is executed by the underlying virtual machine.
+\subsection{Booleans and logic}
+
+Words that return a boolean truth value are known as \emph{predicates}. Predicates are usually used to decide what to execute next at branch points. In Factor, there is no special boolean data type
+-- instead, a special object \texttt{f} is the only object with a
+``false'' boolean value. Every other object is a boolean ``true''.
+The special object \texttt{t} is the ``canonical'' truth value. Note that words that return booleans don't return \texttt{t} as a rule; any object that is not equal to \texttt{f} can be returned as the true value.
+
+The usual boolean operations are found in the \texttt{logic} vocabulary. Note that these are not integer bitwise operations; bitwise operations are described in the next chapter.
+
+\texttt{not ( ?~-{}- ?~)} returns \texttt{t} if the top of stack is \texttt{f}, and \texttt{f} otherwise.
+
+\texttt{and ( ?~?~-{}- ?~)} returns a true value if both input parameters are true.
+
+\texttt{or ( ?~?~-{}- ?~)} returns a true value if at least one of the input parameters is true.
+
+\texttt{xor ( ?~?~-{}- ?~)} returns a true value if exactly one of the input parameters is true.
+
+\begin{alltt}
+t t and .
+\emph{t}
+5 f and .
+\emph{f}
+f "hi" or .
+\emph{"hi"}
+f f or .
+\emph{f}
+t t xor .
+\emph{f}
+t f xor .
+\emph{t}
+\end{alltt}
+
+\texttt{?~( cond~true false -{}- obj~)} returns the second argument if the first argument is true, and returns the third argument if the first argument is false.
+
+\begin{alltt}
+: sgn 0 < -1 1 ? ;
+-10 sgn .
+\emph{-1}
+5 sgn .
+\emph{1}
+\end{alltt}
+
+\subsection{\label{sub:Conditionals}Conditionals}
+
+The \texttt{ifte} combinator was already glossed over and hand-waved in the numbers game example. Now, we will take a closer look at \texttt{ifte} and related forms.
+
+\texttt{ifte} \texttt{( cond true false -{}- )} executes either the
+\texttt{true} or \texttt{false} quotations, depending on the boolean
+value of \texttt{cond}. The condition is removed from the stack before one of the two quotations is executed; if it is required as a parameter to a word called by one of the quotations, it must be duplicated first.
+
+A quotation a list of objects that can be executed. Quotations are input
+using the following syntax:
+
+\begin{alltt}
+{[} 2 3 + . {]}
+\end{alltt}
+
+Here is an example of \texttt{ifte} usage:
+
+\begin{alltt}
+1 2 < {[} "1 is less than 2." print {]} {[} "bug!" print {]} ifte
+\end{alltt}
+
+Compare the order of parameters here with the order of parameters in
+the stack effect of \texttt{ifte}.
+
+The stack effects of the two \texttt{ifte} branches should be
+the same. If they differ, the word becomes harder to document and
+debug.
+
+Two minor variations are \texttt{when} \texttt{( cond true -{}- )} and \texttt{unless} \texttt{( cond false -{}- )}. They only have one branch; the other branch is a no-op. The branch should produce as many values as they consume; this ensures that the stack effect of the entire \texttt{when} or \texttt{unless} expression is consistent regardless of which branch was taken.
+
+The following definition pushes the first element of a list if the top of the stack is a list, otherwise it leaves it intact:
+
+\begin{verbatim}
+: first ( obj -- obj )
+ dup cons? [ car ] when ;
+\end{verbatim}
+
+Note that regardless of the value at the top of the stack, the stack height is consistent at the end of the \texttt{when} expression, since \texttt{car} produces as many values as it consumes.
+
+Because the \texttt{ifte} combinator considers any value not equal to \texttt{f} to be true, it is often the case that the same object that was used as the condition is needed for further processing. One solution is to \texttt{dup} the object, so that it is on the stack for the ``true'' branch to use. However, usually the ``false'' branch does not need the extra \texttt{f} on the stack, so it has to \texttt{drop}. This pattern is very common; here is the general shape of the code:
+
+\begin{verbatim}
+dup [
+ do-something
+] [
+ drop handle-failure
+] ifte
+\end{verbatim}
+
+In fact, this pattern is so common that it is embodied by the \texttt{ifte*} combinator. Using \texttt{ifte*}, one would write the above code as follows:
+
+\begin{verbatim}
+[
+ do-something
+] [
+ handle-failure
+] ifte*
+\end{verbatim}
+
+An example of \texttt{ifte*} use can be found in the definition of the \texttt{list?} word. If the top of the stack is not \texttt{f}, further processing needs to be performed; if it is \texttt{f}, it can be discarded, and \texttt{t} must be pushed on the stack, since \texttt{f} is the empty list:
+
+\begin{verbatim}
+: list? ( list -- boolean )
+ #! Proper list test. A proper list is either f, or a cons
+ #! cell whose cdr is a proper list.
+ [
+ dup cons? [ cdr list? ] [ drop f ] ifte
+ ] [
+ t
+ ] ifte* ;
+\end{verbatim}
+
+Similarly, there is a \texttt{when*} combinator, with only one branch. A code snippet to print the top of the stack if it is not \texttt{f} might look as follows:
+
+\begin{verbatim}
+[ . ] when*
+\end{verbatim}
+
+It is equivalent to either of the following two lines:
+
+\begin{verbatim}
+[ . ] [ ] ifte*
+dup [ . ] [ drop ] ifte
+\end{verbatim}
+
+The \texttt{unless*} combinator provides a convinient way to place another value on the stack if the top of the stack is \texttt{f}, and leave the stack intact otherwise. The \texttt{mime-type} word uses it to provide a default value in case an association list lookup fails:
+
+\begin{verbatim}
+: mime-type ( filename -- mime-type )
+ file-extension mime-types assoc [ "text/plain" ] unless* ;
+\end{verbatim}
+
+If \texttt{unless*} was not available, the above word could be written as
+follows:
+
+\begin{verbatim}
+: mime-type ( filename -- mime-type )
+ file-extension mime-types assoc dup [
+ drop "text/plain"
+ ] unless ;
+\end{verbatim}
+
\subsection{The call stack}
So far, we have seen what we called ``the stack'' store intermediate values between computations. In fact Factor maintains a number of other stacks, and the formal name for the stack we've been dealing with so far is the \emph{data stack}.
Basically, the rule is you must leave the call stack in the same state as you found it so that when the current quotation finishes executing, the interpreter can continue executing without seeing your data on the call stack.
+One exception is that when \texttt{ifte} occurs as the last word in a definition, values may be pushed on the call stack before the condition value is computed, as long as both branches of the \texttt{ifte} pop the values off the callstack before returning.
+
\subsection{Recursion}
The idea of \emph{recursion} is key to understanding Factor. A \emph{recursive} word definition is one that refers to itself, usually in one branch of a conditional. The general form of a recursive word looks as follows:
\texttt{set-hash ( value key hash -{}- )} stores a key/value pair in a hashtable.
-examples, and hash>alist, alist>hash, hash-keys, hash-values
+Hashtables can be converted to association lists and vice versa using
+the \texttt{hash>alist} and \texttt{alist>hash} words. The list of keys and
+list of values can be extracted using the \texttt{hash-keys} and \texttt{hash-values} words.
+
+examples
\subsection{Variables}
<DOCKABLES>
<DOCKABLE NAME="factor">
- new factor.listener.FactorListenerPanel(
+ new factor.jedit.FactorListenerPanel(
factor.jedit.FactorPlugin.getInterpreter());
</DOCKABLE>
</DOCKABLES>
--- /dev/null
+/* :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.Cons;
+import java.util.EventListener;
+
+public interface EvalListener extends EventListener
+{
+ public void eval(Cons code);
+}
--- /dev/null
+/* :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 java.awt.*;
+import java.awt.event.*;
+import javax.swing.*;
+import javax.swing.event.*;
+import javax.swing.text.*;
+
+public class FactorListener extends JTextPane
+{
+ private static final Cursor MoveCursor
+ = Cursor.getPredefinedCursor
+ (Cursor.HAND_CURSOR);
+ private static final Cursor DefaultCursor
+ = Cursor.getPredefinedCursor
+ (Cursor.TEXT_CURSOR);
+ private static final Cursor WaitCursor
+ = Cursor.getPredefinedCursor
+ (Cursor.WAIT_CURSOR);
+
+ public static final Object Input = new Object();
+ public static final Object Actions = new Object();
+
+ private EventListenerList listenerList;
+
+ private Cons readLineContinuation;
+ private int cmdStart = -1;
+ private ListenerHistoryText history;
+
+ //{{{ FactorListener constructor
+ public FactorListener()
+ {
+ MouseHandler mouse = new MouseHandler();
+ addMouseListener(mouse);
+ addMouseMotionListener(mouse);
+
+ history = new ListenerHistoryText(this,"factor");
+
+ listenerList = new EventListenerList();
+
+ InputMap inputMap = getInputMap();
+
+ /* Press enter to evaluate the input */
+ inputMap.put(KeyStroke.getKeyStroke(KeyEvent.VK_ENTER,0),
+ new EnterAction());
+
+ /* Press backspace to stop backspacing over the prompt */
+ inputMap.put(KeyStroke.getKeyStroke('\b'),
+ new BackspaceAction());
+
+ inputMap.put(KeyStroke.getKeyStroke(KeyEvent.VK_HOME,0),
+ new HomeAction());
+
+ /* Press Up/Down to access history */
+ inputMap.put(KeyStroke.getKeyStroke(KeyEvent.VK_UP,0),
+ new HistoryUpAction());
+
+ inputMap.put(KeyStroke.getKeyStroke(KeyEvent.VK_DOWN,0),
+ new HistoryDownAction());
+
+ /* Workaround */
+ inputMap.put(KeyStroke.getKeyStroke(KeyEvent.VK_BACK_SPACE,0),
+ new DummyAction());
+
+ getDocument().addDocumentListener(new DocumentHandler());
+ } //}}}
+
+ //{{{ insertWithAttrs() method
+ public void insertWithAttrs(String text, AttributeSet attrs)
+ throws BadLocationException
+ {
+ if(text == null)
+ throw new NullPointerException();
+
+ StyledDocument doc = (StyledDocument)getDocument();
+ int offset1 = doc.getLength();
+ doc.insertString(offset1,text,null);
+ int offset2 = offset1 + text.length();
+ doc.setCharacterAttributes(offset1,offset2,attrs,true);
+ setCaretPosition(offset2);
+ } //}}}
+
+ //{{{ readLine() method
+ public void readLine(Cons continuation)
+ throws BadLocationException
+ {
+ StyledDocument doc = (StyledDocument)getDocument();
+ cmdStart = doc.getLength();
+ setCursor(DefaultCursor);
+ this.readLineContinuation = continuation;
+ setCaretPosition(cmdStart);
+ } //}}}
+
+ //{{{ addEvalListener() method
+ public void addEvalListener(EvalListener l)
+ {
+ listenerList.add(EvalListener.class,l);
+ } //}}}
+
+ //{{{ removeEvalListener() method
+ public void removeEvalListener(EvalListener l)
+ {
+ listenerList.remove(EvalListener.class,l);
+ } //}}}
+
+ //{{{ eval() method
+ public void eval(String eval)
+ {
+ if(eval == null)
+ return;
+
+ try
+ {
+ StyledDocument doc = (StyledDocument)getDocument();
+ setCaretPosition(doc.getLength());
+ doc.insertString(doc.getLength(),eval + "\n",
+ getCharacterAttributes());
+ }
+ catch(BadLocationException ble)
+ {
+ ble.printStackTrace();
+ }
+ fireEvalEvent(eval);
+ } //}}}
+
+ //{{{ fireEvalEvent() method
+ public void fireEvalEvent(String code)
+ {
+ setCursor(WaitCursor);
+
+ Cons quot = new Cons(code,readLineContinuation);
+ //readLineContinuation = null;
+
+ Object[] listeners = listenerList.getListenerList();
+ for(int i = 0; i < listeners.length; i++)
+ {
+ if(listeners[i] == EvalListener.class)
+ {
+ EvalListener l = (EvalListener)listeners[i+1];
+ l.eval(quot);
+ }
+ }
+ } //}}}
+
+ //{{{ getAttributes() method
+ private AttributeSet getAttributes(int pos)
+ {
+ StyledDocument doc = (StyledDocument)getDocument();
+ Element e = doc.getCharacterElement(pos);
+ return e.getAttributes();
+ } //}}}
+
+ //{{{ getActions() method
+ private Cons getActions(int pos)
+ {
+ AttributeSet a = getAttributes(pos);
+ if(a == null)
+ return null;
+ else
+ return (Cons)a.getAttribute(Actions);
+ } //}}}
+
+ //{{{ getActionsPopup() method
+ private JPopupMenu getActionsPopup(int pos)
+ {
+ Cons actions = getActions(pos);
+ if(actions == null)
+ return null;
+
+ JPopupMenu popup = new JPopupMenu();
+ while(actions != null)
+ {
+ Cons action = (Cons)actions.car;
+ JMenuItem item = new JMenuItem((String)action.cdr);
+ item.setActionCommand((String)action.car);
+ item.addActionListener(new EvalAction());
+ popup.add(item);
+ actions = actions.next();
+ }
+
+ return popup;
+ } //}}}
+
+ //{{{ showPopupMenu() method
+ private void showPopupMenu(int pos)
+ {
+ JPopupMenu actions = getActionsPopup(pos);
+ if(actions == null)
+ return;
+
+ try
+ {
+ StyledDocument doc = (StyledDocument)getDocument();
+ Element e = doc.getCharacterElement(pos);
+ Point pt = modelToView(e.getStartOffset())
+ .getLocation();
+ FontMetrics fm = getFontMetrics(getFont());
+
+ actions.show(this,pt.x,pt.y + fm.getHeight());
+ }
+ catch(Exception e)
+ {
+ e.printStackTrace();
+ }
+ } //}}}
+
+ //{{{ getInput() method
+ public String getInput()
+ {
+ try
+ {
+ Document doc = getDocument();
+ String line = doc.getText(cmdStart,doc.getLength() - cmdStart);
+ if(line.endsWith("\n"))
+ return line.substring(0,line.length() - 1);
+ else
+ return line;
+ }
+ catch(BadLocationException e)
+ {
+ throw new RuntimeException(e);
+ }
+ } //}}}
+
+ //{{{ setInput() method
+ public void setInput(String line)
+ {
+ System.err.println("Set input: " + line + ", " + cmdStart);
+ try
+ {
+ Document doc = getDocument();
+ doc.remove(cmdStart,doc.getLength() - cmdStart);
+ doc.insertString(cmdStart,line,null);
+ }
+ catch(BadLocationException e)
+ {
+ throw new RuntimeException(e);
+ }
+ } //}}}
+
+ /**
+ * Subclasses can override this to provide funky history behavior,
+ * for JTextPanes and such.
+ */
+ public int getInputStart()
+ {
+ return cmdStart;
+ }
+
+ //{{{ MouseHandler class
+ class MouseHandler extends MouseInputAdapter
+ {
+ public void mousePressed(MouseEvent e)
+ {
+ Point pt = new Point(e.getX(), e.getY());
+ int pos = viewToModel(pt);
+ if(pos >= 0)
+ showPopupMenu(pos);
+ }
+
+ public void mouseMoved(MouseEvent e)
+ {
+ Point pt = new Point(e.getX(), e.getY());
+ int pos = viewToModel(pt);
+ if(pos >= 0)
+ {
+ Cursor cursor;
+ if(getActions(pos) != null)
+ cursor = MoveCursor;
+ else
+ cursor = DefaultCursor;
+
+ if(getCursor() != cursor)
+ setCursor(cursor);
+ }
+ }
+ } //}}}
+
+ //{{{ EvalAction class
+ class EvalAction extends AbstractAction
+ {
+ public void actionPerformed(ActionEvent evt)
+ {
+ eval(evt.getActionCommand());
+ }
+ } //}}}
+
+ //{{{ EnterAction class
+ class EnterAction extends AbstractAction
+ {
+ public void actionPerformed(ActionEvent evt)
+ {
+ setCaretPosition(getDocument().getLength());
+ replaceSelection("\n");
+
+ history.addCurrentToHistory();
+ history.setIndex(-1);
+ fireEvalEvent(getInput());
+ }
+ } //}}}
+
+ //{{{ BackspaceAction class
+ class BackspaceAction extends AbstractAction
+ {
+ public void actionPerformed(ActionEvent evt)
+ {
+ if(getSelectionStart() != getSelectionEnd())
+ {
+ replaceSelection("");
+ return;
+ }
+
+ int caret = getCaretPosition();
+ if(caret == cmdStart)
+ {
+ getToolkit().beep();
+ return;
+ }
+
+ try
+ {
+ getDocument().remove(caret - 1,1);
+ }
+ catch(BadLocationException e)
+ {
+ e.printStackTrace();
+ }
+ }
+ } //}}}
+
+ //{{{ HomeAction class
+ class HomeAction extends AbstractAction
+ {
+ public void actionPerformed(ActionEvent evt)
+ {
+ setCaretPosition(cmdStart);
+ }
+ } //}}}
+
+ //{{{ HistoryUpAction class
+ class HistoryUpAction extends AbstractAction
+ {
+ public void actionPerformed(ActionEvent evt)
+ {
+ history.historyPrevious();
+ }
+ } //}}}
+
+ //{{{ HistoryDownAction class
+ class HistoryDownAction extends AbstractAction
+ {
+ public void actionPerformed(ActionEvent evt)
+ {
+ history.historyNext();
+ }
+ } //}}}
+
+ //{{{ DummyAction class
+ class DummyAction extends AbstractAction
+ {
+ public void actionPerformed(ActionEvent evt)
+ {
+ }
+ } //}}}
+
+ //{{{ DocumentHandler class
+ class DocumentHandler implements DocumentListener
+ {
+ public void insertUpdate(DocumentEvent e)
+ {
+ int offset = e.getOffset();
+ int length = e.getLength();
+
+ if(offset < cmdStart)
+ cmdStart += length;
+ }
+
+ public void removeUpdate(DocumentEvent e)
+ {
+ int offset = e.getOffset();
+ int length = e.getLength();
+
+ if(offset < cmdStart)
+ {
+ if(offset + length > cmdStart)
+ cmdStart = offset;
+ else
+ cmdStart -= length;
+ }
+ }
+
+ public void changedUpdate(DocumentEvent e) {}
+ } //}}}
+}
--- /dev/null
+/* :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 java.awt.*;
+import java.awt.event.*;
+import java.util.*;
+import javax.swing.*;
+import javax.swing.text.*;
+import javax.swing.text.html.*;
+
+public class FactorListenerPanel extends JPanel
+{
+ private FactorInterpreter interp;
+ private FactorListener listener;
+
+ //{{{ newInterpreter() method
+ public static FactorInterpreter newInterpreter(String[] args)
+ {
+ try
+ {
+ FactorInterpreter interp = new FactorInterpreter();
+ interp.interactive = false;
+ interp.init(args);
+ return interp;
+ }
+ catch(Exception e)
+ {
+ System.err.println("Failed to initialize interpreter:");
+ e.printStackTrace();
+ return null;
+ }
+ } //}}}
+
+ //{{{ FactorListenerPanel constructor
+ public FactorListenerPanel(FactorInterpreter interp)
+ {
+ setLayout(new BorderLayout());
+
+ this.interp = interp;
+
+ add(BorderLayout.CENTER,new JScrollPane(
+ listener = newListener()));
+ } //}}}
+
+ //{{{ getListener() method
+ public FactorListener getListener()
+ {
+ return listener;
+ } //}}}
+
+ //{{{ newListener() method
+ private FactorListener newListener()
+ {
+ final FactorListener listener = new FactorListener();
+ listener.addEvalListener(new EvalHandler());
+
+ eval(new Cons(listener,
+ new Cons(interp.searchVocabulary(
+ "listener","new-listener-hook"),
+ null)));
+
+ return listener;
+ } //}}}
+
+ //{{{ requestDefaultFocus() method
+ public boolean requestDefaultFocus()
+ {
+ listener.requestFocus();
+ return true;
+ } //}}}
+
+ //{{{ getInterpreter() method
+ public FactorInterpreter getInterpreter()
+ {
+ return interp;
+ } //}}}
+
+ //{{{ eval() method
+ private void eval(Cons cmd)
+ {
+ try
+ {
+ interp.call(cmd);
+ interp.run();
+ }
+ catch(Exception e)
+ {
+ System.err.println("Failed to eval " + cmd + ":");
+ e.printStackTrace();
+ }
+ } //}}}
+
+ //{{{ EvalHandler class
+ class EvalHandler implements EvalListener
+ {
+ public void eval(Cons cmd)
+ {
+ FactorListenerPanel.this.eval(cmd);
+ }
+ } //}}}
+}
package factor.jedit;
-import factor.listener.FactorListenerPanel;
import factor.*;
import java.io.InputStreamReader;
import java.util.*;
plugin.factor.jedit.FactorPlugin.activate=startup
plugin.factor.jedit.FactorPlugin.name=Factor
-plugin.factor.jedit.FactorPlugin.version=0.66
+plugin.factor.jedit.FactorPlugin.version=0.68
plugin.factor.jedit.FactorPlugin.author=Slava Pestov
plugin.factor.jedit.FactorPlugin.docs=/doc/jedit/index.html
-plugin.factor.jedit.FactorPlugin.depend.0=jedit 04.02.15.00
+plugin.factor.jedit.FactorPlugin.depend.0=jedit 04.03.01.00
plugin.factor.jedit.FactorPlugin.depend.1=plugin errorlist.ErrorListPlugin 1.3.2
plugin.factor.jedit.FactorPlugin.depend.2=plugin sidekick.SideKickPlugin 0.3.1
--- /dev/null
+/* :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 javax.swing.text.JTextComponent;
+import org.gjt.sp.jedit.gui.HistoryText;
+
+public class ListenerHistoryText extends HistoryText
+{
+ private FactorListener listener;
+
+ public ListenerHistoryText(FactorListener listener, String model)
+ {
+ super(listener,model);
+ this.listener = listener;
+ }
+
+ public int getInputStart()
+ {
+ return listener.getInputStart();
+ }
+
+ public String getText()
+ {
+ return listener.getInput();
+ }
+
+ public void setText(String text)
+ {
+ setIndex(-1);
+ listener.setInput(text);
+ }
+}
+++ /dev/null
-/* :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.listener;
-
-import factor.Cons;
-import java.util.EventListener;
-
-public interface EvalListener extends EventListener
-{
- public void eval(Cons code);
-}
+++ /dev/null
-/* :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.listener;
-
-import factor.*;
-import java.awt.*;
-import java.awt.event.*;
-import java.util.*;
-import javax.swing.*;
-import javax.swing.text.*;
-import javax.swing.text.html.*;
-
-public class FactorDesktop extends JFrame
-{
- //{{{ main() method
- public static void main(final String[] args)
- {
- SwingUtilities.invokeLater(new Runnable()
- {
- public void run()
- {
- new FactorDesktop(args,true);
- }
- });
- } //}}}
-
- //{{{ FactorDesktop constructor
- public FactorDesktop(String[] args, boolean standalone)
- {
- super("Factor");
-
- getContentPane().add(BorderLayout.CENTER,
- new FactorListenerPanel(
- FactorListenerPanel.newInterpreter(args)));
-
- setSize(640,480);
- setDefaultCloseOperation(standalone
- ? EXIT_ON_CLOSE
- : DISPOSE_ON_CLOSE);
- show();
- } //}}}
-}
+++ /dev/null
-/* :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.listener;
-
-import factor.*;
-import java.awt.*;
-import java.awt.event.*;
-import javax.swing.*;
-import javax.swing.event.*;
-import javax.swing.text.*;
-
-public class FactorListener extends JTextPane
-{
- private static final Cursor MoveCursor
- = Cursor.getPredefinedCursor
- (Cursor.HAND_CURSOR);
- private static final Cursor DefaultCursor
- = Cursor.getPredefinedCursor
- (Cursor.TEXT_CURSOR);
- private static final Cursor WaitCursor
- = Cursor.getPredefinedCursor
- (Cursor.WAIT_CURSOR);
-
- public static final Object Input = new Object();
- public static final Object Actions = new Object();
-
- private EventListenerList listenerList;
-
- private Cons readLineContinuation;
- private int cmdStart = -1;
-
- //{{{ FactorListener constructor
- public FactorListener()
- {
- MouseHandler mouse = new MouseHandler();
- addMouseListener(mouse);
- addMouseMotionListener(mouse);
-
- listenerList = new EventListenerList();
-
- InputMap inputMap = getInputMap();
-
- /* Replace enter to evaluate the input */
- inputMap.put(KeyStroke.getKeyStroke(KeyEvent.VK_ENTER,0),
- new EnterAction());
-
- /* Replace backspace to stop backspacing over the prompt */
- inputMap.put(KeyStroke.getKeyStroke('\b'),
- new BackspaceAction());
-
- inputMap.put(KeyStroke.getKeyStroke(KeyEvent.VK_HOME,0),
- new HomeAction());
-
- /* Workaround */
- inputMap.put(KeyStroke.getKeyStroke(KeyEvent.VK_BACK_SPACE,0),
- new DummyAction());
- } //}}}
-
- //{{{ insertWithAttrs() method
- public void insertWithAttrs(String text, AttributeSet attrs)
- throws BadLocationException
- {
- if(text == null)
- throw new NullPointerException();
-
- StyledDocument doc = (StyledDocument)getDocument();
- int offset1 = doc.getLength();
- doc.insertString(offset1,text,null);
- int offset2 = offset1 + text.length();
- doc.setCharacterAttributes(offset1,offset2,attrs,true);
- setCaretPosition(offset2);
- } //}}}
-
- //{{{ readLine() method
- public void readLine(Cons continuation)
- throws BadLocationException
- {
- StyledDocument doc = (StyledDocument)getDocument();
- cmdStart = doc.getLength();
- Element elem = doc.getParagraphElement(cmdStart);
- /* System.err.println(elem.getAttributes().getClass()); */
- setCursor(DefaultCursor);
- this.readLineContinuation = continuation;
- setCaretPosition(cmdStart);
- } //}}}
-
- //{{{ getLine() method
- private String getLine() throws BadLocationException
- {
- StyledDocument doc = (StyledDocument)getDocument();
- int length = doc.getLength();
- if(cmdStart > length)
- return "";
- else
- {
- String line = doc.getText(cmdStart,length - cmdStart);
- if(line.endsWith("\n"))
- return line.substring(0,line.length() - 1);
- else
- return line;
- }
- } //}}}
-
- //{{{ addEvalListener() method
- public void addEvalListener(EvalListener l)
- {
- listenerList.add(EvalListener.class,l);
- } //}}}
-
- //{{{ removeEvalListener() method
- public void removeEvalListener(EvalListener l)
- {
- listenerList.remove(EvalListener.class,l);
- } //}}}
-
- //{{{ eval() method
- public void eval(String eval)
- {
- if(eval == null)
- return;
-
- try
- {
- StyledDocument doc = (StyledDocument)getDocument();
- setCaretPosition(doc.getLength());
- doc.insertString(doc.getLength(),eval + "\n",
- getCharacterAttributes());
- }
- catch(BadLocationException ble)
- {
- ble.printStackTrace();
- }
- fireEvalEvent(eval);
- } //}}}
-
- //{{{ fireEvalEvent() method
- public void fireEvalEvent(String code)
- {
- setCursor(WaitCursor);
-
- Cons quot = new Cons(code,readLineContinuation);
- //readLineContinuation = null;
-
- Object[] listeners = listenerList.getListenerList();
- for(int i = 0; i < listeners.length; i++)
- {
- if(listeners[i] == EvalListener.class)
- {
- EvalListener l = (EvalListener)listeners[i+1];
- l.eval(quot);
- }
- }
- } //}}}
-
- //{{{ getAttributes() method
- private AttributeSet getAttributes(int pos)
- {
- StyledDocument doc = (StyledDocument)getDocument();
- Element e = doc.getCharacterElement(pos);
- return e.getAttributes();
- } //}}}
-
- //{{{ getActions() method
- private Cons getActions(int pos)
- {
- AttributeSet a = getAttributes(pos);
- if(a == null)
- return null;
- else
- return (Cons)a.getAttribute(Actions);
- } //}}}
-
- //{{{ getActionsPopup() method
- private JPopupMenu getActionsPopup(int pos)
- {
- Cons actions = getActions(pos);
- if(actions == null)
- return null;
-
- JPopupMenu popup = new JPopupMenu();
- while(actions != null)
- {
- Cons action = (Cons)actions.car;
- JMenuItem item = new JMenuItem((String)action.cdr);
- item.setActionCommand((String)action.car);
- item.addActionListener(new EvalAction());
- popup.add(item);
- actions = actions.next();
- }
-
- return popup;
- } //}}}
-
- //{{{ showPopupMenu() method
- private void showPopupMenu(int pos)
- {
- JPopupMenu actions = getActionsPopup(pos);
- if(actions == null)
- return;
-
- try
- {
- StyledDocument doc = (StyledDocument)getDocument();
- Element e = doc.getCharacterElement(pos);
- Point pt = modelToView(e.getStartOffset())
- .getLocation();
- FontMetrics fm = getFontMetrics(getFont());
-
- actions.show(this,pt.x,pt.y + fm.getHeight());
- }
- catch(Exception e)
- {
- e.printStackTrace();
- }
- } //}}}
-
- //{{{ MouseHandler class
- class MouseHandler extends MouseInputAdapter
- {
- public void mousePressed(MouseEvent e)
- {
- Point pt = new Point(e.getX(), e.getY());
- int pos = viewToModel(pt);
- if(pos >= 0)
- showPopupMenu(pos);
- }
-
- public void mouseMoved(MouseEvent e)
- {
- Point pt = new Point(e.getX(), e.getY());
- int pos = viewToModel(pt);
- if(pos >= 0)
- {
- Cursor cursor;
- if(getActions(pos) != null)
- cursor = MoveCursor;
- else
- cursor = DefaultCursor;
-
- if(getCursor() != cursor)
- setCursor(cursor);
- }
- }
- } //}}}
-
- //{{{ EvalAction class
- class EvalAction extends AbstractAction
- {
- public void actionPerformed(ActionEvent evt)
- {
- eval(evt.getActionCommand());
- }
- } //}}}
-
- //{{{ EnterAction class
- class EnterAction extends AbstractAction
- {
- public void actionPerformed(ActionEvent evt)
- {
- setCaretPosition(getDocument().getLength());
- replaceSelection("\n");
-
- try
- {
- fireEvalEvent(getLine());
- }
- catch(BadLocationException e)
- {
- e.printStackTrace();
- }
- }
- } //}}}
-
- //{{{ BackspaceAction class
- class BackspaceAction extends AbstractAction
- {
- public void actionPerformed(ActionEvent evt)
- {
- if(getSelectionStart() != getSelectionEnd())
- {
- replaceSelection("");
- return;
- }
-
- int caret = getCaretPosition();
- if(caret == cmdStart)
- {
- getToolkit().beep();
- return;
- }
-
- try
- {
- getDocument().remove(caret - 1,1);
- }
- catch(BadLocationException e)
- {
- e.printStackTrace();
- }
- }
- } //}}}
-
- //{{{ HomeAction class
- class HomeAction extends AbstractAction
- {
- public void actionPerformed(ActionEvent evt)
- {
- setCaretPosition(cmdStart);
- }
- } //}}}
-
- //{{{ DummyAction class
- class DummyAction extends AbstractAction
- {
- public void actionPerformed(ActionEvent evt)
- {
- }
- } //}}}
-}
+++ /dev/null
-/* :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.listener;
-
-import factor.*;
-import java.awt.*;
-import java.awt.event.*;
-import java.util.*;
-import javax.swing.*;
-import javax.swing.text.*;
-import javax.swing.text.html.*;
-
-public class FactorListenerPanel extends JPanel
-{
- private FactorInterpreter interp;
- private FactorListener listener;
-
- //{{{ newInterpreter() method
- public static FactorInterpreter newInterpreter(String[] args)
- {
- try
- {
- FactorInterpreter interp = new FactorInterpreter();
- interp.interactive = false;
- interp.init(args);
- return interp;
- }
- catch(Exception e)
- {
- System.err.println("Failed to initialize interpreter:");
- e.printStackTrace();
- return null;
- }
- } //}}}
-
- //{{{ FactorListenerPanel constructor
- public FactorListenerPanel(FactorInterpreter interp)
- {
- setLayout(new BorderLayout());
-
- this.interp = interp;
-
- add(BorderLayout.CENTER,new JScrollPane(
- listener = newListener()));
- } //}}}
-
- //{{{ getListener() method
- public FactorListener getListener()
- {
- return listener;
- } //}}}
-
- //{{{ newListener() method
- private FactorListener newListener()
- {
- final FactorListener listener = new FactorListener();
- listener.addEvalListener(new EvalHandler());
-
- eval(new Cons(listener,
- new Cons(interp.searchVocabulary(
- "listener","new-listener-hook"),
- null)));
-
- return listener;
- } //}}}
-
- //{{{ requestDefaultFocus() method
- public boolean requestDefaultFocus()
- {
- listener.requestFocus();
- return true;
- } //}}}
-
- //{{{ getInterpreter() method
- public FactorInterpreter getInterpreter()
- {
- return interp;
- } //}}}
-
- //{{{ eval() method
- private void eval(Cons cmd)
- {
- try
- {
- interp.call(cmd);
- interp.run();
- }
- catch(Exception e)
- {
- System.err.println("Failed to eval " + cmd + ":");
- e.printStackTrace();
- }
- } //}}}
-
- //{{{ EvalHandler class
- class EvalHandler implements EvalListener
- {
- public void eval(Cons cmd)
- {
- FactorListenerPanel.this.eval(cmd);
- }
- } //}}}
-}
] bind ;
: alien-function ( function library -- )
- library dlsym ;
+ [ library dlsym ] [ dlsym-self ] ifte* ;
: compile-alien-call
pop-literal reverse PARAMETERS >r
: default-error-handler ( error -- )
#! Print the error and return to the top level.
[
- in-parser? [ parse-dump ] [ standard-dump ] ifte terpri
+ in-parser? [ parse-dump ] [ standard-dump ] ifte
- "Stacks have been reset." print
":s :r :n :c show stacks at time of error." print
java? [ ":j shows Java stack trace." print ] when
] when* ;
-: :s ( -- ) "error-datastack" get . ;
-: :r ( -- ) "error-callstack" get . ;
-: :n ( -- ) "error-namestack" get . ;
-: :c ( -- ) "error-catchstack" get . ;
+: :s ( -- ) "error-datastack" get {.} ;
+: :r ( -- ) "error-callstack" get {.} ;
+: :n ( -- ) "error-namestack" get {.} ;
+: :c ( -- ) "error-catchstack" get {.} ;
USE: quit-responder
USE: file-responder
USE: resource-responder
-USE: wiki-responder
#! Remove all existing responders, and create a blank
#! responder table.
] extend add-responder
"file" set-default-responder
-
-! <responder> [
-! "wiki" "responder" set
-! [ wiki-get-responder ] "get" set
-! [ wiki-post-responder ] "post" set
-! <namespace> "wiki" set
-! "WikiHome" "default-argument" set
-! ] extend add-responder
+++ /dev/null
-! :folding=indent:collapseFolds=0:
-
-! $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: wiki-responder
-USE: combinators
-USE: format
-USE: html
-USE: lists
-USE: logic
-USE: kernel
-USE: math
-USE: namespaces
-USE: parser
-USE: regexp
-USE: stdio
-USE: stack
-USE: strings
-USE: words
-
-USE: httpd
-USE: httpd-responder
-
-! : wiki-word? ( word -- ? )
-! #! A WikiWord starts with a capital and contains more than
-! #! one capital letter.
-! dup str-length 0 > [
-! 0 over str-nth LETTER? [
-! 0 swap [ LETTER? [ succ ] when ] str-each 1 = not
-! ] [
-! drop f
-! ] ifte
-! ] [
-! drop f
-! ] ifte ;
-!
-! : wiki-formatting ( str -- )
-! #! If a word with this name exists in the wiki-formatting
-! #! vocabulary, its a special text style sequence.
-! [ "wiki-formatting" ] search ;
-!
-! : (wiki-parser) ( text -- )
-! [
-! scan dup wiki-word? [
-! <a href= dup a> write </a>
-! ] [
-! write
-! ] ifte " " write
-! ] with-parser ;
parse-switches run-files ;
: init-interpreter ( -- )
- init-history
-
print-banner
room.
"Copyright (C) 2004 Chris Double" print
"Type ``exit'' to exit, ``help'' for help." print ;
-: init-history ( -- )
- 64 <vector> "history" set ;
-
-: history+ ( cmd -- )
- "history" get vector-push ;
-
-: print-numbered-entry ( index vector -- )
- <% over unparse % ": " % vector-nth % %> print ;
-
-: print-numbered-vector ( list -- )
- dup vector-length [ over print-numbered-entry ] times* drop ;
-
-: history. ( -- )
- "X redo -- evaluate the expression with number X." print
- "X re-edit -- edit the expression with number X." print
- "history" get print-numbered-vector ;
-
-: get-history ( index -- str )
- "history" get vector-nth ;
-
-: redo ( index -- )
- get-history dup " ( " write write " )" print eval ;
-
-: re-edit ( index -- )
- get-history edit ;
-
-: history# ( -- number )
- "history" get vector-length ;
-
: print-prompt ( -- )
- <% " ( " % history# unparse % " )" % %>
- "prompt" get-style write-attr
+ "ok" "prompt" get-style write-attr
! Print the space without a style, to workaround a bug in
! the GUI listener where the style from the prompt carries
! over to the input
- " " write
- flush ;
+ " " write flush ;
: exit ( -- )
"quit-flag" on ;
[ eval ] [ [ default-error-handler drop ] when* ] catch ;
: interpret ( -- )
- print-prompt read dup [
- dup history+ eval-catch
- ] [
- drop exit
- ] ifte ;
+ print-prompt read [ eval-catch ] [ exit ] ifte* ;
: interpreter-loop ( -- )
"quit-flag" get [
native? [
"\"foo.image\" save-image -- save heap to a file" print
] when
- "history. -- show previous commands" print
"room. -- show memory usage" print
"garbage-collection -- force a GC" print
"exit -- exit interpreter" print
"WORDS:" print
"vocabs. -- list vocabularies" print
"\"math\" words. -- list the math vocabulary" print
- "\"neg\" see -- show word definition" print
"\"str\" apropos. -- list all words containing str" print
- "\"car\" usages. -- list all words invoking car" print
+ "\\ neg see -- show word definition" print
+ "\\ car usages. -- list all words invoking car" print
terpri
"STACKS:" print
".s .r .n .c -- show contents of the 4 stacks" print
--- /dev/null
+! :folding=indent: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.
+
+IN: listener
+USE: combinators
+USE: continuations
+USE: init
+USE: interpreter
+USE: kernel
+USE: lists
+USE: namespaces
+USE: stack
+USE: stdio
+USE: styles
+USE: streams
+USE: strings
+USE: unparser
+
+: <attribute-set> ( -- attribute-set )
+ [ ] "javax.swing.text.SimpleAttributeSet" jnew ;
+
+: attribute+ ( attribute-set value key -- )
+ transp
+ [ "java.lang.Object" "java.lang.Object" ]
+ "javax.swing.text.SimpleAttributeSet"
+ "addAttribute" jinvoke ;
+
+: style-constant ( name -- key )
+ #! javax.swing.text.StyleConstants contains static variables
+ #! which key in an AttributeSet.
+ "javax.swing.text.StyleConstants" swap jvar-static-get
+ ; inline
+
+: set-icon-style ( attribute-set icon -- )
+ [
+ "javax.swing.text.MutableAttributeSet"
+ "javax.swing.Icon"
+ ] "javax.swing.text.StyleConstants"
+ "setIcon" jinvoke-static ;
+
+: <icon> ( resource -- icon )
+ resource
+ [ "java.net.URL" ]
+ "javax.swing.ImageIcon" jnew ;
+
+: swing-attribute+ ( attribute-set value key -- )
+ style-constant attribute+ ;
+
+: >color ( triplet -- hex )
+ uncons uncons uncons drop
+ [ "int" "int" "int" ]
+ "java.awt.Color"
+ jnew ;
+
+: actions-key ( -- attr )
+ "factor.jedit.FactorListener" "Actions" jvar-static-get
+ ; inline
+
+: <action-menu-item> ( path pair -- pair )
+ uncons >r " " swap cat3 r> cons ;
+
+: <actions-menu> ( path actions -- alist )
+ [ dupd <action-menu-item> ] map nip ;
+
+: object-actions ( -- list )
+ [
+ [ "describe-path" | "Describe" ]
+ [ "lookup" | "Push" ]
+ [ "lookup execute" | "Execute" ]
+ [ "lookup jedit" | "jEdit" ]
+ [ "lookup usages." | "Usages" ]
+ ] ;
+
+: <object-actions-menu> ( path -- alist )
+ unparse object-actions <actions-menu> ;
+
+: file-actions ( -- list )
+ [
+ [ "" | "Push" ]
+ [ "run-file" | "Run file" ]
+ [ "directory." | "List directory" ]
+ [ "cd" | "Change directory" ]
+ ] ;
+
+: <file-actions-menu> ( path -- alist )
+ unparse file-actions <actions-menu> ;
+
+: underline-attribute ( attribute-set -- )
+ t "Underline" swing-attribute+ ;
+
+: object-link-attribute ( attribute-set target -- )
+ over underline-attribute
+ <object-actions-menu> actions-key attribute+ ;
+
+: file-link-attribute ( attribute-set target -- )
+ over underline-attribute
+ <file-actions-menu> actions-key attribute+ ;
+
+: icon-attribute ( string style value -- )
+ dupd <icon> set-icon-style
+ >r drop " " r> ;
+
+: style>attribute-set ( string style -- string attribute-set )
+ #! We need the string, since outputting an icon changes the
+ #! string to " ".
+ <attribute-set> swap [
+ [ "object-link" dupd object-link-attribute ]
+ [ "file-link" dupd file-link-attribute ]
+ [ "bold" drop dup t "Bold" swing-attribute+ ]
+ [ "italics" drop dup t "Italic" swing-attribute+ ]
+ [ "underline" drop dup t "Underline" swing-attribute+ ]
+ [ "fg" dupd >color "Foreground" swing-attribute+ ]
+ [ "bg" dupd >color "Background" swing-attribute+ ]
+ [ "font" dupd "FontFamily" swing-attribute+ ]
+ [ "size" dupd "FontSize" swing-attribute+ ]
+ [ "icon" icon-attribute ]
+ ] assoc-apply ;
+
+: set-character-attrs ( attrs -- )
+ t "listener" get
+ [ "javax.swing.text.AttributeSet" "boolean" ]
+ "javax.swing.JTextPane"
+ "setCharacterAttributes"
+ jinvoke ;
+
+: set-paragraph-attrs ( attrs -- )
+ t "listener" get
+ [ "javax.swing.text.AttributeSet" "boolean" ]
+ "javax.swing.JTextPane"
+ "setCharacterAttributes"
+ jinvoke ;
+
+: reset-attrs ( -- )
+ f default-style style>attribute-set set-character-attrs
+ drop ;
+
+: listener-readln* ( continuation -- )
+ "listener" get
+ [ "factor.Cons" ]
+ "factor.jedit.FactorListener"
+ "readLine" jinvoke ;
+
+: listener-readln ( -- line )
+ reset-attrs [ listener-readln* toplevel ] callcc1 ;
+
+: listener-write-attr ( string style -- )
+ style>attribute-set "listener" get
+ [ "java.lang.String" "javax.swing.text.AttributeSet" ]
+ "factor.jedit.FactorListener"
+ "insertWithAttrs"
+ jinvoke ;
+
+!: listener-edit ( string -- )
+! "listener" get
+! [ "java.lang.String" ]
+! "factor.jedit.FactorListener"
+! "editLine" jinvoke ;
+
+: <listener-stream> ( listener -- stream )
+ #! Creates a stream for reading/writing to the given
+ #! listener instance.
+ <stream> [
+ "listener" set
+ ( -- string )
+ [ listener-readln ] "freadln" set
+ ( string -- )
+ [ default-style listener-write-attr ] "fwrite" set
+ ( string style -- )
+ [ listener-write-attr ] "fwrite-attr" set
+ ( string -- )
+ ![ listener-edit ] "fedit" set
+ ( -- )
+ [ ] "fflush" set
+ ( -- )
+ [ ] "fclose" set
+ ( string -- )
+ [ this fwrite "\n" this fwrite ] "fprint" set
+ ] extend ;
+
+: new-listener-hook ( listener -- )
+ #! Called when user opens a new listener
+ [
+ dup "listener" set
+ <listener-stream> "stdio" set
+ init-interpreter
+ ] with-scope ;
USE: real-math
USE: stack
-: fib ( n -- nth fibonacci number )
- ! This is the naive implementation, for benchmarking purposes.
- dup 1 <= [ drop 1 ] [ pred dup fib swap pred fib + ] ifte ;
-
: fac ( n -- n! )
! This is the naive implementation, for benchmarking purposes.
1 swap [ succ * ] times* ;
! bind ( namespace quot -- ) executes a quotation with a
! namespace pushed on the namespace stack.
-: >n ( namespace -- n:namespace )
- #! Push a namespace on the namespace stack.
- namestack* vector-push ; inline
-
-: n> ( n:namespace -- namespace )
- #! Pop the top of the namespace stack.
- namestack* vector-pop ; inline
-
: namespace ( -- namespace )
#! Push the current namespace.
namestack* vector-peek ; inline
"/library/httpd/quit-responder.factor" run-resource ! quit-responder
"/library/httpd/resource-responder.factor" run-resource ! resource-responder
"/library/httpd/test-responder.factor" run-resource ! test-responder
-"/library/httpd/wiki-responder.factor" run-resource ! wiki-responder
"/library/httpd/default-responders.factor" run-resource ! default-responders
+!!! Final initialization...
+"/library/init.factor" run-resource ! init
+"/library/platform/jvm/init.factor" run-resource ! init
+
!!! jEdit integration.
-"/library/jedit/jedit-local.factor" run-resource ! jedit
+"/library/jedit/jedit-local.factor" run-resource ! jedit
"/library/jedit/jedit-remote.factor" run-resource ! jedit
-"/library/jedit/jedit.factor" run-resource ! jedit
-
-!!! Final initialization...
-"/library/init.factor" run-resource ! init
-"/library/platform/jvm/init.factor" run-resource ! init
-"/library/platform/jvm/listener.factor" run-resource ! listener
+"/library/jedit/jedit.factor" run-resource ! jedit
+"/library/jedit/listener.factor" run-resource ! listener
+++ /dev/null
-! :folding=indent: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.
-
-IN: listener
-USE: combinators
-USE: continuations
-USE: init
-USE: interpreter
-USE: kernel
-USE: lists
-USE: namespaces
-USE: stack
-USE: stdio
-USE: styles
-USE: streams
-USE: strings
-USE: unparser
-
-: <attribute-set> ( -- attribute-set )
- [ ] "javax.swing.text.SimpleAttributeSet" jnew ;
-
-: attribute+ ( attribute-set value key -- )
- transp
- [ "java.lang.Object" "java.lang.Object" ]
- "javax.swing.text.SimpleAttributeSet"
- "addAttribute" jinvoke ;
-
-: style-constant ( name -- key )
- #! javax.swing.text.StyleConstants contains static variables
- #! which key in an AttributeSet.
- "javax.swing.text.StyleConstants" swap jvar-static-get
- ; inline
-
-: set-icon-style ( attribute-set icon -- )
- [
- "javax.swing.text.MutableAttributeSet"
- "javax.swing.Icon"
- ] "javax.swing.text.StyleConstants"
- "setIcon" jinvoke-static ;
-
-: <icon> ( resource -- icon )
- resource
- [ "java.net.URL" ]
- "javax.swing.ImageIcon" jnew ;
-
-: swing-attribute+ ( attribute-set value key -- )
- style-constant attribute+ ;
-
-: >color ( triplet -- hex )
- uncons uncons uncons drop
- [ "int" "int" "int" ]
- "java.awt.Color"
- jnew ;
-
-: actions-key ( -- attr )
- "factor.listener.FactorListener" "Actions" jvar-static-get
- ; inline
-
-: <action-menu-item> ( path pair -- pair )
- uncons >r " " swap cat3 r> cons ;
-
-: <actions-menu> ( path actions -- alist )
- [ dupd <action-menu-item> ] map nip ;
-
-: object-actions ( -- list )
- [
- [ "describe-path" | "Describe" ]
- [ "lookup" | "Push" ]
- [ "lookup execute" | "Execute" ]
- [ "lookup jedit" | "jEdit" ]
- [ "lookup usages." | "Usages" ]
- ] ;
-
-: <object-actions-menu> ( path -- alist )
- unparse object-actions <actions-menu> ;
-
-: file-actions ( -- list )
- [
- [ "" | "Push" ]
- [ "run-file" | "Run file" ]
- [ "directory." | "List directory" ]
- [ "cd" | "Change directory" ]
- ] ;
-
-: <file-actions-menu> ( path -- alist )
- unparse file-actions <actions-menu> ;
-
-: underline-attribute ( attribute-set -- )
- t "Underline" swing-attribute+ ;
-
-: object-link-attribute ( attribute-set target -- )
- over underline-attribute
- <object-actions-menu> actions-key attribute+ ;
-
-: file-link-attribute ( attribute-set target -- )
- over underline-attribute
- <file-actions-menu> actions-key attribute+ ;
-
-: icon-attribute ( string style value -- )
- dupd <icon> set-icon-style
- >r drop " " r> ;
-
-: style>attribute-set ( string style -- string attribute-set )
- #! We need the string, since outputting an icon changes the
- #! string to " ".
- <attribute-set> swap [
- [ "object-link" dupd object-link-attribute ]
- [ "file-link" dupd file-link-attribute ]
- [ "bold" drop dup t "Bold" swing-attribute+ ]
- [ "italics" drop dup t "Italic" swing-attribute+ ]
- [ "underline" drop dup t "Underline" swing-attribute+ ]
- [ "fg" dupd >color "Foreground" swing-attribute+ ]
- [ "bg" dupd >color "Background" swing-attribute+ ]
- [ "font" dupd "FontFamily" swing-attribute+ ]
- [ "size" dupd "FontSize" swing-attribute+ ]
- [ "icon" icon-attribute ]
- ] assoc-apply ;
-
-: set-character-attrs ( attrs -- )
- t "listener" get
- [ "javax.swing.text.AttributeSet" "boolean" ]
- "javax.swing.JTextPane"
- "setCharacterAttributes"
- jinvoke ;
-
-: set-paragraph-attrs ( attrs -- )
- t "listener" get
- [ "javax.swing.text.AttributeSet" "boolean" ]
- "javax.swing.JTextPane"
- "setCharacterAttributes"
- jinvoke ;
-
-: reset-attrs ( -- )
- f default-style style>attribute-set set-character-attrs
- drop ;
-
-: listener-readln* ( continuation -- )
- "listener" get
- [ "factor.Cons" ]
- "factor.listener.FactorListener"
- "readLine" jinvoke ;
-
-: listener-readln ( -- line )
- reset-attrs [ listener-readln* toplevel ] callcc1 ;
-
-: listener-write-attr ( string style -- )
- style>attribute-set "listener" get
- [ "java.lang.String" "javax.swing.text.AttributeSet" ]
- "factor.listener.FactorListener"
- "insertWithAttrs"
- jinvoke ;
-
-!: listener-edit ( string -- )
-! "listener" get
-! [ "java.lang.String" ]
-! "factor.listener.FactorListener"
-! "editLine" jinvoke ;
-
-: <listener-stream> ( listener -- stream )
- #! Creates a stream for reading/writing to the given
- #! listener instance.
- <stream> [
- "listener" set
- ( -- string )
- [ listener-readln ] "freadln" set
- ( string -- )
- [ default-style listener-write-attr ] "fwrite" set
- ( string style -- )
- [ listener-write-attr ] "fwrite-attr" set
- ( string -- )
- ![ listener-edit ] "fedit" set
- ( -- )
- [ ] "fflush" set
- ( -- )
- [ ] "fclose" set
- ( string -- )
- [ this fwrite "\n" this fwrite ] "fprint" set
- ] extend ;
-
-: new-listener-hook ( listener -- )
- #! Called when user opens a new listener
- [
- dup "listener" set
- <listener-stream> "stdio" set
- init-interpreter
- ] with-scope ;
USE: logic
USE: stack
USE: strings
+USE: vectors
DEFER: namespace
-DEFER: >n
-DEFER: n>
: namestack* ( -- stack )
#! Push the namespace stack.
interpreter
"factor.FactorInterpreter" "namestack" jvar-set ; inline
+: >n ( namespace -- n:namespace )
+ #! Push a namespace on the namespace stack.
+ namestack* vector-push ; inline
+
+: n> ( n:namespace -- namespace )
+ #! Pop the top of the namespace stack.
+ namestack* vector-pop ; inline
+
: namestack ( -- stack )
namestack* clone ; inline
t "ansi" set
t "compile" set
- "ansi" get [ "stdio" get <ansi-stream> "stdio" set ] when
-
! The first CLI arg is the image name.
cli-args uncons parse-command-line "image" set
+ "ansi" get [ "stdio" get <ansi-stream> "stdio" set ] when
+
"compile" get [ init-compiler ] when
run-user-init ;
USE: vectors
DEFER: namespace
-DEFER: >n
-DEFER: n>
: namestack* ( -- ns ) 3 getenv ;
: set-namestack* ( ns -- ) 3 setenv ;
+: >n ( namespace -- n:namespace )
+ #! Push a namespace on the namespace stack.
+ namestack* vector-push ; inline
+
+: n> ( n:namespace -- namespace )
+ #! Pop the top of the namespace stack.
+ namestack* vector-pop ; inline
+
: namestack ( -- stack ) namestack* vector-clone ;
: set-namestack ( stack -- ) vector-clone set-namestack* ;
#! Unparse each element on its own line.
[ . ] each ;
-: .n namestack . ;
-: .s datastack . ;
-: .r callstack . ;
-: .c catchstack . ;
+: {.} ( vector -- )
+ #! Unparse each element on its own line.
+ [ . ] vector-each ;
+
+: .n namestack {.} ;
+: .s datastack {.} ;
+: .r callstack {.} ;
+: .c catchstack {.} ;
! For integers only
: .b >bin print ;
dup [
"client" set
log-client
- init-history
interpreter-loop
] with-stream ;
--- /dev/null
+USE: stack
+USE: math
+USE: kernel
+USE: combinators
+USE: compiler
+USE: test
+
+! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
+
+: ack ( m n -- )
+ over 0 = [
+ nip succ
+ ] [
+ dup 0 = [
+ drop pred 1 ack
+ ] [
+ dupd pred ack >r pred r> ack
+ ] ifte
+ ] ifte ; compiled
+
+[ 4093 ] [ 3 9 ack ] unit-test
USE: stack
USE: test
-[ ] [ 5000000 [ ] times ] unit-test
-[ ] [ 5000000 [ drop ] times* ] unit-test
+: empty-loop-1 ( n -- )
+ [ ] times ;
+
+: empty-loop-2 ( n -- )
+ [ drop ] times* ;
+
+[ ] [ 5000000 empty-loop-1 ] unit-test
+[ ] [ 5000000 empty-loop-2 ] unit-test
IN: scratchpad
+USE: compiler
USE: math
USE: stack
USE: test
+USE: combinators
+
+: fib ( n -- nth fibonacci number )
+ dup 1 <= [ drop 1 ] [ pred dup fib swap pred fib + ] ifte ;
+ compiled
[ 9227465 ] [ 34 fib ] unit-test
--- /dev/null
+USE: stack
+USE: strings
+USE: math
+USE: combinators
+USE: test
+USE: unparser
+USE: hashtables
+
+! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
+
+: store-hash ( hashtable n -- )
+ [ dup >hex swap pick set-hash ] times* drop ;
+
+: lookup-hash ( hashtable n -- )
+ [ unparse over hash drop ] times* drop ;
+
+: hashtable-benchmark ( n -- )
+ 60000 <hashtable> swap 2dup store-hash lookup-hash ;
+
+[ ] [ 80000 hashtable-benchmark ] unit-test
--- /dev/null
+USE: stack
+USE: strings
+USE: math
+USE: combinators
+USE: test
+
+! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
+
+: string-step ( n str -- )
+ 2dup str-length > [
+ dup <% "123" % % "456" % % "789" % %>
+ dup dup str-length 2 /i 0 transp substring
+ swap dup str-length 2 /i succ 1 transp substring cat2
+ string-step
+ ] [
+ 2drop
+ ] ifte ;
+
+: string-benchmark ( n -- )
+ "abcdef" 10 [ 2dup string-step ] times 2drop ;
+
+[ ] [ 1000000 string-benchmark ] unit-test
--- /dev/null
+USE: vectors
+USE: stack
+USE: math
+USE: compiler
+USE: test
+
+! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html
+
+: fill-vector ( n -- vector )
+ dup <vector> swap [ dup pick set-vector-nth ] times* ;
+
+: copy-elt ( vec-y vec-x n -- )
+ #! Copy first nth element from vec-x to vec-y.
+ tuck swap vector-nth transp set-vector-nth ;
+
+: copy-vector ( vec-y vec-x n -- )
+ #! Copy first n-1 elements from vec-x to vec-y.
+ [ >r 2dup r> copy-elt ] times* 2drop ;
+
+: vector-benchmark ( n -- )
+ 0 <vector> over fill-vector rot copy-vector ; ! compiled
+
+[ ] [ 400000 vector-benchmark ] unit-test
USE: test
[
- init-history
- "2 2 +" history+
- history.
- [ "2 2 +" ] [ 0 get-history ] unit-test
- [ 4 ] [ 0 redo ] unit-test
[ 4 ] [ "2 2 +" eval-catch ] unit-test
"The following will print an error; ignore it." print terpri
[ ] [ "clear drop" eval-catch ] unit-test
[ 5 ] [ 1 "x" -@ "x" get ] unit-test
[ 10 ] [ 2 "x" *@ "x" get ] unit-test
[ 2 ] [ 5 "x" /@ "x" get ] unit-test
-[ -3 ] [ "x" pred@ "x" get ] unit-test
-[ -2 ] [ "x" succ@ "x" get ] unit-test
+[ 1 ] [ "x" pred@ "x" get ] unit-test
+[ 2 ] [ "x" succ@ "x" get ] unit-test
"crashes" test
"sbuf" test
"threads" test
- "parsing-word" test
+ ! "parsing-word" test
cpu "x86" = [
[
"benchmark/fac" test
"benchmark/fib" test
"benchmark/sort" test
- "benchmark/continuations" test ;
+ "benchmark/continuations" test
+ "benchmark/ack" test
+ "benchmark/hashtables" test
+ "benchmark/strings" test
+ "benchmark/vectors" test ;
void primitive_bignum_greatereq(void);
void primitive_bignum_not(void);
void copy_bignum_constants(void);
+CELL three_test(void* x, unsigned char r, unsigned char g, unsigned char b);
INLINE CELL tag_integer(FIXNUM x)
{
{
int i;
for(i = 0; i < USER_ENV; i++)
- userenv[i] = 0;
+ userenv[i] = F;
profile_depth = 0;
}
projects / factor.git / commitdiff