inference errors printed; type violations are flagged; plugin fixes

TODO.FACTOR.txt

@@ -7,10 +7,8 @@
 - type inference fails with some assembler words;
   displaced, register and other predicates need to inherit from list
   not cons, and need stronger branch partial eval
-- print warning on null class
 - optimize away dispatch
 - code gc
-- #jump-f #jump-f-label
 - don't hardcode so many colors
 - ffi unicode strings: null char security hole
 - utf16 string boxing
@@ -19,6 +17,7 @@
 
 + compiler/ffi:
 
+- #jump-f #jump-f-label
 - declarations
 - value type structs
 - out parameters

examples/mandel.factor

@@ -89,10 +89,10 @@ SYMBOL: center
     ] with-pixels ; compiled
 
 : mandel ( -- )
-    640 480 0 SDL_HWSURFACE [
+    1280 1024 0 SDL_HWSURFACE  [
         [
-            0.8 zoom-fact set
+            3.7 zoom-fact set
-            -0.65 center set
+            -0.45 center set
             100 nb-iter set
             init-mandel
             [ render ] time

factor/DefaultVocabularyLookup.java

@@ -193,7 +193,7 @@ public class DefaultVocabularyLookup implements VocabularyLookup
 		{
 			// save to same workspace as vocabulary,
 			// or no workspace if vocabulary is builtins
-			FactorWord word = new FactorWord(vocabulary,name);
+			FactorWord word = new FactorWord(this,vocabulary,name);
 			v.put(name,word);
 			return word;
 		}

factor/ExternalFactor.java

@@ -201,7 +201,7 @@ public class ExternalFactor extends DefaultVocabularyLookup
 		String name = (String)info.next().car;
 		FactorWord w = super.searchVocabulary(new Cons(vocabulary,null),name);
 		if(w == null)
-			w = new FactorWord(vocabulary,name);
+			w = new FactorWord(this,vocabulary,name);
 		w.stackEffect = (String)info.next().next().car;
 		return w;
 	} //}}}

factor/FactorArtifact.java

@@ -67,4 +67,6 @@ public abstract class FactorArtifact
 	
 	public abstract String getShortString();
 	public abstract String getLongString();
+	
+	public void forget() {}
 }

factor/FactorReader.java

@@ -46,7 +46,7 @@ public class FactorReader
 	/**
 	 * Top level of parse tree.
 	 */
-	private FactorWord toplevel = new FactorWord(null,"#<EOF>");
+	private FactorWord toplevel = new FactorWord(null,null,"#<EOF>");
 	private boolean alwaysDocComments;
 
 	private Cons use;

factor/FactorWord.java

@@ -43,14 +43,18 @@ public class FactorWord extends FactorArtifact implements FactorExternalizable
 	 */
 	public FactorParsingDefinition parsing;
 
+	private VocabularyLookup lookup;
+	
 	/**
 	 * For browsing, the parsing word that was used to define this word.
 	 */
 	private FactorWord definer;
 
 	//{{{ FactorWord constructor
-	public FactorWord(String vocabulary, String name)
+	public FactorWord(VocabularyLookup lookup,
+		String vocabulary, String name)
 	{
+		this.lookup = lookup;
 		this.vocabulary = vocabulary;
 		this.name = name;
 	} //}}}
@@ -65,7 +69,7 @@ public class FactorWord extends FactorArtifact implements FactorExternalizable
 	public FactorWord getDefiner()
 	{
 		if(definer == null)
-			return new FactorWord(null,"DEFER:");
+			return new FactorWord(lookup,null,"DEFER:");
 		else
 			return definer;
 	} //}}}
@@ -87,4 +91,15 @@ public class FactorWord extends FactorArtifact implements FactorExternalizable
 	{
 		return FactorWordRenderer.getWordHTMLString(this,false);
 	} //}}}
+
+	//{{{ forget() method
+	public void forget()
+	{
+		/* Not allowed to forget parsing words, since that confuses our
+		parser */
+		if(parsing != null)
+			return;
+		
+		lookup.forget(this);
+	} //}}}
 }

factor/jedit/FactorSideKickParser.java

@@ -98,9 +98,9 @@ public class FactorSideKickParser extends SideKickParser
 	public SideKickParsedData parse(Buffer buffer,
 		DefaultErrorSource errorSource)
 	{
-		Object words = buffer.getProperty(ARTIFACTS_PROPERTY);
+		Object artifacts = buffer.getProperty(ARTIFACTS_PROPERTY);
-		if(words instanceof Cons)
+		if(artifacts instanceof Cons)
-			forgetWords((Cons)words);
+			forgetArtifacts((Cons)artifacts);
 
 		FactorParsedData d = new FactorParsedData(
 			this,buffer.getPath());
@@ -157,17 +157,13 @@ public class FactorSideKickParser extends SideKickParser
 		return d;
 	} //}}}
 
-	//{{{ forgetWords() method
+	//{{{ forgetArtifacts() method
-	private void forgetWords(Cons words)
+	private void forgetArtifacts(Cons artifacts)
 	{
-		while(words != null)
+		while(artifacts != null)
 		{
-			FactorWord word = (FactorWord)words.car;
+			((FactorArtifact)artifacts.car).forget();
-			// We're not allowed to forget parsing words.
+			artifacts = artifacts.next();
-			if(word.parsing != null)
-				return;
-			FactorPlugin.getExternalInstance().forget(word);
-			words = words.next();
 		}
 	} //}}}
 

library/assoc.factor

@@ -11,14 +11,21 @@ IN: lists USING: kernel ;
     dup list? [ [ cons? ] all? ] [ drop f ] ifte ;
 
 : assoc* ( key alist -- [[ key value ]] )
-    #! Looks up the key in an alist. Push the key/value pair.
+    #! Look up a key/value pair.
-    #! Most of the time you want to use assoc not assoc*.
     [ car = ] some-with?  dup [ car ] when ;
 
 : assoc ( key alist -- value )
-    #! Looks up the key in an alist.
+    #! Look up a value.
     assoc*  dup [ cdr ] when ;
 
+: assq* ( key alist -- [[ key value ]] )
+    #! Looks up a key/value pair using identity comparison.
+    [ car eq? ] some-with?  dup [ car ] when ;
+
+: assq ( key alist -- value )
+    #! Looks up a key/value pair using identity comparison.
+    assq*  dup [ cdr ] when ;
+
 : remove-assoc ( key alist -- alist )
     #! Remove all key/value pairs with this key.
     [ car = not ] subset-with ;

library/bootstrap/boot-stage2.factor

@@ -94,6 +94,7 @@ IN: alien : add-library 3drop ;
         "/library/tools/profiler.factor"
         "/library/tools/interpreter.factor"
     
+        "/library/inference/conditions.factor"
         "/library/inference/dataflow.factor"
         "/library/inference/inference.factor"
         "/library/inference/branches.factor"

library/compiler/generator.factor

@@ -1,41 +1,8 @@
-! :folding=indent:collapseFolds=1:
+! Copyright (C) 2004, 2005 Slava Pestov.
-
+! See http://factor.sf.net/license.txt for BSD license.
-! $Id$
-!
-! Copyright (C) 2004 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
 IN: compiler
-USE: assembler
+USING: assembler inference errors kernel lists math namespaces
-USE: inference
+strings words vectors ;
-USE: errors
-USE: kernel
-USE: lists
-USE: math
-USE: namespaces
-USE: strings
-USE: words
-USE: vectors
 
 ! To support saving compiled code to disk, generator words
 ! append relocation instructions to this vector.

library/compiler/linearizer.factor

@@ -1,41 +1,8 @@
-! :folding=indent:collapseFolds=1:
+! Copyright (C) 2004, 2005 Slava Pestov.
-
+! See http://factor.sf.net/license.txt for BSD license.
-! $Id$
-!
-! Copyright (C) 2004 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
 IN: compiler
-USE: inference
+USING: inference kernel lists math namespaces words strings
-USE: kernel
+errors prettyprint kernel-internals ;
-USE: lists
-USE: math
-USE: namespaces
-USE: words
-USE: strings
-USE: errors
-USE: prettyprint
-USE: kernel-internals
 
 ! The linear IR is close to assembly language. It also resembles
 ! Forth code in some sense. It exists so that pattern matching
@@ -49,6 +16,9 @@ SYMBOL: #push-indirect
 SYMBOL: #replace-immediate
 SYMBOL: #replace-indirect
 SYMBOL: #jump-t ( branch if top of stack is true )
+SYMBOL: #jump-t-label ( branch if top of stack is true )
+SYMBOL: #jump-f ( branch if top of stack is false )
+SYMBOL: #jump-f-label ( branch if top of stack is false )
 SYMBOL: #jump ( tail-call )
 SYMBOL: #jump-label ( tail-call )
 SYMBOL: #return-to ( push addr on C stack )
@@ -133,7 +103,7 @@ SYMBOL: #end-dispatch
     #! The parameter is a list of two lists, each one a dataflow
     #! IR.
     2unlist  <label> [
-        #jump-t swons ,
+        #jump-t-label swons ,
         (linearize) ( false branch )
         <label> dup #jump-label swons ,
     ] keep label, ( branch target of BRANCH-T )

library/compiler/simplifier.factor

@@ -1,39 +1,8 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
 ! Copyright (C) 2004, 2005 Slava Pestov.
-! 
+! See http://factor.sf.net/license.txt for BSD license.
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
 IN: compiler
-USE: kernel
+USING: kernel lists namespaces words inference strings
-USE: lists
+prettyprint ;
-USE: namespaces
-USE: words
-USE: inference
-USE: strings
-USE: strings
-USE: prettyprint
 
 ! The linear IR being simplified is stored in this variable.
 SYMBOL: simplifying
@@ -144,7 +113,7 @@ SYMBOL: simplifying
 : double-jump ( linear op1 op2 -- linear ? )
     #! A jump to a jump is just a jump. If the next logical node
     #! is a jump of type op1, replace the jump at the car of the
-    #! list with a just of type op2.
+    #! list with a jump of type op2.
     swap pick next-logical? [
         over next-logical car cdr cons swap cdr cons t
     ] [

library/compiler/x86/generator.factor

@@ -40,12 +40,34 @@ math memory namespaces words ;
     compile-jump-label
 ] "generator" set-word-property
 
-#jump-t [
+: compile-jump-t ( word -- )
     POP-DS
     ! condition is now in EAX
     EAX f address CMP
     ! jump w/ address added later
-    0 JNE fixup compiled-offset defer-xt
+    0 JNE fixup compiled-offset defer-xt ;
+
+#jump-t-label [
+    compile-jump-t
+] "generator" set-word-property
+
+#jump-t [
+    dup compile-jump-t t rel-word
+] "generator" set-word-property
+
+: compile-jump-f ( word -- )
+    POP-DS
+    ! condition is now in EAX
+    EAX f address CMP
+    ! jump w/ address added later
+    0 JE fixup compiled-offset defer-xt ;
+
+#jump-f-label [
+    compile-jump-f
+] "generator" set-word-property
+
+#jump-f [
+    dup compile-jump-f t rel-word
 ] "generator" set-word-property
 
 #return-to [

library/inference/branches.factor

@@ -50,7 +50,7 @@ strings vectors words hashtables prettyprint ;
     dup balanced? [
         unzip unify-stacks >r unify-stacks r>
     ] [
-        "Unbalanced branches" throw
+        "Unbalanced branches" inference-error
     ] ifte ;
 
 : datastack-effect ( list -- )
@@ -79,7 +79,7 @@ SYMBOL: cloned
 : deep-clone ( obj -- obj )
     #! Clone an object if it hasn't already been cloned in this
     #! with-deep-clone scope.
-    dup cloned get assoc [
+    dup cloned get assq [
         clone [ dup cloned [ acons ] change ] keep
     ] ?unless ;
 
@@ -146,10 +146,10 @@ SYMBOL: cloned
     #! parameter is a vector.
     (infer-branches) dup unify-effects unify-dataflow ;
 
-: (with-block) ( label quot -- node )
+: (with-block) ( [[ label quot ]] quot -- node )
     #! Call a quotation in a new namespace, and transfer
     #! inference state from the outer scope.
-    swap >r [
+    swap car >r [
         dataflow-graph off
         call
         d-in get meta-d get meta-r get get-dataflow

library/inference/conditions.factor

@@ -0,0 +1,36 @@
+! Copyright (C) 2004, 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: inference
+USING: errors interpreter kernel lists namespaces prettyprint
+stdio ;
+
+DEFER: recursive-state
+
+: inference-condition ( msg symbol -- )
+    [
+        , , recursive-state get , meta-d get , meta-r get ,
+    ] make-list ;
+
+: inference-error ( msg -- )
+    \ inference-error inference-condition throw ;
+
+: inference-warning ( msg -- )
+    \ inference-warning inference-condition error. ;
+
+: inference-condition. ( cond msg -- )
+    write
+    cdr unswons error.
+    "Recursive state:" print
+    car [.] ;
+!    "Meta data stack:" print
+!    unswons {.}
+!    "Meta return stack:" print
+!    car {.} ;
+
+PREDICATE: cons inference-error car \ inference-error = ;
+M: inference-error error. ( error -- )
+    "Inference error: " inference-condition. ;
+
+PREDICATE: cons inference-warning car \ inference-warning = ;
+M: inference-warning error. ( error -- )
+    "Inference warning: " inference-condition. ;

library/inference/inference.factor

@@ -1,43 +1,8 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
 ! Copyright (C) 2004, 2005 Slava Pestov.
-! 
+! See http://factor.sf.net/license.txt for BSD license.
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
 IN: inference
-USE: errors
+USING: generic interpreter kernel lists math namespaces strings
-USE: interpreter
+unparser vectors words ;
-USE: kernel
-USE: lists
-USE: math
-USE: namespaces
-USE: strings
-USE: vectors
-USE: words
-USE: hashtables
-USE: generic
-USE: prettyprint
 
 : max-recursion 0 ;
 
@@ -77,8 +42,20 @@ C: computed ( class -- value )
 M: computed value= ( literal value -- ? )
     2drop f ;
 
+: failing-class-and
+    2dup class-and dup null = [
+        drop [
+            word-name , " and " , word-name ,
+            " do not intersect" ,
+        ] make-string inference-error
+    ] [
+        2nip
+    ] ifte ;
+
 M: computed value-class-and ( class value -- )
-    [ value-class class-and ] keep set-value-class ;
+    [
+        value-class failing-class-and
+    ] keep set-value-class ;
 
 TUPLE: literal value delegate ;
 
@@ -98,6 +75,10 @@ M: literal value-class-and ( class value -- )
 M: literal set-value-class ( class value -- )
     2drop ;
 
+M: computed literal-value ( value -- )
+    "A literal value was expected where a computed value was"
+    " found: " rot unparse cat3 inference-error ;
+
 : (ensure-types) ( typelist n stack -- )
     pick [
         3dup >r >r car r> r> vector-nth value-class-and
@@ -191,7 +172,7 @@ DEFER: apply-word
 : check-return ( -- )
     #! Raise an error if word leaves values on return stack.
     meta-r get vector-length 0 = [
-        "Word leaves elements on return stack" throw
+        "Word leaves elements on return stack" inference-error
     ] unless ;
 
 : values-node ( op -- )

library/inference/words.factor

@@ -41,9 +41,9 @@ strings vectors words hashtables parser prettyprint ;
     ] ifte* ;
 
 : no-effect ( word -- )
-    "Unknown stack effect: " swap word-name cat2 throw ;
+    "Unknown stack effect: " swap word-name cat2 inference-error ;
 
-: with-block ( word label quot -- node )
+: with-block ( word [[ label quot ]] quot -- node )
     #! Execute a quotation with the word on the stack, and add
     #! its dataflow contribution to a new block node in the IR.
     over [
@@ -60,7 +60,9 @@ strings vectors words hashtables parser prettyprint ;
     #! Infer the stack effect of a compound word in the current
     #! inferencer instance. If the word in question is recursive
     #! we infer its stack effect inside a new block.
-    gensym [ word-parameter infer-quot effect ] with-block ;
+    gensym over word-parameter cons [
+        word-parameter infer-quot effect
+    ] with-block ;
 
 : infer-compound ( word -- )
     #! Infer a word's stack effect in a separate inferencer
@@ -83,6 +85,10 @@ strings vectors words hashtables parser prettyprint ;
 
 GENERIC: (apply-word)
 
+M: object (apply-word) ( word -- )
+    #! A primitive with an unknown stack effect.
+    no-effect ;
+
 M: compound (apply-word) ( word -- )
     #! Infer a compound word's stack effect.
     dup "no-effect" word-property [
@@ -110,9 +116,9 @@ M: symbol (apply-word) ( word -- )
         rethrow
     ] catch ;
 
-: base-case ( word label -- )
+: base-case ( word [ label quot ] -- )
     [
-        over inline-compound [
+        car over inline-compound [
             drop
             [ #call-label ] [ #call ] ?ifte
             node-op set
@@ -121,9 +127,9 @@ M: symbol (apply-word) ( word -- )
     ] with-recursion ;
 
 : no-base-case ( word -- )
-    word-name " does not have a base case." cat2 throw ;
+    word-name " does not have a base case." cat2 inference-error ;
 
-: recursive-word ( word label -- )
+: recursive-word ( word [ label quot ] -- )
     #! Handle a recursive call, by either applying a previously
     #! inferred base case, or raising an error. If the recursive
     #! call is to a local block, emit a label call node.
@@ -152,11 +158,10 @@ M: symbol (apply-word) ( word -- )
 : infer-call ( -- )
     [ general-list ] ensure-d
     dataflow-drop,
-    gensym dup [
+    pop-d gensym dup pick literal-value cons [
-        drop pop-d dup
+        drop
-        value-recursion recursive-state set
+        dup value-recursion recursive-state set
-        literal-value
+        literal-value dup infer-quot
-        dup infer-quot
     ] with-block drop handle-terminator ;
 
 \ call [ infer-call ] "infer" set-word-property

library/test/memory.factor

@@ -1,14 +1,12 @@
 IN: scratchpad
-USE: kernel
+USING: generic kernel lists math memory words ;
-USE: math
-USE: memory
-USE: generic
-USE: lists
 
 num-types [
     [
-        builtin-type instances [
+        builtin-type [
+            "predicate" word-property instances [
                 class drop
             ] each
+        ] when*
     ] keep
 ] repeat

library/test/tuple.factor

@@ -47,7 +47,7 @@ C: quuux-tuple-2
     100 200 <point>
     
     ! Use eval to sequence parsing explicitly
-    "TUPLE: point y x ;" eval
+    "TUPLE: point x y z ;" eval
     
     point-x
 ] unit-test