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 -- ) : write-highlighted ( line -- )
dup nickname get index-of -1 = dup nickname get index-of -1 =
f [ [ "ansi-fg" | "3" ] ] ? write-attr ; f [ [[ "ansi-fg" "3" ]] ] ? write-attr ;
: extract-nick ( line -- nick ) : extract-nick ( line -- nick )
"!" split1 drop ; "!" split1 drop ;
: write-nick ( line -- ) : write-nick ( line -- )
"!" split1 drop [ [ "bold" | t ] ] write-attr ; "!" split1 drop [ [[ "bold" t ]] ] write-attr ;
GENERIC: irc-display GENERIC: irc-display
PREDICATE: string privmsg "PRIVMSG" index-of -1 > ; PREDICATE: string privmsg "PRIVMSG" index-of -1 > ;

8
examples/more-random.factor
View File

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

36
factor/Cons.java
View File

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

8
factor/DefaultVocabularyLookup.java
View File

@ -75,8 +75,12 @@ public class DefaultVocabularyLookup implements VocabularyLookup
bra.parsing = new Bra(bra); bra.parsing = new Bra(bra);
FactorWord ket = define("syntax","]"); FactorWord ket = define("syntax","]");
ket.parsing = new Ket(bra,ket); 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 */ /* vectors */
FactorWord beginVector = define("syntax","{"); FactorWord beginVector = define("syntax","{");

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

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

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. #! Push if the list appears to be an alist.
dup list? [ [ cons? ] all? ] [ drop f ] ifte ; 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. #! Looks up the key in an alist. Push the key/value pair.
#! Most of the time you want to use assoc not assoc*. #! Most of the time you want to use assoc not assoc*.
dup [ dup [

6
library/bootstrap/image.factor
View File

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

342
library/bootstrap/primitives.factor
View File

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

2
library/compiler/generator.factor
View File

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

12
library/compiler/optimizer.factor
View File

@ -202,18 +202,18 @@ USE: prettyprint
\ over [ 2drop t ] "can-kill" set-word-property \ over [ 2drop t ] "can-kill" set-word-property
\ over [ \ over [
[ [
[ [ f f ] | over ] [[ [ f f ] over ]]
[ [ f t ] | dup ] [[ [ f t ] dup ]]
] reduce-stack-op ] reduce-stack-op
] "kill-node" set-word-property ] "kill-node" set-word-property
\ pick [ 2drop t ] "can-kill" set-word-property \ pick [ 2drop t ] "can-kill" set-word-property
\ pick [ \ pick [
[ [
[ [ f f f ] | pick ] [[ [ f f f ] pick ]]
[ [ f f t ] | over ] [[ [ f f t ] over ]]
[ [ f t f ] | over ] [[ [ f t f ] over ]]
[ [ f t t ] | dup ] [[ [ f t t ] dup ]]
] reduce-stack-op ] reduce-stack-op
] "kill-node" set-word-property ] "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 ? ) M: return-follows simplify-call ( node rest -- rest ? )
>r >r
unswons [ unswons [
[ #call | #jump ] [[ #call #jump ]]
[ #call-label | #jump-label ] [[ #call-label #jump-label ]]
] assoc swons , r> t ; ] assoc swons , r> t ;
#call [ simplify-call ] "simplify" set-word-property #call [ simplify-call ] "simplify" set-word-property
@ -119,8 +119,8 @@ PREDICATE: cons push-next ( list -- ? )
M: push-next simplify-drop ( node rest -- rest ? ) M: push-next simplify-drop ( node rest -- rest ? )
nip uncons >r unswons [ nip uncons >r unswons [
[ #push-immediate | #replace-immediate ] [[ #push-immediate #replace-immediate ]]
[ #push-indirect | #replace-indirect ] [[ #push-indirect #replace-indirect ]]
] assoc swons , r> t ; ] assoc swons , r> t ;
\ drop [ simplify-drop ] "simplify" set-word-property \ drop [ simplify-drop ] "simplify" set-word-property

10
library/cons.factor
View File

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

2
library/hashtables.factor
View File

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

10
library/httpd/html.factor
View File

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

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

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

6
library/httpd/httpd.factor
View File

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

2
library/httpd/responder.factor
View File

@ -46,7 +46,7 @@ USE: strings
! - raw-query -- raw query string ! - raw-query -- raw query string
! - query -- an alist of query parameters, eg ! - query -- an alist of query parameters, eg
! foo.bar?a=b&c=d becomes ! 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 ! - header -- an alist of headers from the user's client
! - response -- an alist of the POST request response ! - 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 ; unify-lengths vector-transpose [ unify-results ] vector-map ;
: balanced? ( list -- ? ) : balanced? ( list -- ? )
#! Check if a list of [ instack | outstack ] pairs is #! Check if a list of [[ instack outstack ]] pairs is
#! balanced. #! balanced.
[ uncons vector-length swap vector-length - ] map all=? ; [ uncons vector-length swap vector-length - ] map all=? ;
: unify-effect ( list -- in out ) : unify-effect ( list -- in out )
#! Unify a list of [ instack | outstack ] pairs. #! Unify a list of [[ instack outstack ]] pairs.
dup balanced? [ dup balanced? [
unzip unify-stacks >r unify-stacks r> unzip unify-stacks >r unify-stacks r>
] [ ] [
@ -136,7 +136,7 @@ SYMBOL: cloned
meta-d off meta-r off d-in off meta-d off meta-r off d-in off
] when ; ] when ;
: propagate-type ( [ value | class ] -- ) : propagate-type ( [[ value class ]] -- )
#! Type propagation is chained. #! Type propagation is chained.
[ [
unswons 2dup set-value-class unswons 2dup set-value-class
@ -155,9 +155,9 @@ SYMBOL: cloned
: (infer-branches) ( branchlist -- list ) : (infer-branches) ( branchlist -- list )
#! The branchlist is a list of pairs: #! The branchlist is a list of pairs:
#! [ value | typeprop ] #! [[ value typeprop ]]
#! value is either a literal or computed instance; 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. #! 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 ! A value has the following slots in addition to those relating
! to generics above: ! to generics above:
! An association list mapping values to [ value | class ] pairs ! An association list mapping values to [[ value class ]] pairs
SYMBOL: type-propagations SYMBOL: type-propagations
TRAITS: computed TRAITS: computed
@ -145,11 +145,11 @@ M: literal set-value-class ( class value -- )
: (present-effect) ( vector -- list ) : (present-effect) ( vector -- list )
[ value-class ] vector-map 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. #! After inference is finished, collect information.
uncons >r (present-effect) r> (present-effect) 2list ; 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 ; d-in get meta-d get cons ;
: init-inference ( recursive-state -- ) : init-inference ( recursive-state -- )
@ -193,7 +193,7 @@ DEFER: apply-word
infer-quot infer-quot
#return values-node check-return ; #return values-node check-return ;
: infer ( quot -- [ in | out ] ) : infer ( quot -- [[ in out ]] )
#! Stack effect of a quotation. #! Stack effect of a quotation.
[ (infer) effect present-effect ] with-scope ; [ (infer) effect present-effect ] with-scope ;

4
library/inference/words.factor
View File

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

34
library/io/files.factor
View File

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

10
library/io/presentation.factor
View File

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

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

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

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

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

29
library/syntax/prettyprint.factor
View File

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

6
library/syntax/see.factor
View File

@ -40,9 +40,9 @@ USE: words
! Prettyprinting words ! Prettyprinting words
: vocab-actions ( search -- list ) : vocab-actions ( search -- list )
[ [
[ "Words" | "words." ] [[ "Words" "words." ]]
[ "Use" | "\"use\" cons@" ] [[ "Use" "\"use\" cons@" ]]
[ "In" | "\"in\" set" ] [[ "In" "\"in\" set" ]]
] ; ] ;
: vocab-attrs ( vocab -- attrs ) : 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 ) : ch>ascii-escape ( ch -- esc )
[ [
[ CHAR: \e | "\\e" ] [[ CHAR: \e "\\e" ]]
[ CHAR: \n | "\\n" ] [[ CHAR: \n "\\n" ]]
[ CHAR: \r | "\\r" ] [[ CHAR: \r "\\r" ]]
[ CHAR: \t | "\\t" ] [[ CHAR: \t "\\t" ]]
[ CHAR: \0 | "\\0" ] [[ CHAR: \0 "\\0" ]]
[ CHAR: \\ | "\\\\" ] [[ CHAR: \\ "\\\\" ]]
[ CHAR: \" | "\\\"" ] [[ CHAR: \" "\\\"" ]]
] assoc ; ] assoc ;
: ch>unicode-escape ( ch -- esc ) : ch>unicode-escape ( ch -- esc )

4
library/test/alien.factor
View File

@ -14,9 +14,9 @@ USE: inference
: alien-inference-1 : alien-inference-1
"void" "foobar" "boo" [ "short" "short" ] alien-invoke ; "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 : alien-inference-2
"int" "foobar" "boo" [ "short" "short" ] alien-invoke ; "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: lists
USE: kernel USE: kernel
USE: math USE: math
USE: namespaces
USE: random USE: random
USE: test USE: test
USE: compiler USE: compiler

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

@ -3,6 +3,7 @@ USE: kernel
USE: math USE: math
USE: test USE: test
USE: lists USE: lists
USE: namespaces
USE: compiler USE: compiler
! http://inferno.bell-labs.com/cm/cs/who/bwk/interps/pap.html ! 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 1 2 3 ;
[ [ ] ] [ \ foo word-parameter dataflow kill-set ] unit-test ! [ [ ] ] [ \ foo word-parameter dataflow kill-set ] unit-test
!
[ [ [ + ] [ - ] ] ] [ [ 3 4 1 2 > [ + ] [ - ] ifte ] 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 ] ] ] [ [ [ 1 ] [ 2 ] ifte ] dataflow kill-set ] unit-test
!
[ [ [ 1 ] [ 2 ] ] ] [ [ t [ 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 ! [ [ 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 [ [ ] ] [ [ ] simplify ] unit-test
[ [ [ #return ] ] ] [ [ [ #return ] ] 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 ] ] ] [ [ [ #return ] ] ]
[ 123 [ [ #call | car ] [ #label | 123 ] [ #return ] ] find-label ] [ 123 [ [[ #call car ]] [[ #label 123 ]] [ #return ] ] find-label ]
unit-test unit-test
[ [ [ #return ] ] ] [ [ [ #return ] ] ]
[ [ [ #label | 123 ] [ #return ] ] follow ] [ [ [[ #label 123 ]] [ #return ] ] follow ]
unit-test unit-test
[ [ [ #return ] ] ] [ [ [ #return ] ] ]
[ [
[ [
[ #jump-label | 123 ] [[ #jump-label 123 ]]
[ #call | car ] [[ #call car ]]
[ #label | 123 ] [[ #label 123 ]]
[ #return ] [ #return ]
] follow ] follow
] ]
unit-test unit-test
[ [
[ #jump | car ] [[ #jump car ]]
] ]
[ [
[ [
[ #call | car ] [[ #call car ]]
[ #jump-label | 123 ] [[ #jump-label 123 ]]
[ #label | 123 ] [[ #label 123 ]]
[ #return ] [ #return ]
] simplify car ] simplify car
] unit-test ] unit-test
@ -44,13 +44,13 @@ unit-test
t t
] [ ] [
[ [
[ #push-immediate | 1 ] [[ #push-immediate 1 ]]
] push-next? >boolean ] push-next? >boolean
] unit-test ] unit-test
[ [
[ [
[ #replace-immediate | 1 ] [[ #replace-immediate 1 ]]
[ #return ] [ #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 ; #ifte swap dataflow-contains-op? car [ node-consume-d get ] bind ;
[ t ] [ [ t ] [
[ 2 [ swap ] [ nip "hi" ] ifte ] dataflow [ [ swap ] [ nip "hi" ] ifte ] dataflow
dataflow-ifte-node-consume-d length 1 = dataflow-ifte-node-consume-d length 1 =
] unit-test ] unit-test
@ -77,8 +77,8 @@ SYMBOL: #test
[ 6 ] [ [ 6 ] [
{{ {{
[ node-op | #test ] [[ node-op #test ]]
[ node-param | 5 ] [[ node-param 5 ]]
}} "foobar" [ [ node-param get ] bind 1 + ] apply-dataflow }} "foobar" [ [ node-param get ] bind 1 + ] apply-dataflow
] unit-test ] unit-test
@ -86,8 +86,8 @@ SYMBOL: #test
[ 25 ] [ [ 25 ] [
{{ {{
[ node-op | #test ] [[ node-op #test ]]
[ node-param | 5 ] [[ node-param 5 ]]
}} "foobar" [ [ node-param get ] bind 1 + ] apply-dataflow }} "foobar" [ [ node-param get ] bind 1 + ] apply-dataflow
] unit-test ] unit-test

6
library/test/generic.factor
View File

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

12
library/test/hashtables.factor
View File

@ -22,13 +22,13 @@ unit-test
unit-test unit-test
[ f ] [ f ]
[ [ 1 2 | 3 ] hashtable? ] [ [[ 1 [[ 2 3 ]] ]] hashtable? ]
unit-test unit-test
! Test some hashcodes. ! Test some hashcodes.
[ t ] [ [ 1 2 3 ] hashcode [ 1 2 3 ] hashcode = ] unit-test [ 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 ] [ [ 1 [ 2 3 ] 4 ] hashcode [ 1 [ 2 3 ] 4 ] hashcode = ] unit-test
[ t ] [ 12 hashcode 12 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 [ { } ] [ { [ { } ] } vector-clone "testhash" get hash* cdr ] unit-test
[ [
[ "salmon" | "fish" ] [[ "salmon" "fish" ]]
[ "crocodile" | "reptile" ] [[ "crocodile" "reptile" ]]
[ "cow" | "mammal" ] [[ "cow" "mammal" ]]
[ "visual basic" | "language" ] [[ "visual basic" "language" ]]
] alist>hash "testhash" set ] alist>hash "testhash" set
[ f ] [ [ 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 [ drop ] icon-tag
] with-string ] with-string
] unit-test ] unit-test
@ -38,7 +38,7 @@ USE: kernel
[ "<span style='color: #ff00ff; font-family: Monospaced; '>car</span>" ] [ "<span style='color: #ff00ff; font-family: Monospaced; '>car</span>" ]
[ [
[ [
[ [ "fg" 255 0 255 ] [ "font" | "Monospaced" ] ] [ [ "fg" 255 0 255 ] [[ "font" "Monospaced" ]] ]
[ drop "car" write ] [ drop "car" write ]
span-tag span-tag
] with-string ] with-string
@ -56,7 +56,7 @@ USE: kernel
[ [
[ [
"car" "car"
[ [ "fg" 255 0 255 ] [ "font" | "Monospaced" ] ] [ [ "fg" 255 0 255 ] [[ "font" "Monospaced" ]] ]
html-write-attr html-write-attr
] with-string ] with-string
] unit-test ] unit-test

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

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

126
library/test/inference.factor
View File

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

2
library/test/interpreter.factor
View File

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

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

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

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

@ -7,28 +7,28 @@ USE: test
[ f ] [ f cons? ] unit-test [ f ] [ f cons? ] unit-test
[ f ] [ t 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 ] ] [ 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 [ [ 1 ] ] [ f 1 swons ] unit-test
[ [ [ [ ] ] ] ] [ [ ] unit unit ] unit-test [ [ [ [ ] ] ] ] [ [ ] unit unit ] unit-test
[ 1 ] [ [ 1 | 2 ] car ] unit-test [ 1 ] [ [[ 1 2 ]] car ] unit-test
[ 2 ] [ [ 1 | 2 ] cdr ] 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 ] ] [ [ 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 [ [ 2 ] 1 ] [ [ 1 2 ] unswons ] unit-test
[ [ 1 2 ] ] [ 1 2 2list ] unit-test [ [ 1 2 ] ] [ 1 2 2list ] unit-test
[ [ 1 2 3 ] ] [ 1 2 3 3list ] unit-test [ [ 1 2 3 ] ] [ 1 2 3 3list ] unit-test
[ 1 3 ] [ [ 1 | 2 ] [ 3 | 4 ] 2car ] unit-test [ 1 3 ] [ [[ 1 2 ]] [[ 3 4 ]] 2car ] unit-test
[ 2 4 ] [ [ 1 | 2 ] [ 3 | 4 ] 2cdr ] unit-test [ 2 4 ] [ [[ 1 2 ]] [[ 3 4 ]] 2cdr ] unit-test
[ 1 3 2 4 ] [ [ 1 | 2 ] [ 3 | 4 ] 2uncons ] 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 [ [ 1 ] ] [ [ 1 ] [ ] append ] unit-test
[ [ 2 ] ] [ [ ] [ 2 ] 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 [ [[ 1 [[ 2 [[ 3 4 ]] ]] ]] ] [ [ 1 2 3 ] 4 append ] unit-test
[ f ] [ 3 [ ] contains? ] unit-test [ f ] [ 3 [ ] contains? ] unit-test
[ f ] [ 3 [ 1 2 ] contains? ] unit-test [ f ] [ 3 [ 1 2 ] contains? ] unit-test
@ -19,11 +19,11 @@ USE: strings
[ [ 3 ] ] [ [ 3 ] last* ] unit-test [ [ 3 ] ] [ [ 3 ] last* ] unit-test
[ [ 3 ] ] [ [ 1 2 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 ] [ [ 3 ] last ] unit-test
[ 3 ] [ [ 1 2 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 [ 0 ] [ [ ] length ] unit-test
[ 3 ] [ [ 1 2 3 ] length ] unit-test [ 3 ] [ [ 1 2 3 ] length ] unit-test
@ -31,7 +31,7 @@ USE: strings
[ t ] [ f list? ] unit-test [ t ] [ f list? ] unit-test
[ f ] [ t list? ] unit-test [ f ] [ t list? ] unit-test
[ t ] [ [ 1 2 ] 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 [ ] remove ] unit-test
[ [ ] ] [ 1 [ 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 ] [ 3 [ 1 [ 3 ] 2 ] tree-contains? not ] unit-test
[ f ] [ 1 [ [ [ 1 ] ] 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 ] [ 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 [ [ ] ] [ 0 count ] unit-test
[ [ ] ] [ -10 count ] unit-test [ [ ] ] [ -10 count ] unit-test

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

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

6
library/test/parser.factor
View File

@ -56,9 +56,9 @@ test-word
! Test improper lists ! Test improper lists
[ 2 ] [ "[ 1 | 2 ]" parse car cdr ] unit-test [ 2 ] [ "[[ 1 2 ]]" parse car cdr ] unit-test
[ "hello" ] [ "[ 1 | \"hello\" ]" parse car cdr ] unit-test [ "hello" ] [ "[[ 1 \"hello\" ]]" parse car cdr ] unit-test
[ #{ 1 2 } ] [ "[ 1 | #{ 1 2 } ]" parse car cdr ] unit-test [ #{ 1 2 } ] [ "[[ 1 #{ 1 2 } ]]" parse car cdr ] unit-test
! Test EOL comments in multiline strings. ! Test EOL comments in multiline strings.
[ [ "Hello" ] ] [ "#! This calls until-eol.\n\"Hello\"" parse ] unit-test [ [ "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 ] unit-test
[ "Sans-Serif" ] [ [ "Sans-Serif" ] [
[ [
[ "font" | "Sans-Serif" ] [[ "font" "Sans-Serif" ]]
] "fooquux" set-style ] "fooquux" set-style
"font" "fooquux" style assoc "font" "fooquux" style assoc
] unit-test ] 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 ] [ { 1 2 3 4 } { 5 6 7 8 } vector-zip [ uncons + ] vector-map ]
unit-test 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 ] [ { 1 2 3 4 } { 5 6 7 8 } vector-zip ]
unit-test unit-test

14
library/ui/console.factor
View File

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

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

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