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

[[ car cdr ]] syntax replaces [ car | cdr ]

cvs
Slava Pestov 2005-01-14 00:49:47 +00:00
parent 242644a236
commit 7e8a87f213
52 changed files with 807 additions and 765 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
examples/irc.factor
View File

@ -32,13 +32,13 @@ SYMBOL: nickname
: write-highlighted ( line -- )
dup nickname get index-of -1 =
f [ [ "ansi-fg" | "3" ] ] ? write-attr ;
f [ [[ "ansi-fg" "3" ]] ] ? write-attr ;
: extract-nick ( line -- nick )
"!" split1 drop ;
: write-nick ( line -- )
"!" split1 drop [ [ "bold" | t ] ] write-attr ;
"!" split1 drop [ [[ "bold" t ]] ] write-attr ;
GENERIC: irc-display
PREDICATE: string privmsg "PRIVMSG" index-of -1 > ;

8
examples/more-random.factor
View File

@ -72,10 +72,10 @@ USE: namespaces
unit-test
[
[ 10 | t ]
[ 20 | f ]
[ 30 | "monkey" ]
[ 24 | 1/2 ]
[[ 10 t ]]
[[ 20 f ]]
[[ 30 "monkey" ]]
[[ 24 1/2 ]]
[ 13 | { "Hello" "Banana" } ]
] "random-pairs" set

36
factor/Cons.java
View File

@ -50,6 +50,17 @@ public class Cons implements FactorExternalizable
return (Cons)cdr;
} //}}}
//{{{ isList() method
public static boolean isList(Object list)
{
if(list == null)
return true;
else if(list instanceof Cons)
return isList(((Cons)list).cdr);
else
return false;
} //}}}
//{{{ contains() method
public static boolean contains(Cons list, Object obj)
{
@ -98,20 +109,8 @@ public class Cons implements FactorExternalizable
while(iter != null)
{
buf.append(FactorReader.unparseObject(iter.car));
if(iter.cdr instanceof Cons)
{
buf.append(' ');
iter = (Cons)iter.cdr;
continue;
}
else if(iter.cdr == null)
break;
else
{
buf.append(" | ");
buf.append(FactorReader.unparseObject(iter.cdr));
iter = null;
}
buf.append(' ');
iter = iter.next();
}
return buf.toString();
@ -123,7 +122,14 @@ public class Cons implements FactorExternalizable
*/
public String toString()
{
return "[ " + elementsToString() + " ]";
if(isList(this))
return "[ " + elementsToString() + " ]";
else
{
return "[[ " + FactorReader.unparseObject(car)
+ " " + FactorReader.unparseObject(cdr)
+ " ]]";
}
} //}}}
//{{{ toArray() method

8
factor/DefaultVocabularyLookup.java
View File

@ -75,8 +75,12 @@ public class DefaultVocabularyLookup implements VocabularyLookup
bra.parsing = new Bra(bra);
FactorWord ket = define("syntax","]");
ket.parsing = new Ket(bra,ket);
FactorWord bar = define("syntax","|");
bar.parsing = new Bar(bar);
/* conses */
FactorWord beginCons = define("syntax","[[");
beginCons.parsing = new BeginCons(beginCons);
FactorWord endCons = define("syntax","]]");
endCons.parsing = new EndCons(beginCons,endCons);
/* vectors */
FactorWord beginVector = define("syntax","{");

18
factor/parser/Bar.java → factor/parser/BeginCons.java
View File

@ -3,7 +3,7 @@
/*
* $Id$
*
* Copyright (C) 2004 Slava Pestov.
* Copyright (C) 2005 Slava Pestov.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
@ -31,23 +31,15 @@ package factor.parser;
import factor.*;
public class Bar extends FactorParsingDefinition
public class BeginCons extends FactorParsingDefinition
{
//{{{ Bar constructor
/**
* A new definition.
*/
public Bar(FactorWord word)
public BeginCons(FactorWord word)
{
super(word);
} //}}}
}
public void eval(FactorReader reader)
throws Exception
{
FactorReader.ParseState state = reader.getCurrentState();
if(state.start != reader.intern("[",false))
reader.error("| only allowed inside [ ... ]");
reader.bar();
reader.pushState(word,null);
}
}

51
factor/parser/EndCons.java Normal file
View File

@ -0,0 +1,51 @@
/* :folding=explicit:collapseFolds=1: */
/*
* $Id$
*
* Copyright (C) 2005 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.parser;
import factor.*;
public class EndCons extends FactorParsingDefinition
{
public FactorWord start;
public EndCons(FactorWord start, FactorWord end)
{
super(end);
this.start = start;
}
public void eval(FactorReader reader) throws FactorParseException
{
Cons list = reader.popState(start,word).first;
if(Cons.length(list) != 2)
reader.getScanner().error("Exactly two objects must be between [[ and ]]");
reader.append(new Cons(list.car,list.next().car));
}
}

2
library/assoc.factor
View File

@ -36,7 +36,7 @@ USE: kernel
#! Push if the list appears to be an alist.
dup list? [ [ cons? ] all? ] [ drop f ] ifte ;
: assoc* ( key alist -- [ key | value ] )
: assoc* ( key alist -- [[ key value ]] )
#! Looks up the key in an alist. Push the key/value pair.
#! Most of the time you want to use assoc not assoc*.
dup [

6
library/bootstrap/image.factor
View File

@ -159,9 +159,9 @@ M: bignum ' ( bignum -- tagged )
object-tag here-as >r
bignum-type >header emit
[
[ 0 | [ 1 0 ] ]
[ -1 | [ 2 1 1 ] ]
[ 1 | [ 2 0 1 ] ]
[[ 0 [ 1 0 ] ]]
[[ -1 [ 2 1 1 ] ]]
[[ 1 [ 2 0 1 ] ]]
] assoc [ emit ] each align-here r> ;
( Special objects )

342
library/bootstrap/primitives.factor
View File

@ -54,177 +54,177 @@ vocabularies get [
<namespace> classes set
2 [
[ "words" | "execute" ]
[ "kernel" | "call" ]
[ "kernel" | "ifte" ]
[ "lists" | "cons" ]
[ "vectors" | "<vector>" ]
[ "vectors" | "vector-nth" ]
[ "vectors" | "set-vector-nth" ]
[ "strings" | "str-nth" ]
[ "strings" | "str-compare" ]
[ "strings" | "str=" ]
[ "strings" | "index-of*" ]
[ "strings" | "substring" ]
[ "strings" | "str-reverse" ]
[ "strings" | "<sbuf>" ]
[ "strings" | "sbuf-length" ]
[ "strings" | "set-sbuf-length" ]
[ "strings" | "sbuf-nth" ]
[ "strings" | "set-sbuf-nth" ]
[ "strings" | "sbuf-append" ]
[ "strings" | "sbuf>str" ]
[ "strings" | "sbuf-reverse" ]
[ "strings" | "sbuf-clone" ]
[ "strings" | "sbuf=" ]
[ "strings" | "sbuf-hashcode" ]
[ "math-internals" | "arithmetic-type" ]
[ "math" | ">fixnum" ]
[ "math" | ">bignum" ]
[ "math" | ">float" ]
[ "math-internals" | "(fraction>)" ]
[ "parser" | "str>float" ]
[ "unparser" | "(unparse-float)" ]
[ "math-internals" | "(rect>)" ]
[ "math-internals" | "fixnum=" ]
[ "math-internals" | "fixnum+" ]
[ "math-internals" | "fixnum-" ]
[ "math-internals" | "fixnum*" ]
[ "math-internals" | "fixnum/i" ]
[ "math-internals" | "fixnum/f" ]
[ "math-internals" | "fixnum-mod" ]
[ "math-internals" | "fixnum/mod" ]
[ "math-internals" | "fixnum-bitand" ]
[ "math-internals" | "fixnum-bitor" ]
[ "math-internals" | "fixnum-bitxor" ]
[ "math-internals" | "fixnum-bitnot" ]
[ "math-internals" | "fixnum-shift" ]
[ "math-internals" | "fixnum<" ]
[ "math-internals" | "fixnum<=" ]
[ "math-internals" | "fixnum>" ]
[ "math-internals" | "fixnum>=" ]
[ "math-internals" | "bignum=" ]
[ "math-internals" | "bignum+" ]
[ "math-internals" | "bignum-" ]
[ "math-internals" | "bignum*" ]
[ "math-internals" | "bignum/i" ]
[ "math-internals" | "bignum/f" ]
[ "math-internals" | "bignum-mod" ]
[ "math-internals" | "bignum/mod" ]
[ "math-internals" | "bignum-bitand" ]
[ "math-internals" | "bignum-bitor" ]
[ "math-internals" | "bignum-bitxor" ]
[ "math-internals" | "bignum-bitnot" ]
[ "math-internals" | "bignum-shift" ]
[ "math-internals" | "bignum<" ]
[ "math-internals" | "bignum<=" ]
[ "math-internals" | "bignum>" ]
[ "math-internals" | "bignum>=" ]
[ "math-internals" | "float=" ]
[ "math-internals" | "float+" ]
[ "math-internals" | "float-" ]
[ "math-internals" | "float*" ]
[ "math-internals" | "float/f" ]
[ "math-internals" | "float<" ]
[ "math-internals" | "float<=" ]
[ "math-internals" | "float>" ]
[ "math-internals" | "float>=" ]
[ "math-internals" | "facos" ]
[ "math-internals" | "fasin" ]
[ "math-internals" | "fatan" ]
[ "math-internals" | "fatan2" ]
[ "math-internals" | "fcos" ]
[ "math-internals" | "fexp" ]
[ "math-internals" | "fcosh" ]
[ "math-internals" | "flog" ]
[ "math-internals" | "fpow" ]
[ "math-internals" | "fsin" ]
[ "math-internals" | "fsinh" ]
[ "math-internals" | "fsqrt" ]
[ "words" | "<word>" ]
[ "words" | "update-xt" ]
[ "profiler" | "call-profiling" ]
[ "profiler" | "allot-profiling" ]
[ "words" | "compiled?" ]
[ "kernel" | "drop" ]
[ "kernel" | "dup" ]
[ "kernel" | "swap" ]
[ "kernel" | "over" ]
[ "kernel" | "pick" ]
[ "kernel" | ">r" ]
[ "kernel" | "r>" ]
[ "kernel" | "eq?" ]
[ "kernel-internals" | "getenv" ]
[ "kernel-internals" | "setenv" ]
[ "io-internals" | "open-file" ]
[ "files" | "stat" ]
[ "files" | "(directory)" ]
[ "kernel" | "garbage-collection" ]
[ "kernel" | "gc-time" ]
[ "kernel" | "save-image" ]
[ "kernel" | "datastack" ]
[ "kernel" | "callstack" ]
[ "kernel" | "set-datastack" ]
[ "kernel" | "set-callstack" ]
[ "kernel" | "exit*" ]
[ "io-internals" | "client-socket" ]
[ "io-internals" | "server-socket" ]
[ "io-internals" | "close-port" ]
[ "io-internals" | "add-accept-io-task" ]
[ "io-internals" | "accept-fd" ]
[ "io-internals" | "can-read-line?" ]
[ "io-internals" | "add-read-line-io-task" ]
[ "io-internals" | "read-line-fd-8" ]
[ "io-internals" | "can-read-count?" ]
[ "io-internals" | "add-read-count-io-task" ]
[ "io-internals" | "read-count-fd-8" ]
[ "io-internals" | "can-write?" ]
[ "io-internals" | "add-write-io-task" ]
[ "io-internals" | "write-fd-8" ]
[ "io-internals" | "add-copy-io-task" ]
[ "io-internals" | "pending-io-error" ]
[ "io-internals" | "next-io-task" ]
[ "kernel" | "room" ]
[ "kernel" | "os-env" ]
[ "kernel" | "millis" ]
[ "random" | "init-random" ]
[ "random" | "(random-int)" ]
[ "kernel" | "type" ]
[ "files" | "cwd" ]
[ "files" | "cd" ]
[ "assembler" | "compiled-offset" ]
[ "assembler" | "set-compiled-offset" ]
[ "assembler" | "literal-top" ]
[ "assembler" | "set-literal-top" ]
[ "kernel" | "address" ]
[ "alien" | "dlopen" ]
[ "alien" | "dlsym" ]
[ "alien" | "dlclose" ]
[ "alien" | "<alien>" ]
[ "alien" | "<local-alien>" ]
[ "alien" | "alien-cell" ]
[ "alien" | "set-alien-cell" ]
[ "alien" | "alien-4" ]
[ "alien" | "set-alien-4" ]
[ "alien" | "alien-2" ]
[ "alien" | "set-alien-2" ]
[ "alien" | "alien-1" ]
[ "alien" | "set-alien-1" ]
[ "kernel" | "heap-stats" ]
[ "errors" | "throw" ]
[ "kernel-internals" | "string>memory" ]
[ "kernel-internals" | "memory>string" ]
[ "alien" | "local-alien?" ]
[ "alien" | "alien-address" ]
[ "lists" | ">cons" ]
[ "vectors" | ">vector" ]
[ "strings" | ">string" ]
[ "words" | ">word" ]
[ "kernel-internals" | "slot" ]
[ "kernel-internals" | "set-slot" ]
[ "kernel-internals" | "integer-slot" ]
[ "kernel-internals" | "set-integer-slot" ]
[ "kernel-internals" | "grow-array" ]
[[ "words" "execute" ]]
[[ "kernel" "call" ]]
[[ "kernel" "ifte" ]]
[[ "lists" "cons" ]]
[[ "vectors" "<vector>" ]]
[[ "vectors" "vector-nth" ]]
[[ "vectors" "set-vector-nth" ]]
[[ "strings" "str-nth" ]]
[[ "strings" "str-compare" ]]
[[ "strings" "str=" ]]
[[ "strings" "index-of*" ]]
[[ "strings" "substring" ]]
[[ "strings" "str-reverse" ]]
[[ "strings" "<sbuf>" ]]
[[ "strings" "sbuf-length" ]]
[[ "strings" "set-sbuf-length" ]]
[[ "strings" "sbuf-nth" ]]
[[ "strings" "set-sbuf-nth" ]]
[[ "strings" "sbuf-append" ]]
[[ "strings" "sbuf>str" ]]
[[ "strings" "sbuf-reverse" ]]
[[ "strings" "sbuf-clone" ]]
[[ "strings" "sbuf=" ]]
[[ "strings" "sbuf-hashcode" ]]
[[ "math-internals" "arithmetic-type" ]]
[[ "math" ">fixnum" ]]
[[ "math" ">bignum" ]]
[[ "math" ">float" ]]
[[ "math-internals" "(fraction>)" ]]
[[ "parser" "str>float" ]]
[[ "unparser" "(unparse-float)" ]]
[[ "math-internals" "(rect>)" ]]
[[ "math-internals" "fixnum=" ]]
[[ "math-internals" "fixnum+" ]]
[[ "math-internals" "fixnum-" ]]
[[ "math-internals" "fixnum*" ]]
[[ "math-internals" "fixnum/i" ]]
[[ "math-internals" "fixnum/f" ]]
[[ "math-internals" "fixnum-mod" ]]
[[ "math-internals" "fixnum/mod" ]]
[[ "math-internals" "fixnum-bitand" ]]
[[ "math-internals" "fixnum-bitor" ]]
[[ "math-internals" "fixnum-bitxor" ]]
[[ "math-internals" "fixnum-bitnot" ]]
[[ "math-internals" "fixnum-shift" ]]
[[ "math-internals" "fixnum<" ]]
[[ "math-internals" "fixnum<=" ]]
[[ "math-internals" "fixnum>" ]]
[[ "math-internals" "fixnum>=" ]]
[[ "math-internals" "bignum=" ]]
[[ "math-internals" "bignum+" ]]
[[ "math-internals" "bignum-" ]]
[[ "math-internals" "bignum*" ]]
[[ "math-internals" "bignum/i" ]]
[[ "math-internals" "bignum/f" ]]
[[ "math-internals" "bignum-mod" ]]
[[ "math-internals" "bignum/mod" ]]
[[ "math-internals" "bignum-bitand" ]]
[[ "math-internals" "bignum-bitor" ]]
[[ "math-internals" "bignum-bitxor" ]]
[[ "math-internals" "bignum-bitnot" ]]
[[ "math-internals" "bignum-shift" ]]
[[ "math-internals" "bignum<" ]]
[[ "math-internals" "bignum<=" ]]
[[ "math-internals" "bignum>" ]]
[[ "math-internals" "bignum>=" ]]
[[ "math-internals" "float=" ]]
[[ "math-internals" "float+" ]]
[[ "math-internals" "float-" ]]
[[ "math-internals" "float*" ]]
[[ "math-internals" "float/f" ]]
[[ "math-internals" "float<" ]]
[[ "math-internals" "float<=" ]]
[[ "math-internals" "float>" ]]
[[ "math-internals" "float>=" ]]
[[ "math-internals" "facos" ]]
[[ "math-internals" "fasin" ]]
[[ "math-internals" "fatan" ]]
[[ "math-internals" "fatan2" ]]
[[ "math-internals" "fcos" ]]
[[ "math-internals" "fexp" ]]
[[ "math-internals" "fcosh" ]]
[[ "math-internals" "flog" ]]
[[ "math-internals" "fpow" ]]
[[ "math-internals" "fsin" ]]
[[ "math-internals" "fsinh" ]]
[[ "math-internals" "fsqrt" ]]
[[ "words" "<word>" ]]
[[ "words" "update-xt" ]]
[[ "profiler" "call-profiling" ]]
[[ "profiler" "allot-profiling" ]]
[[ "words" "compiled?" ]]
[[ "kernel" "drop" ]]
[[ "kernel" "dup" ]]
[[ "kernel" "swap" ]]
[[ "kernel" "over" ]]
[[ "kernel" "pick" ]]
[[ "kernel" ">r" ]]
[[ "kernel" "r>" ]]
[[ "kernel" "eq?" ]]
[[ "kernel-internals" "getenv" ]]
[[ "kernel-internals" "setenv" ]]
[[ "io-internals" "open-file" ]]
[[ "files" "stat" ]]
[[ "files" "(directory)" ]]
[[ "kernel" "garbage-collection" ]]
[[ "kernel" "gc-time" ]]
[[ "kernel" "save-image" ]]
[[ "kernel" "datastack" ]]
[[ "kernel" "callstack" ]]
[[ "kernel" "set-datastack" ]]
[[ "kernel" "set-callstack" ]]
[[ "kernel" "exit*" ]]
[[ "io-internals" "client-socket" ]]
[[ "io-internals" "server-socket" ]]
[[ "io-internals" "close-port" ]]
[[ "io-internals" "add-accept-io-task" ]]
[[ "io-internals" "accept-fd" ]]
[[ "io-internals" "can-read-line?" ]]
[[ "io-internals" "add-read-line-io-task" ]]
[[ "io-internals" "read-line-fd-8" ]]
[[ "io-internals" "can-read-count?" ]]
[[ "io-internals" "add-read-count-io-task" ]]
[[ "io-internals" "read-count-fd-8" ]]
[[ "io-internals" "can-write?" ]]
[[ "io-internals" "add-write-io-task" ]]
[[ "io-internals" "write-fd-8" ]]
[[ "io-internals" "add-copy-io-task" ]]
[[ "io-internals" "pending-io-error" ]]
[[ "io-internals" "next-io-task" ]]
[[ "kernel" "room" ]]
[[ "kernel" "os-env" ]]
[[ "kernel" "millis" ]]
[[ "random" "init-random" ]]
[[ "random" "(random-int)" ]]
[[ "kernel" "type" ]]
[[ "files" "cwd" ]]
[[ "files" "cd" ]]
[[ "assembler" "compiled-offset" ]]
[[ "assembler" "set-compiled-offset" ]]
[[ "assembler" "literal-top" ]]
[[ "assembler" "set-literal-top" ]]
[[ "kernel" "address" ]]
[[ "alien" "dlopen" ]]
[[ "alien" "dlsym" ]]
[[ "alien" "dlclose" ]]
[[ "alien" "<alien>" ]]
[[ "alien" "<local-alien>" ]]
[[ "alien" "alien-cell" ]]
[[ "alien" "set-alien-cell" ]]
[[ "alien" "alien-4" ]]
[[ "alien" "set-alien-4" ]]
[[ "alien" "alien-2" ]]
[[ "alien" "set-alien-2" ]]
[[ "alien" "alien-1" ]]
[[ "alien" "set-alien-1" ]]
[[ "kernel" "heap-stats" ]]
[[ "errors" "throw" ]]
[[ "kernel-internals" "string>memory" ]]
[[ "kernel-internals" "memory>string" ]]
[[ "alien" "local-alien?" ]]
[[ "alien" "alien-address" ]]
[[ "lists" ">cons" ]]
[[ "vectors" ">vector" ]]
[[ "strings" ">string" ]]
[[ "words" ">word" ]]
[[ "kernel-internals" "slot" ]]
[[ "kernel-internals" "set-slot" ]]
[[ "kernel-internals" "integer-slot" ]]
[[ "kernel-internals" "set-integer-slot" ]]
[[ "kernel-internals" "grow-array" ]]
] [
unswons create swap 1 + [ f define ] keep
] each drop

2
library/compiler/generator.factor
View File

@ -61,7 +61,7 @@ SYMBOL: relocation-table
#! Relocate address just compiled.
4 rel, relocating 0 rel, ;
: generate-node ( [ op | params ] -- )
: generate-node ( [[ op params ]] -- )
#! Generate machine code for a node.
unswons dup "generator" word-property [
call

12
library/compiler/optimizer.factor
View File

@ -202,18 +202,18 @@ USE: prettyprint
\ over [ 2drop t ] "can-kill" set-word-property
\ over [
[
[ [ f f ] | over ]
[ [ f t ] | dup ]
[[ [ f f ] over ]]
[[ [ f t ] dup ]]
] reduce-stack-op
] "kill-node" set-word-property
\ pick [ 2drop t ] "can-kill" set-word-property
\ pick [
[
[ [ f f f ] | pick ]
[ [ f f t ] | over ]
[ [ f t f ] | over ]
[ [ f t t ] | dup ]
[[ [ f f f ] pick ]]
[[ [ f f t ] over ]]
[[ [ f t f ] over ]]
[[ [ f t t ] dup ]]
] reduce-stack-op
] "kill-node" set-word-property

8
library/compiler/simplifier.factor
View File

@ -101,8 +101,8 @@ PREDICATE: cons return-follows #return swap follows? ;
M: return-follows simplify-call ( node rest -- rest ? )
>r
unswons [
[ #call | #jump ]
[ #call-label | #jump-label ]
[[ #call #jump ]]
[[ #call-label #jump-label ]]
] assoc swons , r> t ;
#call [ simplify-call ] "simplify" set-word-property
@ -119,8 +119,8 @@ PREDICATE: cons push-next ( list -- ? )
M: push-next simplify-drop ( node rest -- rest ? )
nip uncons >r unswons [
[ #push-immediate | #replace-immediate ]
[ #push-indirect | #replace-indirect ]
[[ #push-immediate #replace-immediate ]]
[[ #push-indirect #replace-indirect ]]
] assoc swons , r> t ;
\ drop [ simplify-drop ] "simplify" set-word-property

10
library/cons.factor
View File

@ -36,15 +36,15 @@ USE: kernel-internals
BUILTIN: cons 2
: car ( [ car | cdr ] -- car ) >cons 0 slot ; inline
: cdr ( [ car | cdr ] -- cdr ) >cons 1 slot ; inline
: car ( [[ car cdr ]] -- car ) >cons 0 slot ; inline
: cdr ( [[ car cdr ]] -- cdr ) >cons 1 slot ; inline
: swons ( cdr car -- [ car | cdr ] )
: swons ( cdr car -- [[ car cdr ]] )
#! Push a new cons cell. If the cdr is f or a proper list,
#! has the effect of prepending the car to the cdr.
swap cons ; inline
: uncons ( [ car | cdr ] -- car cdr )
: uncons ( [[ car cdr ]] -- car cdr )
#! Push both the head and tail of a list.
dup car swap cdr ; inline
@ -52,7 +52,7 @@ BUILTIN: cons 2
#! Construct a proper list of one element.
f cons ; inline
: unswons ( [ car | cdr ] -- cdr car )
: unswons ( [[ car cdr ]] -- cdr car )
#! Push both the head and tail of a list.
dup cdr swap car ; inline

4
library/generic/union.factor
View File

@ -72,8 +72,8 @@ union [ 2drop t ] "class<" set-word-property
[
[
[
[ f | POSTPONE: f ]
[ t | POSTPONE: t ]
[[ f POSTPONE: f ]]
[[ t POSTPONE: t ]]
] assoc dup
] keep ?
] map

2
library/hashtables.factor
View File

@ -50,7 +50,7 @@ PREDICATE: vector hashtable ( obj -- ? )
#! Compute the index of the bucket for a key.
>r hashcode r> vector-length rem ; inline
: hash* ( key table -- [ key | value ] )
: hash* ( key table -- [[ key value ]] )
#! Look up a value in the hashtable. First the bucket is
#! determined using the hash function, then the association
#! list therein is searched linearly.

10
library/httpd/html.factor
View File

@ -39,11 +39,11 @@ USE: generic
: html-entities ( -- alist )
[
[ CHAR: < | "&lt;" ]
[ CHAR: > | "&gt;" ]
[ CHAR: & | "&amp;" ]
[ CHAR: ' | "&apos;" ]
[ CHAR: " | "&quot;" ]
[[ CHAR: < "&lt;" ]]
[[ CHAR: > "&gt;" ]]
[[ CHAR: & "&amp;" ]]
[[ CHAR: ' "&apos;" ]]
[[ CHAR: " "&quot;" ]]
] ;
: char>entity ( ch -- str )

6
library/httpd/http-common.factor
View File

@ -50,7 +50,7 @@ USE: url-encoding
: error-head ( error -- )
dup log-error
[ [ "Content-Type" | "text/html" ] ] over response ;
[ [[ "Content-Type" "text/html" ]] ] over response ;
: httpd-error ( error -- )
#! This must be run from handle-request
@ -65,11 +65,11 @@ USE: url-encoding
] with-scope ;
: serving-html ( -- )
[ [ "Content-Type" | "text/html" ] ]
[ [[ "Content-Type" "text/html" ]] ]
"200 Document follows" response terpri ;
: serving-text ( -- )
[ [ "Content-Type" | "text/plain" ] ]
[ [[ "Content-Type" "text/plain" ]] ]
"200 Document follows" response terpri ;
: redirect ( to -- )

6
library/httpd/httpd.factor
View File

@ -56,9 +56,9 @@ USE: url-encoding
: request-method ( cmd -- method )
[
[ "GET" | "get" ]
[ "POST" | "post" ]
[ "HEAD" | "head" ]
[[ "GET" "get" ]]
[[ "POST" "post" ]]
[[ "HEAD" "head" ]]
] assoc [ "bad" ] unless* ;
: (handle-request) ( arg cmd -- url method )

2
library/httpd/responder.factor
View File

@ -46,7 +46,7 @@ USE: strings
! - raw-query -- raw query string
! - query -- an alist of query parameters, eg
! foo.bar?a=b&c=d becomes
! [ [ "a" | "b" ] [ "c" | "d" ] ]
! [ [[ "a" "b" ]] [[ "c" "d" ]] ]
! - header -- an alist of headers from the user's client
! - response -- an alist of the POST request response

10
library/inference/branches.factor
View File

@ -76,12 +76,12 @@ USE: prettyprint
unify-lengths vector-transpose [ unify-results ] vector-map ;
: balanced? ( list -- ? )
#! Check if a list of [ instack | outstack ] pairs is
#! Check if a list of [[ instack outstack ]] pairs is
#! balanced.
[ uncons vector-length swap vector-length - ] map all=? ;
: unify-effect ( list -- in out )
#! Unify a list of [ instack | outstack ] pairs.
#! Unify a list of [[ instack outstack ]] pairs.
dup balanced? [
unzip unify-stacks >r unify-stacks r>
] [
@ -136,7 +136,7 @@ SYMBOL: cloned
meta-d off meta-r off d-in off
] when ;
: propagate-type ( [ value | class ] -- )
: propagate-type ( [[ value class ]] -- )
#! Type propagation is chained.
[
unswons 2dup set-value-class
@ -155,9 +155,9 @@ SYMBOL: cloned
: (infer-branches) ( branchlist -- list )
#! The branchlist is a list of pairs:
#! [ value | typeprop ]
#! [[ value typeprop ]]
#! value is either a literal or computed instance; typeprop
#! is a pair [ value | class ] indicating a type propagation
#! is a pair [[ value class ]] indicating a type propagation
#! for the given branch.
[
[

8
library/inference/inference.factor
View File

@ -69,7 +69,7 @@ GENERIC: set-value-class ( class value -- )
! A value has the following slots in addition to those relating
! to generics above:
! An association list mapping values to [ value | class ] pairs
! An association list mapping values to [[ value class ]] pairs
SYMBOL: type-propagations
TRAITS: computed
@ -145,11 +145,11 @@ M: literal set-value-class ( class value -- )
: (present-effect) ( vector -- list )
[ value-class ] vector-map vector>list ;
: present-effect ( [ d-in | meta-d ] -- [ in-types out-types ] )
: present-effect ( [[ d-in meta-d ]] -- [ in-types out-types ] )
#! After inference is finished, collect information.
uncons >r (present-effect) r> (present-effect) 2list ;
: effect ( -- [ d-in | meta-d ] )
: effect ( -- [[ d-in meta-d ]] )
d-in get meta-d get cons ;
: init-inference ( recursive-state -- )
@ -193,7 +193,7 @@ DEFER: apply-word
infer-quot
#return values-node check-return ;
: infer ( quot -- [ in | out ] )
: infer ( quot -- [[ in out ]] )
#! Stack effect of a quotation.
[ (infer) effect present-effect ] with-scope ;

4
library/inference/words.factor
View File

@ -139,7 +139,7 @@ M: symbol (apply-word) ( word -- )
] when
] when ;
: decompose ( x y -- [ d-in | meta-d ] )
: decompose ( x y -- [[ d-in meta-d ]] )
#! Return a stack effect such that x*effect = y.
uncons >r swap uncons >r
over vector-length over vector-length -
@ -155,7 +155,7 @@ M: symbol (apply-word) ( word -- )
rethrow
] catch ;
: base-case ( word -- [ d-in | meta-d ] )
: base-case ( word -- [[ d-in meta-d ]] )
[
[
copy-inference

34
library/io/files.factor
View File

@ -50,10 +50,10 @@ USE: unparser
: file-actions ( -- list )
[
[ "Push" | "" ]
[ "Run file" | "run-file" ]
[ "List directory" | "directory." ]
[ "Change directory" | "cd" ]
[[ "Push" "" ]]
[[ "Run file" "run-file" ]]
[[ "List directory" "directory." ]]
[[ "Change directory" "cd" ]]
] ;
: set-mime-types ( assoc -- )
@ -100,20 +100,20 @@ USE: unparser
: dir. cwd directory. ;
[
[ "html" | "text/html" ]
[ "txt" | "text/plain" ]
[[ "html" "text/html" ]]
[[ "txt" "text/plain" ]]
[ "gif" | "image/gif" ]
[ "png" | "image/png" ]
[ "jpg" | "image/jpeg" ]
[ "jpeg" | "image/jpeg" ]
[[ "gif" "image/gif" ]]
[[ "png" "image/png" ]]
[[ "jpg" "image/jpeg" ]]
[[ "jpeg" "image/jpeg" ]]
[ "jar" | "application/octet-stream" ]
[ "zip" | "application/octet-stream" ]
[ "tgz" | "application/octet-stream" ]
[ "tar.gz" | "application/octet-stream" ]
[ "gz" | "application/octet-stream" ]
[[ "jar" "application/octet-stream" ]]
[[ "zip" "application/octet-stream" ]]
[[ "tgz" "application/octet-stream" ]]
[[ "tar.gz" "application/octet-stream" ]]
[[ "gz" "application/octet-stream" ]]
[ "factor" | "application/x-factor" ]
[ "factsp" | "application/x-factor-server-page" ]
[[ "factor" "application/x-factor" ]]
[[ "factsp" "application/x-factor-server-page" ]]
] set-mime-types

10
library/io/presentation.factor
View File

@ -50,15 +50,15 @@ USE: unparser
<namespace> "styles" set
[
[ "font" | "Monospaced" ]
[[ "font" "Monospaced" ]]
] "default" set-style
[
[ "bold" | t ]
[[ "bold" t ]]
] default-style append "prompt" set-style
[
[ "ansi-fg" | "0" ]
[ "ansi-bg" | "2" ]
[ "fg" | [ 255 0 0 ] ]
[[ "ansi-fg" "0" ]]
[[ "ansi-bg" "2" ]]
[[ "fg" [ 255 0 0 ] ]]
] default-style append "comments" set-style

58
library/io/vocabulary-style.factor
View File

@ -46,61 +46,61 @@ USE: words
<namespace> "vocabularies" set-style
[
[ "ansi-fg" | "1" ]
[ "fg" | [ 204 0 0 ] ]
[[ "ansi-fg" "1" ]]
[[ "fg" [ 204 0 0 ] ]]
] "arithmetic" set-vocab-style
[
[ "ansi-fg" | "1" ]
[ "fg" | [ 255 0 0 ] ]
[[ "ansi-fg" "1" ]]
[[ "fg" [ 255 0 0 ] ]]
] "errors" set-vocab-style
[
[ "ansi-fg" | "4" ]
[ "fg" | [ 153 102 255 ] ]
[[ "ansi-fg" "4" ]]
[[ "fg" [ 153 102 255 ] ]]
] "hashtables" set-vocab-style
[
[ "ansi-fg" | "2" ]
[ "fg" | [ 0 102 153 ] ]
[[ "ansi-fg" "2" ]]
[[ "fg" [ 0 102 153 ] ]]
] "lists" set-vocab-style
[
[ "ansi-fg" | "1" ]
[ "fg" | [ 204 0 0 ] ]
[[ "ansi-fg" "1" ]]
[[ "fg" [ 204 0 0 ] ]]
] "math" set-vocab-style
[
[ "ansi-fg" | "6" ]
[ "fg" | [ 0 153 255 ] ]
[[ "ansi-fg" "6" ]]
[[ "fg" [ 0 153 255 ] ]]
] "namespaces" set-vocab-style
[
[ "ansi-fg" | "2" ]
[ "fg" | [ 102 204 255 ] ]
[[ "ansi-fg" "2" ]]
[[ "fg" [ 102 204 255 ] ]]
] "parser" set-vocab-style
[
[ "ansi-fg" | "2" ]
[ "fg" | [ 102 204 255 ] ]
[[ "ansi-fg" "2" ]]
[[ "fg" [ 102 204 255 ] ]]
] "prettyprint" set-vocab-style
[
[ "ansi-fg" | "2" ]
[ "fg" | [ 0 0 0 ] ]
[[ "ansi-fg" "2" ]]
[[ "fg" [ 0 0 0 ] ]]
] "stack" set-vocab-style
[
[ "ansi-fg" | "4" ]
[ "fg" | [ 204 0 204 ] ]
[[ "ansi-fg" "4" ]]
[[ "fg" [ 204 0 204 ] ]]
] "stdio" set-vocab-style
[
[ "ansi-fg" | "4" ]
[ "fg" | [ 102 0 204 ] ]
[[ "ansi-fg" "4" ]]
[[ "fg" [ 102 0 204 ] ]]
] "streams" set-vocab-style
[
[ "ansi-fg" | "6" ]
[ "fg" | [ 255 0 204 ] ]
[[ "ansi-fg" "6" ]]
[[ "fg" [ 255 0 204 ] ]]
] "strings" set-vocab-style
[
[ "ansi-fg" | "4" ]
[ "fg" | [ 102 204 255 ] ]
[[ "ansi-fg" "4" ]]
[[ "fg" [ 102 204 255 ] ]]
] "unparser" set-vocab-style
[
[ "ansi-fg" | "3" ]
[ "fg" | [ 2 185 2 ] ]
[[ "ansi-fg" "3" ]]
[[ "fg" [ 2 185 2 ] ]]
] "vectors" set-vocab-style
[
[ "fg" | [ 128 128 128 ] ]
[[ "fg" [ 128 128 128 ] ]]
] "syntax" set-vocab-style

488
library/sdl/sdl-keysym.factor
View File

@ -34,263 +34,263 @@ USE: namespaces
SYMBOL: modifiers
[
[ "SHIFT" | HEX: 0001 ]
[ "SHIFT" | HEX: 0002 ]
[ "CTRL" | HEX: 0040 ]
[ "CTRL" | HEX: 0080 ]
[ "ALT" | HEX: 0100 ]
[ "ALT" | HEX: 0200 ]
[ "META" | HEX: 0400 ]
[ "META" | HEX: 0800 ]
[ "NUM" | HEX: 1000 ]
[ "CAPS" | HEX: 2000 ]
[ "MODE" | HEX: 4000 ]
[[ "SHIFT" HEX: 0001 ]]
[[ "SHIFT" HEX: 0002 ]]
[[ "CTRL" HEX: 0040 ]]
[[ "CTRL" HEX: 0080 ]]
[[ "ALT" HEX: 0100 ]]
[[ "ALT" HEX: 0200 ]]
[[ "META" HEX: 0400 ]]
[[ "META" HEX: 0800 ]]
[[ "NUM" HEX: 1000 ]]
[[ "CAPS" HEX: 2000 ]]
[[ "MODE" HEX: 4000 ]]
] modifiers set
SYMBOL: keysyms
{{
! The keyboard syms have been cleverly chosen to map to ASCII
[ 0 | "UNKNOWN" ]
! [ 0 | "FIRST" ]
[ 8 | "BACKSPACE" ]
[ 9 | "TAB" ]
[ 12 | "CLEAR" ]
[ 13 | "RETURN" ]
[ 19 | "PAUSE" ]
[ 27 | "ESCAPE" ]
[ 32 | "SPACE" ]
[ 33 | "EXCLAIM" ]
[ 34 | "QUOTEDBL" ]
[ 35 | "HASH" ]
[ 36 | "DOLLAR" ]
[ 38 | "AMPERSAND" ]
[ 39 | "QUOTE" ]
[ 40 | "LEFTPAREN" ]
[ 41 | "RIGHTPAREN" ]
[ 42 | "ASTERISK" ]
[ 43 | "PLUS" ]
[ 44 | "COMMA" ]
[ 45 | "MINUS" ]
[ 46 | "PERIOD" ]
[ 47 | "SLASH" ]
[ 48 | 0 ]
[ 49 | 1 ]
[ 50 | 2 ]
[ 51 | 3 ]
[ 52 | 4 ]
[ 53 | 5 ]
[ 54 | 6 ]
[ 55 | 7 ]
[ 56 | 8 ]
[ 57 | 9 ]
[ 58 | "COLON" ]
[ 59 | "SEMICOLON" ]
[ 60 | "LESS" ]
[ 61 | "EQUALS" ]
[ 62 | "GREATER" ]
[ 63 | "QUESTION" ]
[ 64 | "AT" ]
[[ 0 "UNKNOWN" ]]
! [[ 0 "FIRST" ]]
[[ 8 "BACKSPACE" ]]
[[ 9 "TAB" ]]
[[ 12 "CLEAR" ]]
[[ 13 "RETURN" ]]
[[ 19 "PAUSE" ]]
[[ 27 "ESCAPE" ]]
[[ 32 "SPACE" ]]
[[ 33 "EXCLAIM" ]]
[[ 34 "QUOTEDBL" ]]
[[ 35 "HASH" ]]
[[ 36 "DOLLAR" ]]
[[ 38 "AMPERSAND" ]]
[[ 39 "QUOTE" ]]
[[ 40 "LEFTPAREN" ]]
[[ 41 "RIGHTPAREN" ]]
[[ 42 "ASTERISK" ]]
[[ 43 "PLUS" ]]
[[ 44 "COMMA" ]]
[[ 45 "MINUS" ]]
[[ 46 "PERIOD" ]]
[[ 47 "SLASH" ]]
[[ 48 0 ]]
[[ 49 1 ]]
[[ 50 2 ]]
[[ 51 3 ]]
[[ 52 4 ]]
[[ 53 5 ]]
[[ 54 6 ]]
[[ 55 7 ]]
[[ 56 8 ]]
[[ 57 9 ]]
[[ 58 "COLON" ]]
[[ 59 "SEMICOLON" ]]
[[ 60 "LESS" ]]
[[ 61 "EQUALS" ]]
[[ 62 "GREATER" ]]
[[ 63 "QUESTION" ]]
[[ 64 "AT" ]]
! Skip uppercase letters
[ 91 | "LEFTBRACKET" ]
[ 92 | "BACKSLASH" ]
[ 93 | "RIGHTBRACKET" ]
[ 94 | "CARET" ]
[ 95 | "UNDERSCORE" ]
[ 96 | "BACKQUOTE" ]
[ 97 | "a" ]
[ 98 | "b" ]
[ 99 | "c" ]
[ 100 | "d" ]
[ 101 | "e" ]
[ 102 | "f" ]
[ 103 | "g" ]
[ 104 | "h" ]
[ 105 | "i" ]
[ 106 | "j" ]
[ 107 | "k" ]
[ 108 | "l" ]
[ 109 | "m" ]
[ 110 | "n" ]
[ 111 | "o" ]
[ 112 | "p" ]
[ 113 | "q" ]
[ 114 | "r" ]
[ 115 | "s" ]
[ 116 | "t" ]
[ 117 | "u" ]
[ 118 | "v" ]
[ 119 | "w" ]
[ 120 | "x" ]
[ 121 | "y" ]
[ 122 | "z" ]
[ 127 | "DELETE" ]
[[ 91 "LEFTBRACKET" ]]
[[ 92 "BACKSLASH" ]]
[[ 93 "RIGHTBRACKET" ]]
[[ 94 "CARET" ]]
[[ 95 "UNDERSCORE" ]]
[[ 96 "BACKQUOTE" ]]
[[ 97 "a" ]]
[[ 98 "b" ]]
[[ 99 "c" ]]
[[ 100 "d" ]]
[[ 101 "e" ]]
[[ 102 "f" ]]
[[ 103 "g" ]]
[[ 104 "h" ]]
[[ 105 "i" ]]
[[ 106 "j" ]]
[[ 107 "k" ]]
[[ 108 "l" ]]
[[ 109 "m" ]]
[[ 110 "n" ]]
[[ 111 "o" ]]
[[ 112 "p" ]]
[[ 113 "q" ]]
[[ 114 "r" ]]
[[ 115 "s" ]]
[[ 116 "t" ]]
[[ 117 "u" ]]
[[ 118 "v" ]]
[[ 119 "w" ]]
[[ 120 "x" ]]
[[ 121 "y" ]]
[[ 122 "z" ]]
[[ 127 "DELETE" ]]
! End of ASCII mapped keysyms
! International keyboard syms
[ 160 | "WORLD_0" ] ! 0xA0
[ 161 | "WORLD_1" ]
[ 162 | "WORLD_2" ]
[ 163 | "WORLD_3" ]
[ 164 | "WORLD_4" ]
[ 165 | "WORLD_5" ]
[ 166 | "WORLD_6" ]
[ 167 | "WORLD_7" ]
[ 168 | "WORLD_8" ]
[ 169 | "WORLD_9" ]
[ 170 | "WORLD_10" ]
[ 171 | "WORLD_11" ]
[ 172 | "WORLD_12" ]
[ 173 | "WORLD_13" ]
[ 174 | "WORLD_14" ]
[ 175 | "WORLD_15" ]
[ 176 | "WORLD_16" ]
[ 177 | "WORLD_17" ]
[ 178 | "WORLD_18" ]
[ 179 | "WORLD_19" ]
[ 180 | "WORLD_20" ]
[ 181 | "WORLD_21" ]
[ 182 | "WORLD_22" ]
[ 183 | "WORLD_23" ]
[ 184 | "WORLD_24" ]
[ 185 | "WORLD_25" ]
[ 186 | "WORLD_26" ]
[ 187 | "WORLD_27" ]
[ 188 | "WORLD_28" ]
[ 189 | "WORLD_29" ]
[ 190 | "WORLD_30" ]
[ 191 | "WORLD_31" ]
[ 192 | "WORLD_32" ]
[ 193 | "WORLD_33" ]
[ 194 | "WORLD_34" ]
[ 195 | "WORLD_35" ]
[ 196 | "WORLD_36" ]
[ 197 | "WORLD_37" ]
[ 198 | "WORLD_38" ]
[ 199 | "WORLD_39" ]
[ 200 | "WORLD_40" ]
[ 201 | "WORLD_41" ]
[ 202 | "WORLD_42" ]
[ 203 | "WORLD_43" ]
[ 204 | "WORLD_44" ]
[ 205 | "WORLD_45" ]
[ 206 | "WORLD_46" ]
[ 207 | "WORLD_47" ]
[ 208 | "WORLD_48" ]
[ 209 | "WORLD_49" ]
[ 210 | "WORLD_50" ]
[ 211 | "WORLD_51" ]
[ 212 | "WORLD_52" ]
[ 213 | "WORLD_53" ]
[ 214 | "WORLD_54" ]
[ 215 | "WORLD_55" ]
[ 216 | "WORLD_56" ]
[ 217 | "WORLD_57" ]
[ 218 | "WORLD_58" ]
[ 219 | "WORLD_59" ]
[ 220 | "WORLD_60" ]
[ 221 | "WORLD_61" ]
[ 222 | "WORLD_62" ]
[ 223 | "WORLD_63" ]
[ 224 | "WORLD_64" ]
[ 225 | "WORLD_65" ]
[ 226 | "WORLD_66" ]
[ 227 | "WORLD_67" ]
[ 228 | "WORLD_68" ]
[ 229 | "WORLD_69" ]
[ 230 | "WORLD_70" ]
[ 231 | "WORLD_71" ]
[ 232 | "WORLD_72" ]
[ 233 | "WORLD_73" ]
[ 234 | "WORLD_74" ]
[ 235 | "WORLD_75" ]
[ 236 | "WORLD_76" ]
[ 237 | "WORLD_77" ]
[ 238 | "WORLD_78" ]
[ 239 | "WORLD_79" ]
[ 240 | "WORLD_80" ]
[ 241 | "WORLD_81" ]
[ 242 | "WORLD_82" ]
[ 243 | "WORLD_83" ]
[ 244 | "WORLD_84" ]
[ 245 | "WORLD_85" ]
[ 246 | "WORLD_86" ]
[ 247 | "WORLD_87" ]
[ 248 | "WORLD_88" ]
[ 249 | "WORLD_89" ]
[ 250 | "WORLD_90" ]
[ 251 | "WORLD_91" ]
[ 252 | "WORLD_92" ]
[ 253 | "WORLD_93" ]
[ 254 | "WORLD_94" ]
[ 255 | "WORLD_95" ] ! 0xFF
[[ 160 "WORLD_0" ]] ! 0xA0
[[ 161 "WORLD_1" ]]
[[ 162 "WORLD_2" ]]
[[ 163 "WORLD_3" ]]
[[ 164 "WORLD_4" ]]
[[ 165 "WORLD_5" ]]
[[ 166 "WORLD_6" ]]
[[ 167 "WORLD_7" ]]
[[ 168 "WORLD_8" ]]
[[ 169 "WORLD_9" ]]
[[ 170 "WORLD_10" ]]
[[ 171 "WORLD_11" ]]
[[ 172 "WORLD_12" ]]
[[ 173 "WORLD_13" ]]
[[ 174 "WORLD_14" ]]
[[ 175 "WORLD_15" ]]
[[ 176 "WORLD_16" ]]
[[ 177 "WORLD_17" ]]
[[ 178 "WORLD_18" ]]
[[ 179 "WORLD_19" ]]
[[ 180 "WORLD_20" ]]
[[ 181 "WORLD_21" ]]
[[ 182 "WORLD_22" ]]
[[ 183 "WORLD_23" ]]
[[ 184 "WORLD_24" ]]
[[ 185 "WORLD_25" ]]
[[ 186 "WORLD_26" ]]
[[ 187 "WORLD_27" ]]
[[ 188 "WORLD_28" ]]
[[ 189 "WORLD_29" ]]
[[ 190 "WORLD_30" ]]
[[ 191 "WORLD_31" ]]
[[ 192 "WORLD_32" ]]
[[ 193 "WORLD_33" ]]
[[ 194 "WORLD_34" ]]
[[ 195 "WORLD_35" ]]
[[ 196 "WORLD_36" ]]
[[ 197 "WORLD_37" ]]
[[ 198 "WORLD_38" ]]
[[ 199 "WORLD_39" ]]
[[ 200 "WORLD_40" ]]
[[ 201 "WORLD_41" ]]
[[ 202 "WORLD_42" ]]
[[ 203 "WORLD_43" ]]
[[ 204 "WORLD_44" ]]
[[ 205 "WORLD_45" ]]
[[ 206 "WORLD_46" ]]
[[ 207 "WORLD_47" ]]
[[ 208 "WORLD_48" ]]
[[ 209 "WORLD_49" ]]
[[ 210 "WORLD_50" ]]
[[ 211 "WORLD_51" ]]
[[ 212 "WORLD_52" ]]
[[ 213 "WORLD_53" ]]
[[ 214 "WORLD_54" ]]
[[ 215 "WORLD_55" ]]
[[ 216 "WORLD_56" ]]
[[ 217 "WORLD_57" ]]
[[ 218 "WORLD_58" ]]
[[ 219 "WORLD_59" ]]
[[ 220 "WORLD_60" ]]
[[ 221 "WORLD_61" ]]
[[ 222 "WORLD_62" ]]
[[ 223 "WORLD_63" ]]
[[ 224 "WORLD_64" ]]
[[ 225 "WORLD_65" ]]
[[ 226 "WORLD_66" ]]
[[ 227 "WORLD_67" ]]
[[ 228 "WORLD_68" ]]
[[ 229 "WORLD_69" ]]
[[ 230 "WORLD_70" ]]
[[ 231 "WORLD_71" ]]
[[ 232 "WORLD_72" ]]
[[ 233 "WORLD_73" ]]
[[ 234 "WORLD_74" ]]
[[ 235 "WORLD_75" ]]
[[ 236 "WORLD_76" ]]
[[ 237 "WORLD_77" ]]
[[ 238 "WORLD_78" ]]
[[ 239 "WORLD_79" ]]
[[ 240 "WORLD_80" ]]
[[ 241 "WORLD_81" ]]
[[ 242 "WORLD_82" ]]
[[ 243 "WORLD_83" ]]
[[ 244 "WORLD_84" ]]
[[ 245 "WORLD_85" ]]
[[ 246 "WORLD_86" ]]
[[ 247 "WORLD_87" ]]
[[ 248 "WORLD_88" ]]
[[ 249 "WORLD_89" ]]
[[ 250 "WORLD_90" ]]
[[ 251 "WORLD_91" ]]
[[ 252 "WORLD_92" ]]
[[ 253 "WORLD_93" ]]
[[ 254 "WORLD_94" ]]
[[ 255 "WORLD_95" ]] ! 0xFF
! Numeric keypad
[ 256 | "KP0" ]
[ 257 | "KP1" ]
[ 258 | "KP2" ]
[ 259 | "KP3" ]
[ 260 | "KP4" ]
[ 261 | "KP5" ]
[ 262 | "KP6" ]
[ 263 | "KP7" ]
[ 264 | "KP8" ]
[ 265 | "KP9" ]
[ 266 | "KP_PERIOD" ]
[ 267 | "KP_DIVIDE" ]
[ 268 | "KP_MULTIPLY" ]
[ 269 | "KP_MINUS" ]
[ 270 | "KP_PLUS" ]
[ 271 | "KP_ENTER" ]
[ 272 | "KP_EQUALS" ]
[[ 256 "KP0" ]]
[[ 257 "KP1" ]]
[[ 258 "KP2" ]]
[[ 259 "KP3" ]]
[[ 260 "KP4" ]]
[[ 261 "KP5" ]]
[[ 262 "KP6" ]]
[[ 263 "KP7" ]]
[[ 264 "KP8" ]]
[[ 265 "KP9" ]]
[[ 266 "KP_PERIOD" ]]
[[ 267 "KP_DIVIDE" ]]
[[ 268 "KP_MULTIPLY" ]]
[[ 269 "KP_MINUS" ]]
[[ 270 "KP_PLUS" ]]
[[ 271 "KP_ENTER" ]]
[[ 272 "KP_EQUALS" ]]
! Arrows + Home/End pad
[ 273 | "UP" ]
[ 274 | "DOWN" ]
[ 275 | "RIGHT" ]
[ 276 | "LEFT" ]
[ 277 | "INSERT" ]
[ 278 | "HOME" ]
[ 279 | "END" ]
[ 280 | "PAGEUP" ]
[ 281 | "PAGEDOWN" ]
[[ 273 "UP" ]]
[[ 274 "DOWN" ]]
[[ 275 "RIGHT" ]]
[[ 276 "LEFT" ]]
[[ 277 "INSERT" ]]
[[ 278 "HOME" ]]
[[ 279 "END" ]]
[[ 280 "PAGEUP" ]]
[[ 281 "PAGEDOWN" ]]
! Function keys
[ 282 | "F1" ]
[ 283 | "F2" ]
[ 284 | "F3" ]
[ 285 | "F4" ]
[ 286 | "F5" ]
[ 287 | "F6" ]
[ 288 | "F7" ]
[ 289 | "F8" ]
[ 290 | "F9" ]
[ 291 | "F10" ]
[ 292 | "F11" ]
[ 293 | "F12" ]
[ 294 | "F13" ]
[ 295 | "F14" ]
[ 296 | "F15" ]
[[ 282 "F1" ]]
[[ 283 "F2" ]]
[[ 284 "F3" ]]
[[ 285 "F4" ]]
[[ 286 "F5" ]]
[[ 287 "F6" ]]
[[ 288 "F7" ]]
[[ 289 "F8" ]]
[[ 290 "F9" ]]
[[ 291 "F10" ]]
[[ 292 "F11" ]]
[[ 293 "F12" ]]
[[ 294 "F13" ]]
[[ 295 "F14" ]]
[[ 296 "F15" ]]
! Key state modifier keys
[ 300 | "NUMLOCK" ]
[ 301 | "CAPSLOCK" ]
[ 302 | "SCROLLOCK" ]
[ 303 | "RSHIFT" ]
[ 304 | "LSHIFT" ]
[ 305 | "RCTRL" ]
[ 306 | "LCTRL" ]
[ 307 | "RALT" ]
[ 308 | "LALT" ]
[ 309 | "RMETA" ]
[ 310 | "LMETA" ]
[ 311 | "LSUPER" ] ! Left "Windows" key
[ 312 | "RSUPER" ] ! Right "Windows" key
[ 313 | "MODE" ] ! "Alt Gr" key
[ 314 | "COMPOSE" ] ! Multi-key compose key
[[ 300 "NUMLOCK" ]]
[[ 301 "CAPSLOCK" ]]
[[ 302 "SCROLLOCK" ]]
[[ 303 "RSHIFT" ]]
[[ 304 "LSHIFT" ]]
[[ 305 "RCTRL" ]]
[[ 306 "LCTRL" ]]
[[ 307 "RALT" ]]
[[ 308 "LALT" ]]
[[ 309 "RMETA" ]]
[[ 310 "LMETA" ]]
[[ 311 "LSUPER" ]] ! Left "Windows" key
[[ 312 "RSUPER" ]] ! Right "Windows" key
[[ 313 "MODE" ]] ! "Alt Gr" key
[[ 314 "COMPOSE" ]] ! Multi-key compose key
! Miscellaneous function keys
[ 315 | "HELP" ]
[ 316 | "PRINT" ]
[ 317 | "SYSREQ" ]
[ 318 | "BREAK" ]
[ 319 | "MENU" ]
[ 320 | "POWER" ] ! Power Macintosh power key
[ 321 | "EURO" ] ! Some european keyboards
[ 322 | "UNDO" ] ! Atari keyboard has Undo
[[ 315 "HELP" ]]
[[ 316 "PRINT" ]]
[[ 317 "SYSREQ" ]]
[[ 318 "BREAK" ]]
[[ 319 "MENU" ]]
[[ 320 "POWER" ]] ! Power Macintosh power key
[[ 321 "EURO" ]] ! Some european keyboards
[[ 322 "UNDO" ]] ! Atari keyboard has Undo
! Add any other keys here
}} keysyms set

42
library/syntax/parse-syntax.factor
View File

@ -56,28 +56,27 @@ USE: unparser
! properties to the current word if it is set.
! Constants
: t t parsed ; parsing
: f f parsed ; parsing
: t t swons ; parsing
: f f swons ; parsing
! Lists
: [ f ; parsing
: ] reverse parsed ; parsing
: ] reverse swons ; parsing
: | ( syntax: | cdr ] )
#! See the word 'parsed'. We push a special sentinel, and
#! 'parsed' acts accordingly.
"|" ; parsing
! Conses (whose cdr might not be a list)
: [[ f ; parsing
: ]] 2unlist swons swons ; parsing
! Vectors
: { f ; parsing
: } reverse list>vector parsed ; parsing
: } reverse list>vector swons ; parsing
! Hashtables
: {{ f ; parsing
: }} alist>hash parsed ; parsing
: }} alist>hash swons ; parsing
! Do not execute parsing word
: POSTPONE: ( -- ) scan-word parsed ; parsing
: POSTPONE: ( -- ) scan-word swons ; parsing
: :
#! Begin a word definition. Word name follows.
@ -95,7 +94,7 @@ USE: unparser
: \
#! Parsed as a piece of code that pushes a word on the stack
#! \ foo ==> [ foo ] car
scan-word unit parsed \ car parsed ; parsing
scan-word unit swons \ car swons ; parsing
! Vocabularies
: DEFER:
@ -112,7 +111,7 @@ USE: unparser
scan dup "use" cons@ "in" set ; parsing
! Char literal
: CHAR: ( -- ) next-word-ch parse-ch parsed ; parsing
: CHAR: ( -- ) next-word-ch parse-ch swons ; parsing
! String literal
: parse-string ( -- )
@ -126,11 +125,14 @@ USE: unparser
#! Note the ugly hack to carry the new value of 'pos' from
#! the make-string scope up to the original scope.
[ parse-string "col" get ] make-string
swap "col" set parsed ; parsing
swap "col" set swons ; parsing
: expect ( word -- )
dup scan = [ drop ] [ "Expected " swap cat2 throw ] ifte ;
: #{
#! Complex literal - #{ real imaginary #}
scan str>number scan str>number rect> "}" expect parsed ;
scan str>number scan str>number rect> "}" expect swons ;
parsing
! Comments
@ -148,11 +150,11 @@ USE: unparser
! Reading numbers in other bases
: BASE: ( base -- )
: (BASE) ( base -- )
#! Read a number in a specific base.
scan swap base> parsed ;
scan swap base> swons ;
: HEX: 16 BASE: ; parsing
: DEC: 10 BASE: ; parsing
: OCT: 8 BASE: ; parsing
: BIN: 2 BASE: ; parsing
: HEX: 16 (BASE) ; parsing
: DEC: 10 (BASE) ; parsing
: OCT: 8 (BASE) ; parsing
: BIN: 2 (BASE) ; parsing

30
library/syntax/parser.factor
View File

@ -118,20 +118,10 @@ USE: unparser
dup "use" get search [ str>number ] ?unless
] when ;
: parsed| ( parsed parsed obj -- parsed )
#! Some ugly ugly code to handle [ a | b ] expressions.
>r unswons r> cons swap [ swons ] each swons ;
: expect ( word -- )
dup scan = [ drop ] [ "Expected " swap cat2 throw ] ifte ;
: parsed ( obj -- )
over "|" = [ nip parsed| "]" expect ] [ swons ] ifte ;
: (parse) ( str -- )
[
scan-word [
dup parsing? [ execute ] [ parsed ] ifte
dup parsing? [ execute ] [ swons ] ifte
] when*
] with-parser ;
@ -185,15 +175,15 @@ USE: unparser
: ascii-escape>ch ( ch -- esc )
[
[ CHAR: e | CHAR: \e ]
[ CHAR: n | CHAR: \n ]
[ CHAR: r | CHAR: \r ]
[ CHAR: t | CHAR: \t ]
[ CHAR: s | CHAR: \s ]
[ CHAR: \s | CHAR: \s ]
[ CHAR: 0 | CHAR: \0 ]
[ CHAR: \\ | CHAR: \\ ]
[ CHAR: \" | CHAR: \" ]
[[ CHAR: e CHAR: \e ]]
[[ CHAR: n CHAR: \n ]]
[[ CHAR: r CHAR: \r ]]
[[ CHAR: t CHAR: \t ]]
[[ CHAR: s CHAR: \s ]]
[[ CHAR: \s CHAR: \s ]]
[[ CHAR: 0 CHAR: \0 ]]
[[ CHAR: \\ CHAR: \\ ]]
[[ CHAR: \" CHAR: \" ]]
] assoc ;
: escape ( ch -- esc )

29
library/syntax/prettyprint.factor
View File

@ -89,11 +89,11 @@ M: object prettyprint* ( indent obj -- indent )
: word-actions ( search -- list )
[
[ "See" | "see" ]
[ "Push" | "" ]
[ "Execute" | "execute" ]
[ "jEdit" | "jedit" ]
[ "Usages" | "usages." ]
[[ "See" "see" ]]
[[ "Push" "" ]]
[[ "Execute" "execute" ]]
[[ "jEdit" "jedit" ]]
[[ "Usages" "usages." ]]
] ;
: word-attrs ( word -- attrs )
@ -118,21 +118,16 @@ M: word prettyprint* ( indent word -- indent )
: prettyprint-list ( indent list -- indent )
#! Pretty-print a list, without [ and ].
[
uncons >r prettyprint-element r>
dup cons? [
prettyprint-list
] [
[
\ | prettyprint*
" " write prettyprint-element
] when*
] ifte
] when* ;
[ prettyprint-element ] each ;
M: cons prettyprint* ( indent list -- indent )
M: list prettyprint* ( indent list -- indent )
swap prettyprint-[ swap prettyprint-list prettyprint-] ;
M: cons prettyprint* ( indent cons -- indent )
\ [[ prettyprint* " " write
uncons >r prettyprint-element r> prettyprint-element
\ ]] prettyprint* ;
: prettyprint-{ ( indent -- indent )
\ { prettyprint* <prettyprint ;

6
library/syntax/see.factor
View File

@ -40,9 +40,9 @@ USE: words
! Prettyprinting words
: vocab-actions ( search -- list )
[
[ "Words" | "words." ]
[ "Use" | "\"use\" cons@" ]
[ "In" | "\"in\" set" ]
[[ "Words" "words." ]]
[[ "Use" "\"use\" cons@" ]]
[[ "In" "\"in\" set" ]]
] ;
: vocab-attrs ( vocab -- attrs )

14
library/syntax/unparser.factor
View File

@ -103,13 +103,13 @@ M: complex unparse ( num -- str )
: ch>ascii-escape ( ch -- esc )
[
[ CHAR: \e | "\\e" ]
[ CHAR: \n | "\\n" ]
[ CHAR: \r | "\\r" ]
[ CHAR: \t | "\\t" ]
[ CHAR: \0 | "\\0" ]
[ CHAR: \\ | "\\\\" ]
[ CHAR: \" | "\\\"" ]
[[ CHAR: \e "\\e" ]]
[[ CHAR: \n "\\n" ]]
[[ CHAR: \r "\\r" ]]
[[ CHAR: \t "\\t" ]]
[[ CHAR: \0 "\\0" ]]
[[ CHAR: \\ "\\\\" ]]
[[ CHAR: \" "\\\"" ]]
] assoc ;
: ch>unicode-escape ( ch -- esc )

4
library/test/alien.factor
View File

@ -14,9 +14,9 @@ USE: inference
: alien-inference-1
"void" "foobar" "boo" [ "short" "short" ] alien-invoke ;
[ [ 2 | 0 ] ] [ [ alien-inference-1 ] infer old-effect ] unit-test
[ [[ 2 0 ]] ] [ [ alien-inference-1 ] infer old-effect ] unit-test
: alien-inference-2
"int" "foobar" "boo" [ "short" "short" ] alien-invoke ;
[ [ 2 | 1 ] ] [ [ alien-inference-2 ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ alien-inference-2 ] infer old-effect ] unit-test

1
library/test/benchmark/sort.factor
View File

@ -2,6 +2,7 @@ IN: scratchpad
USE: lists
USE: kernel
USE: math
USE: namespaces
USE: random
USE: test
USE: compiler

1
library/test/benchmark/strings.factor
View File

@ -3,6 +3,7 @@ USE: kernel
USE: math
USE: test
USE: lists
USE: namespaces
USE: compiler
! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html

18
library/test/compiler/optimizer.factor
View File

@ -9,12 +9,12 @@ USE: lists
: foo 1 2 3 ;
[ [ ] ] [ \ foo word-parameter dataflow kill-set ] unit-test
[ [ [ + ] [ - ] ] ] [ [ 3 4 1 2 > [ + ] [ - ] ifte ] dataflow kill-set ] unit-test
[ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test
[ [ [ 1 ] [ 2 ] ] ] [ [ t [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test
[ [ t t f ] ] [ [ 1 2 ] [ 1 2 3 ] [ f <literal> ] map kill-mask ] unit-test
! [ [ ] ] [ \ foo word-parameter dataflow kill-set ] unit-test
!
! [ [ [ + ] [ - ] ] ] [ [ 3 4 1 2 > [ + ] [ - ] ifte ] dataflow kill-set ] unit-test
!
! [ [ [ 1 ] [ 2 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test
!
! [ [ [ 1 ] [ 2 ] ] ] [ [ t [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test
!
! [ [ t t f ] ] [ [ 1 2 ] [ 1 2 3 ] [ f <literal> ] map kill-mask ] unit-test

24
library/test/compiler/simplifier.factor
View File

@ -7,35 +7,35 @@ USE: kernel
[ [ ] ] [ [ ] simplify ] unit-test
[ [ [ #return ] ] ] [ [ [ #return ] ] simplify ] unit-test
[ [ #jump | car ] ] [ [ [ #call | car ] [ #return ] ] simplify car ] unit-test
[ [[ #jump car ]] ] [ [ [[ #call car ]] [ #return ] ] simplify car ] unit-test
[ [ [ #return ] ] ]
[ 123 [ [ #call | car ] [ #label | 123 ] [ #return ] ] find-label ]
[ 123 [ [[ #call car ]] [[ #label 123 ]] [ #return ] ] find-label ]
unit-test
[ [ [ #return ] ] ]
[ [ [ #label | 123 ] [ #return ] ] follow ]
[ [ [[ #label 123 ]] [ #return ] ] follow ]
unit-test
[ [ [ #return ] ] ]
[
[
[ #jump-label | 123 ]
[ #call | car ]
[ #label | 123 ]
[[ #jump-label 123 ]]
[[ #call car ]]
[[ #label 123 ]]
[ #return ]
] follow
]
unit-test
[
[ #jump | car ]
[[ #jump car ]]
]
[
[
[ #call | car ]
[ #jump-label | 123 ]
[ #label | 123 ]
[[ #call car ]]
[[ #jump-label 123 ]]
[[ #label 123 ]]
[ #return ]
] simplify car
] unit-test
@ -44,13 +44,13 @@ unit-test
t
] [
[
[ #push-immediate | 1 ]
[[ #push-immediate 1 ]]
] push-next? >boolean
] unit-test
[
[
[ #replace-immediate | 1 ]
[[ #replace-immediate 1 ]]
[ #return ]
]
] [

10
library/test/dataflow.factor
View File

@ -58,7 +58,7 @@ USE: generic
#ifte swap dataflow-contains-op? car [ node-consume-d get ] bind ;
[ t ] [
[ 2 [ swap ] [ nip "hi" ] ifte ] dataflow
[ [ swap ] [ nip "hi" ] ifte ] dataflow
dataflow-ifte-node-consume-d length 1 =
] unit-test
@ -77,8 +77,8 @@ SYMBOL: #test
[ 6 ] [
{{
[ node-op | #test ]
[ node-param | 5 ]
[[ node-op #test ]]
[[ node-param 5 ]]
}} "foobar" [ [ node-param get ] bind 1 + ] apply-dataflow
] unit-test
@ -86,8 +86,8 @@ SYMBOL: #test
[ 25 ] [
{{
[ node-op | #test ]
[ node-param | 5 ]
[[ node-op #test ]]
[[ node-param 5 ]]
}} "foobar" [ [ node-param get ] bind 1 + ] apply-dataflow
] unit-test

6
library/test/generic.factor
View File

@ -86,8 +86,8 @@ M: f bool>str drop "false" ;
: str>bool
[
[ "true" | t ]
[ "false" | f ]
[[ "true" t ]]
[[ "false" f ]]
] assoc ;
[ t ] [ t bool>str str>bool ] unit-test
@ -99,7 +99,7 @@ GENERIC: funny-length
M: cons funny-length drop 0 ;
M: nonempty-list funny-length length ;
[ 0 ] [ [ 1 2 | 3 ] funny-length ] unit-test
[ 0 ] [ [[ 1 [[ 2 3 ]] ]] funny-length ] unit-test
[ 3 ] [ [ 1 2 3 ] funny-length ] unit-test
[ "hello" funny-length ] unit-test-fails

12
library/test/hashtables.factor
View File

@ -22,13 +22,13 @@ unit-test
unit-test
[ f ]
[ [ 1 2 | 3 ] hashtable? ]
[ [[ 1 [[ 2 3 ]] ]] hashtable? ]
unit-test
! Test some hashcodes.
[ t ] [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test
[ t ] [ [ f | t ] hashcode [ f | t ] hashcode = ] unit-test
[ t ] [ [[ f t ]] hashcode [[ f t ]] hashcode = ] unit-test
[ t ] [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
[ t ] [ 12 hashcode 12 hashcode = ] unit-test
@ -48,10 +48,10 @@ f 100 fac "testhash" get set-hash
[ { } ] [ { [ { } ] } vector-clone "testhash" get hash* cdr ] unit-test
[
[ "salmon" | "fish" ]
[ "crocodile" | "reptile" ]
[ "cow" | "mammal" ]
[ "visual basic" | "language" ]
[[ "salmon" "fish" ]]
[[ "crocodile" "reptile" ]]
[[ "cow" "mammal" ]]
[[ "visual basic" "language" ]]
] alist>hash "testhash" set
[ f ] [

6
library/test/httpd/html.factor
View File

@ -23,7 +23,7 @@ USE: kernel
[
[
""
[ [ "icon" | "library/icons/File.png" ] ]
[ [[ "icon" "library/icons/File.png" ]] ]
[ drop ] icon-tag
] with-string
] unit-test
@ -38,7 +38,7 @@ USE: kernel
[ "<span style='color: #ff00ff; font-family: Monospaced; '>car</span>" ]
[
[
[ [ "fg" 255 0 255 ] [ "font" | "Monospaced" ] ]
[ [ "fg" 255 0 255 ] [[ "font" "Monospaced" ]] ]
[ drop "car" write ]
span-tag
] with-string
@ -56,7 +56,7 @@ USE: kernel
[
[
"car"
[ [ "fg" 255 0 255 ] [ "font" | "Monospaced" ] ]
[ [ "fg" 255 0 255 ] [[ "font" "Monospaced" ]] ]
html-write-attr
] with-string
] unit-test

12
library/test/httpd/httpd.factor
View File

@ -20,12 +20,12 @@ USE: lists
[
[
[ "X-Spyware-Requested" | "yes" ]
[ "User-Agent" | "Internet Explorer 0.4alpha" ]
[[ "X-Spyware-Requested" "yes" ]]
[[ "User-Agent" "Internet Explorer 0.4alpha" ]]
]
]
[
[ [ "User-Agent" | "Internet Explorer 0.4alpha" ] ]
[ [[ "User-Agent" "Internet Explorer 0.4alpha" ]] ]
"X-Spyware-Requested: yes" header-line
] unit-test
@ -67,12 +67,12 @@ USE: lists
[ ] [ "GET ../index.html" parse-request ] unit-test
[ ] [ "POO" parse-request ] unit-test
[ [ [ "Foo" | "Bar" ] ] ] [ "Foo=Bar" query>alist ] unit-test
[ [ [[ "Foo" "Bar" ]] ] ] [ "Foo=Bar" query>alist ] unit-test
[ [ [ "Foo" | "Bar" ] [ "Baz" | "Quux" ] ] ]
[ [ [[ "Foo" "Bar" ]] [[ "Baz" "Quux" ]] ] ]
[ "Foo=Bar&Baz=Quux" query>alist ] unit-test
[ [ [ "Baz" | " " ] ] ]
[ [ [[ "Baz" " " ]] ] ]
[ "Baz=%20" query>alist ] unit-test
[ [ [ "Foo" ] ] ] [ "Foo" query>alist ] unit-test

126
library/test/inference.factor
View File

@ -29,25 +29,25 @@ USE: generic
! decompose
! ] unit-test
: old-effect ( [ in-types out-types ] -- [ in | out ] )
: old-effect ( [ in-types out-types ] -- [[ in out ]] )
uncons car length >r length r> cons ;
[ [ 0 | 2 ] ] [ [ 2 "Hello" ] infer old-effect ] unit-test
[ [ 1 | 2 ] ] [ [ dup ] infer old-effect ] unit-test
[ [[ 0 2 ]] ] [ [ 2 "Hello" ] infer old-effect ] unit-test
[ [[ 1 2 ]] ] [ [ dup ] infer old-effect ] unit-test
[ [ 1 | 2 ] ] [ [ [ dup ] call ] infer old-effect ] unit-test
[ [[ 1 2 ]] ] [ [ [ dup ] call ] infer old-effect ] unit-test
[ [ call ] infer old-effect ] unit-test-fails
[ [ 2 | 4 ] ] [ [ 2dup ] infer old-effect ] unit-test
[ [ 2 | 0 ] ] [ [ vector-push ] infer old-effect ] unit-test
[ [[ 2 4 ]] ] [ [ 2dup ] infer old-effect ] unit-test
[ [[ 2 0 ]] ] [ [ vector-push ] infer old-effect ] unit-test
[ [ 1 | 0 ] ] [ [ [ ] [ ] ifte ] infer old-effect ] unit-test
[ [[ 1 0 ]] ] [ [ [ ] [ ] ifte ] infer old-effect ] unit-test
[ [ ifte ] infer old-effect ] unit-test-fails
[ [ [ ] ifte ] infer old-effect ] unit-test-fails
[ [ [ 2 ] [ ] ifte ] infer old-effect ] unit-test-fails
[ [ 4 | 3 ] ] [ [ [ rot ] [ -rot ] ifte ] infer old-effect ] unit-test
[ [[ 4 3 ]] ] [ [ [ rot ] [ -rot ] ifte ] infer old-effect ] unit-test
[ [ 4 | 3 ] ] [
[ [[ 4 3 ]] ] [
[
[
[ swap 3 ] [ nip 5 5 ] ifte
@ -57,14 +57,14 @@ USE: generic
] infer old-effect
] unit-test
[ [ 1 | 1 ] ] [ [ dup [ ] when ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ dup [ dup fixnum* ] when ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ [ dup fixnum* ] when ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ dup [ ] when ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ dup [ dup fixnum* ] when ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ [ dup fixnum* ] when ] infer old-effect ] unit-test
[ [ 1 | 0 ] ] [ [ [ drop ] when* ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ [ { { [ ] } } ] unless* ] infer old-effect ] unit-test
[ [[ 1 0 ]] ] [ [ [ drop ] when* ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ [ { { [ ] } } ] unless* ] infer old-effect ] unit-test
[ [ 0 | 1 ] ] [
[ [[ 0 1 ]] ] [
[ [ 2 2 fixnum+ ] dup [ ] when call ] infer old-effect
] unit-test
@ -79,12 +79,12 @@ USE: generic
: simple-recursion-1
dup [ simple-recursion-1 ] [ ] ifte ;
[ [ 1 | 1 ] ] [ [ simple-recursion-1 ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ simple-recursion-1 ] infer old-effect ] unit-test
: simple-recursion-2
dup [ ] [ simple-recursion-2 ] ifte ;
[ [ 1 | 1 ] ] [ [ simple-recursion-2 ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ simple-recursion-2 ] infer old-effect ] unit-test
! : bad-recursion-1
! dup [ drop bad-recursion-1 5 ] [ ] ifte ;
@ -101,10 +101,10 @@ USE: generic
: funny-recursion
dup [ funny-recursion 1 ] [ 2 ] ifte drop ;
[ [ 1 | 1 ] ] [ [ funny-recursion ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ funny-recursion ] infer old-effect ] unit-test
! Simple combinators
[ [ 1 | 2 ] ] [ [ [ car ] keep cdr ] infer old-effect ] unit-test
[ [[ 1 2 ]] ] [ [ [ car ] keep cdr ] infer old-effect ] unit-test
! Mutual recursion
DEFER: foe
@ -127,8 +127,8 @@ DEFER: foe
2drop f
] ifte ;
[ [ 2 | 1 ] ] [ [ fie ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ foe ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ fie ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ foe ] infer old-effect ] unit-test
! This form should not have a stack effect
! : bad-bin 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] ifte ;
@ -141,7 +141,7 @@ DEFER: foe
] when
] when ;
[ [ 0 | 0 ] ] [ [ nested-when ] infer old-effect ] unit-test
[ [[ 0 0 ]] ] [ [ nested-when ] infer old-effect ] unit-test
: nested-when* ( -- )
[
@ -150,55 +150,55 @@ DEFER: foe
] when*
] when* ;
[ [ 1 | 0 ] ] [ [ nested-when* ] infer old-effect ] unit-test
[ [[ 1 0 ]] ] [ [ nested-when* ] infer old-effect ] unit-test
SYMBOL: sym-test
[ [ 0 | 1 ] ] [ [ sym-test ] infer old-effect ] unit-test
[ [[ 0 1 ]] ] [ [ sym-test ] infer old-effect ] unit-test
[ [ 2 | 0 ] ] [ [ set-vector-length ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ 2list ] infer old-effect ] unit-test
[ [ 3 | 1 ] ] [ [ 3list ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ append ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ swons ] infer old-effect ] unit-test
[ [ 1 | 2 ] ] [ [ uncons ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ unit ] infer old-effect ] unit-test
[ [ 1 | 2 ] ] [ [ unswons ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ last* ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ last ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ list? ] infer old-effect ] unit-test
[ [[ 2 0 ]] ] [ [ set-vector-length ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ 2list ] infer old-effect ] unit-test
[ [[ 3 1 ]] ] [ [ 3list ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ append ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ swons ] infer old-effect ] unit-test
[ [[ 1 2 ]] ] [ [ uncons ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ unit ] infer old-effect ] unit-test
[ [[ 1 2 ]] ] [ [ unswons ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ last* ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ last ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ list? ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ length ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ reverse ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ contains? ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ tree-contains? ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ remove ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ prune ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ length ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ reverse ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ contains? ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ tree-contains? ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ remove ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ prune ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ bitor ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ bitand ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ bitxor ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ mod ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ /i ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ /f ] infer old-effect ] unit-test
[ [ 2 | 2 ] ] [ [ /mod ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ + ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ - ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ * ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ / ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ < ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ <= ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ > ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ >= ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ number= ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ bitor ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ bitand ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ bitxor ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ mod ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ /i ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ /f ] infer old-effect ] unit-test
[ [[ 2 2 ]] ] [ [ /mod ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ + ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ - ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ * ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ / ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ < ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ <= ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ > ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ >= ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ number= ] infer old-effect ] unit-test
[ [ 2 | 1 ] ] [ [ = ] infer old-effect ] unit-test
[ [[ 2 1 ]] ] [ [ = ] infer old-effect ] unit-test
[ [ 1 | 0 ] ] [ [ >n ] infer old-effect ] unit-test
[ [ 0 | 1 ] ] [ [ n> ] infer old-effect ] unit-test
[ [[ 1 0 ]] ] [ [ >n ] infer old-effect ] unit-test
[ [[ 0 1 ]] ] [ [ n> ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ get ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ get ] infer old-effect ] unit-test
: terminator-branch
dup [
@ -207,9 +207,9 @@ SYMBOL: sym-test
not-a-number
] ifte ;
[ [ 1 | 1 ] ] [ [ terminator-branch ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ terminator-branch ] infer old-effect ] unit-test
[ [ 1 | 1 ] ] [ [ str>number ] infer old-effect ] unit-test
[ [[ 1 1 ]] ] [ [ str>number ] infer old-effect ] unit-test
! Type inference

2
library/test/interpreter.factor
View File

@ -33,7 +33,7 @@ USE: kernel
] unit-test
[ { "Hey" "there" } ] [
[ [ "Hey" | "there" ] uncons ] test-interpreter
[ [[ "Hey" "there" ]] uncons ] test-interpreter
] unit-test
[ { t } ] [

20
library/test/lists/assoc.factor
View File

@ -5,16 +5,16 @@ USE: namespaces
USE: test
[
[ "monkey" | 1 ]
[ "banana" | 2 ]
[ "Java" | 3 ]
[ t | "true" ]
[ f | "false" ]
[ [ 1 2 ] | [ 2 1 ] ]
[[ "monkey" 1 ]]
[[ "banana" 2 ]]
[[ "Java" 3 ]]
[[ t "true" ]]
[[ f "false" ]]
[[ [ 1 2 ] [ 2 1 ] ]]
] "assoc" set
[ t ] [ "assoc" get assoc? ] unit-test
[ f ] [ [ 1 2 3 | 4 ] assoc? ] unit-test
[ f ] [ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] assoc? ] unit-test
[ f ] [ "assoc" assoc? ] unit-test
[ f ] [ "monkey" f assoc ] unit-test
@ -28,9 +28,9 @@ USE: test
[ "is great" ] [ "Java" "assoc" get assoc ] unit-test
[
[ "one" | 1 ]
[ "two" | 2 ]
[ "four" | 4 ]
[[ "one" 1 ]]
[[ "two" 2 ]]
[[ "four" 4 ]]
] "value-alist" set
[

20
library/test/lists/cons.factor
View File

@ -7,28 +7,28 @@ USE: test
[ f ] [ f cons? ] unit-test
[ f ] [ t cons? ] unit-test
[ t ] [ [ t | f ] cons? ] unit-test
[ t ] [ [[ t f ]] cons? ] unit-test
[ [ 1 | 2 ] ] [ 1 2 cons ] unit-test
[ [[ 1 2 ]] ] [ 1 2 cons ] unit-test
[ [ 1 ] ] [ 1 f cons ] unit-test
[ [ 1 | 2 ] ] [ 2 1 swons ] unit-test
[ [[ 1 2 ]] ] [ 2 1 swons ] unit-test
[ [ 1 ] ] [ f 1 swons ] unit-test
[ [ [ [ ] ] ] ] [ [ ] unit unit ] unit-test
[ 1 ] [ [ 1 | 2 ] car ] unit-test
[ 2 ] [ [ 1 | 2 ] cdr ] unit-test
[ 1 ] [ [[ 1 2 ]] car ] unit-test
[ 2 ] [ [[ 1 2 ]] cdr ] unit-test
[ 1 2 ] [ [ 1 | 2 ] uncons ] unit-test
[ 1 2 ] [ [[ 1 2 ]] uncons ] unit-test
[ 1 [ 2 ] ] [ [ 1 2 ] uncons ] unit-test
[ 1 2 ] [ [ 2 | 1 ] unswons ] unit-test
[ 1 2 ] [ [[ 2 1 ]] unswons ] unit-test
[ [ 2 ] 1 ] [ [ 1 2 ] unswons ] unit-test
[ [ 1 2 ] ] [ 1 2 2list ] unit-test
[ [ 1 2 3 ] ] [ 1 2 3 3list ] unit-test
[ 1 3 ] [ [ 1 | 2 ] [ 3 | 4 ] 2car ] unit-test
[ 2 4 ] [ [ 1 | 2 ] [ 3 | 4 ] 2cdr ] unit-test
[ 1 3 2 4 ] [ [ 1 | 2 ] [ 3 | 4 ] 2uncons ] unit-test
[ 1 3 ] [ [[ 1 2 ]] [[ 3 4 ]] 2car ] unit-test
[ 2 4 ] [ [[ 1 2 ]] [[ 3 4 ]] 2cdr ] unit-test
[ 1 3 2 4 ] [ [[ 1 2 ]] [[ 3 4 ]] 2uncons ] unit-test

10
library/test/lists/lists.factor
View File

@ -10,7 +10,7 @@ USE: strings
[ [ 1 ] ] [ [ 1 ] [ ] append ] unit-test
[ [ 2 ] ] [ [ ] [ 2 ] append ] unit-test
[ [ 1 2 3 4 ] ] [ [ 1 2 3 ] [ 4 ] append ] unit-test
[ [ 1 2 3 | 4 ] ] [ [ 1 2 3 ] 4 append ] unit-test
[ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] ] [ [ 1 2 3 ] 4 append ] unit-test
[ f ] [ 3 [ ] contains? ] unit-test
[ f ] [ 3 [ 1 2 ] contains? ] unit-test
@ -19,11 +19,11 @@ USE: strings
[ [ 3 ] ] [ [ 3 ] last* ] unit-test
[ [ 3 ] ] [ [ 1 2 3 ] last* ] unit-test
[ [ 3 | 4 ] ] [ [ 1 2 3 | 4 ] last* ] unit-test
[ [[ 3 4 ]] ] [ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] last* ] unit-test
[ 3 ] [ [ 3 ] last ] unit-test
[ 3 ] [ [ 1 2 3 ] last ] unit-test
[ 3 ] [ [ 1 2 3 | 4 ] last ] unit-test
[ 3 ] [ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] last ] unit-test
[ 0 ] [ [ ] length ] unit-test
[ 3 ] [ [ 1 2 3 ] length ] unit-test
@ -31,7 +31,7 @@ USE: strings
[ t ] [ f list? ] unit-test
[ f ] [ t list? ] unit-test
[ t ] [ [ 1 2 ] list? ] unit-test
[ f ] [ [ 1 | 2 ] list? ] unit-test
[ f ] [ [[ 1 2 ]] list? ] unit-test
[ [ ] ] [ 1 [ ] remove ] unit-test
[ [ ] ] [ 1 [ 1 ] remove ] unit-test
@ -49,7 +49,7 @@ USE: strings
[ f ] [ 3 [ 1 [ 3 ] 2 ] tree-contains? not ] unit-test
[ f ] [ 1 [ [ [ 1 ] ] 2 ] tree-contains? not ] unit-test
[ f ] [ 2 [ 1 2 ] tree-contains? not ] unit-test
[ f ] [ 3 [ 1 2 | 3 ] tree-contains? not ] unit-test
[ f ] [ 3 [[ 1 [[ 2 3 ]] ]] tree-contains? not ] unit-test
[ [ ] ] [ 0 count ] unit-test
[ [ ] ] [ -10 count ] unit-test

4
library/test/lists/namespaces.factor
View File

@ -4,10 +4,10 @@ USE: namespaces
USE: test
[ [ 1 ] ] [ 1 f ] [ "x" set "x" cons@ "x" get ] test-word
[ [ 1 | 2 ] ] [ 1 2 ] [ "x" set "x" cons@ "x" get ] test-word
[ [[ 1 2 ]] ] [ 1 2 ] [ "x" set "x" cons@ "x" get ] test-word
[ [ 1 2 ] ] [ 1 [ 2 ] ] [ "x" set "x" cons@ "x" get ] test-word
[ [ [ 2 | 3 ] [ 1 | 2 ] ] ] [
[ [ [[ 2 3 ]] [[ 1 2 ]] ] ] [
"x" off 2 1 "x" [ acons ] change 3 2 "x" [ acons ] change "x" get
] unit-test

6
library/test/parser.factor
View File

@ -56,9 +56,9 @@ test-word
! Test improper lists
[ 2 ] [ "[ 1 | 2 ]" parse car cdr ] unit-test
[ "hello" ] [ "[ 1 | \"hello\" ]" parse car cdr ] unit-test
[ #{ 1 2 } ] [ "[ 1 | #{ 1 2 } ]" parse car cdr ] unit-test
[ 2 ] [ "[[ 1 2 ]]" parse car cdr ] unit-test
[ "hello" ] [ "[[ 1 \"hello\" ]]" parse car cdr ] unit-test
[ #{ 1 2 } ] [ "[[ 1 #{ 1 2 } ]]" parse car cdr ] unit-test
! Test EOL comments in multiline strings.
[ [ "Hello" ] ] [ "#! This calls until-eol.\n\"Hello\"" parse ] unit-test

2
library/test/styles.factor
View File

@ -10,7 +10,7 @@ USE: test
] unit-test
[ "Sans-Serif" ] [
[
[ "font" | "Sans-Serif" ]
[[ "font" "Sans-Serif" ]]
] "fooquux" set-style
"font" "fooquux" style assoc
] unit-test

2
library/test/vectors.factor
View File

@ -60,7 +60,7 @@ unit-test
[ { 1 2 3 4 } { 5 6 7 8 } vector-zip [ uncons + ] vector-map ]
unit-test
[ { [ 1 | 5 ] [ 2 | 6 ] [ 3 | 7 ] [ 4 | 8 ] } ]
[ { [[ 1 5 ]] [[ 2 6 ]] [[ 3 7 ]] [[ 4 8 ]] } ]
[ { 1 2 3 4 } { 5 6 7 8 } vector-zip ]
unit-test

14
library/ui/console.factor
View File

@ -228,13 +228,13 @@ PREDICATE: alien key-down-event
SYMBOL: keymap
{{
[ [ "RETURN" ] | [ return-key ] ]
[ [ "BACKSPACE" ] | [ input-line get [ backspace ] bind ] ]
[ [ "LEFT" ] | [ input-line get [ left ] bind ] ]
[ [ "RIGHT" ] | [ input-line get [ right ] bind ] ]
[ [ "UP" ] | [ input-line get [ history-prev ] bind ] ]
[ [ "DOWN" ] | [ input-line get [ history-next ] bind ] ]
[ [ "CTRL" "k" ] | [ input-line get [ line-clear ] bind ] ]
[[ [ "RETURN" ] [ return-key ] ]]
[[ [ "BACKSPACE" ] [ input-line get [ backspace ] bind ] ]]
[[ [ "LEFT" ] [ input-line get [ left ] bind ] ]]
[[ [ "RIGHT" ] [ input-line get [ right ] bind ] ]]
[[ [ "UP" ] [ input-line get [ history-prev ] bind ] ]]
[[ [ "DOWN" ] [ input-line get [ history-next ] bind ] ]]
[[ [ "CTRL" "k" ] [ input-line get [ line-clear ] bind ] ]]
}} keymap set
M: key-down-event handle-event ( event -- ? )

2
library/win32/win32-errors.factor
View File

@ -37,7 +37,7 @@ USE: alien
USE: words
: CONSTANT: CREATE
[ [ [ parsed ] each ] cons define-compound POSTPONE: parsing ]
[ [ [ swons ] each ] cons define-compound POSTPONE: parsing ]
[ ] ; parsing
CONSTANT: ERROR_SUCCESS 0 ;