simplifying the parser; #{ a b } is now #{ a b }#

TODO.FACTOR.txt

@@ -1,9 +1,6 @@
 + compiler:
 
-- investigate why : foo t or ; doesn't partially evaluate
-- investigate why ' doesn't infer
 - recursive? and tree-contains? should handle vectors
-- type inference and recursion flaw
 - 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
@@ -17,6 +14,7 @@
 
 - make see work with union, builtin, predicate
 - doc comments of generics
+- proper ordering for classes
 
 + ffi:
 

examples/dejong.factor

@@ -39,7 +39,7 @@ SYMBOL: d
 : white ( -- rgb )
     HEX: ffffffff ;
 
-: pixel ( #{ x y } color -- )
+: pixel ( #{ x y }# color -- )
     >r >r surface get r> >rect r> pixelColor ;
 
 : iterate-dejong ( x y -- x y )

examples/factoroids.factor

@@ -163,11 +163,11 @@ C: plasma ( actor dy -- plasma )
 : player-fire ( -- )
     #! Do nothing if player is dead.
     player-actor [
-        #{ 0 -6 } <plasma> player-shots cons@
+        #{ 0 -6 }# <plasma> player-shots cons@
     ] when* ;
 
 : enemy-fire ( actor -- )
-    #{ 0 5 } <plasma> enemy-shots cons@ ;
+    #{ 0 5 }# <plasma> enemy-shots cons@ ;
 
 ! Background of stars
 TRAITS: particle

examples/infix.factor

@@ -14,7 +14,7 @@ SYMBOL: exprs
 DEFER: infix
 : >e exprs get vector-push ;
 : e> exprs get vector-pop ;
-: e@ exprs get dup vector-empty? [ drop f ] [ vector-peek ] ifte ;
+: e@ exprs get dup vector-length 0 = [ drop f ] [ vector-peek ] ifte ;
 : e, ( obj -- ) dup cons? [ [ e, ] each ] [ , ] ifte ;
 : end ( -- ) exprs get [ e, ] vector-each ;
 : >postfix ( op -- ) e@ word? [ e> e> -rot 3list ] when >e ;

examples/mandel.factor

@@ -72,7 +72,7 @@ SYMBOL: center
     height get 150000 zoom-fact get * / y-inc set
     nb-iter get max-color min <color-map> cols set ;
 
-: c ( #{ i j } -- c )
+: c ( #{ i j }# -- c )
     >rect >r
     x-inc get * center get real x-inc get width get 2 / * - + >float
     r>

library/assoc.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2004 Slava Pestov.
+! Copyright (C) 2004, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -51,7 +51,7 @@ USE: kernel
 
 : remove-assoc ( key alist -- alist )
     #! Remove all key/value pairs with this key.
-    [ dupd car = not ] subset nip ;
+    [ car = not ] subset-with ;
 
 : acons ( value key alist -- alist )
     #! Adds the key/value pair to the alist. Existing pairs with
@@ -83,11 +83,7 @@ USE: kernel
 : zip ( list list -- list )
     #! Make a new list containing pairs of corresponding
     #! elements from the two given lists.
-    dup [
-        2uncons zip >r cons r> cons
-    ] [
-        2drop [ ]
-    ] ifte ;
+    dup [ 2uncons zip >r cons r> cons ] [ 2drop [ ] ] ifte ;
 
 : unzip ( assoc -- keys values )
     #! Split an association list into two lists of keys and

library/bootstrap/init.factor

@@ -36,7 +36,6 @@ USE: words
 : boot ( -- )
     #! Initialize an interpreter with the basic services.
     init-namespaces
-    init-threads
     init-stdio
     "HOME" os-env [ "." ] unless* "~" set
     init-search-path ;

library/combinators.factor

@@ -56,6 +56,16 @@ IN: kernel
     #! condition and execute the 'false' quotation.
     pick [ drop call ] [ nip nip call ] ifte ; inline
 
+: ?ifte ( default cond true false -- )
+    #! If cond is true, drop default and apply true
+    #! quotation to cond. Otherwise, drop cond, and apply false
+    #! to default.
+    >r >r dup [
+        nip r> r> drop call
+    ] [
+        drop r> drop r> call
+    ] ifte ; inline
+
 : unless ( cond quot -- )
     #! Execute a quotation only when the condition is f. The
     #! condition is popped off the stack.
@@ -72,6 +82,12 @@ IN: kernel
     #! value than it produces.
     over [ drop ] [ nip call ] ifte ; inline
 
+: ?unless ( default cond false -- )
+    #! If cond is true, drop default and leave cond on the
+    #! stack. Otherwise, drop default, and apply false
+    #! quotation to default.
+    >r dup [ nip r> drop ] [ drop r> call ] ifte ; inline
+
 : when ( cond quot -- )
     #! Execute a quotation only when the condition is not f. The
     #! condition is popped off the stack.
@@ -89,31 +105,15 @@ IN: kernel
     #! value than it produces.
     dupd [ drop ] ifte ; inline
 
-: forever ( quot -- )
-    #! The code is evaluated in an infinite loop. Typically, a
-    #! continuation is used to escape the infinite loop.
-    #!
-    #! This combinator will not compile.
-    dup slip forever ;
-
-: ?ifte ( default cond true false -- )
-    #! If cond is true, drop default and apply true
-    #! quotation to cond. Otherwise, drop cond, and apply false
-    #! to default.
-    >r >r dup [
-        nip r> r> drop call
-    ] [
-        drop r> drop r> call
-    ] ifte ; inline
-
 : ?when ( default cond true -- )
     #! If cond is true, drop default and apply true
     #! quotation to cond. Otherwise, drop cond, and leave
     #! default on the stack.
     >r dup [ nip r> call ] [ r> 2drop ] ifte ; inline
 
-: ?unless ( default cond false -- )
-    #! If cond is true, drop default and leave cond on the
-    #! stack. Otherwise, drop default, and apply false
-    #! quotation to default.
-    >r dup [ nip r> drop ] [ drop r> call ] ifte ; inline
+: forever ( quot -- )
+    #! The code is evaluated in an infinite loop. Typically, a
+    #! continuation is used to escape the infinite loop.
+    #!
+    #! This combinator will not compile.
+    dup slip forever ;

library/cons.factor

@@ -103,7 +103,7 @@ PREDICATE: general-list list ( list -- ? )
 
 : with ( obj quot elt -- obj quot )
     #! Utility word for each-with, map-with.
-    pick pick >r >r swap call r> r> ;
+    pick pick >r >r swap call r> r> ; inline
 
 : each-with ( obj list quot -- )
     #! Push each element of a proper list in turn, and apply a
@@ -121,3 +121,6 @@ PREDICATE: general-list list ( list -- ? )
     ] [
         drop
     ] ifte ; inline
+
+: subset-with ( obj list quot -- list )
+    swap [ with rot ] subset nip nip ; inline

library/generic/predicate.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2004 Slava Pestov.
+! Copyright (C) 2004, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -74,22 +74,17 @@ predicate [
 ] "class<" set-word-property
 
 : define-predicate ( class predicate definition -- )
-    rot "superclass" word-property "predicate" word-property
+    pick "superclass" word-property "predicate" word-property
     [ \ dup , append, , [ drop f ] , \ ifte , ] make-list
-    define-compound ;
+    define-compound
+    predicate define-class ;
 
 : PREDICATE: ( -- class predicate definition )
     #! Followed by a superclass name, then a class name.
     scan-word
     CREATE dup intern-symbol
     dup rot "superclass" set-word-property
-    dup predicate "metaclass" set-word-property
     dup predicate-word
+!    2dup swap "predicate" set-word-property
     [ dupd unit "predicate" set-word-property ] keep
     [ define-predicate ] [ ] ; parsing
-
-PREDICATE: compound generic ( word -- ? )
-    "combination" word-property ;
-
-PREDICATE: compound promise ( obj -- ? )
-    "promise" word-property ;

library/lists.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2003, 2004 Slava Pestov.
+! Copyright (C) 2003, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -132,7 +132,7 @@ DEFER: tree-contains?
 
 : remove ( obj list -- list )
     #! Remove all occurrences of the object from the list.
-    [ dupd = not ] subset nip ;
+    [ = not ] subset-with ;
 
 : length ( list -- length )
     0 swap [ drop 1 + ] each ;

library/math/complex.factor

@@ -35,11 +35,11 @@ USE: kernel-internals
 USE: math
 USE: math-internals
 
-GENERIC: real ( #{ re im } -- re )
+GENERIC: real ( #{ re im }# -- re )
 M: real real ;
 M: complex real 0 slot %real ;
 
-GENERIC: imaginary ( #{ re im } -- im )
+GENERIC: imaginary ( #{ re im }# -- im )
 M: real imaginary drop 0 ;
 M: complex imaginary 1 slot %real ;
 

library/math/constants.factor

@@ -28,8 +28,8 @@
 IN: math
 USE: kernel
 
-: i #{ 0 1 } ; inline
-: -i #{ 0 -1 } ; inline
+: i #{ 0 1 }# ; inline
+: -i #{ 0 -1 }# ; inline
 : inf 1.0 0.0 / ; inline
 : -inf -1.0 0.0 / ; inline
 : e 2.7182818284590452354 ; inline

library/math/math-combinators.factor

@@ -54,16 +54,16 @@ USE: kernel
 : fac ( n -- n! )
     1 swap [ 1 + * ] times* ;
 
-: 2times-succ ( #{ a b } #{ c d } -- z )
-    #! Lexicographically add #{ 0 1 } to a complex number.
-    #! If d + 1 == b, return #{ c+1 0 }. Otherwise, #{ c d+1 }.
+: 2times-succ ( #{ a b }# #{ c d }# -- z )
+    #! Lexicographically add #{ 0 1 }# to a complex number.
+    #! If d + 1 == b, return #{ c+1 0 }#. Otherwise, #{ c d+1 }#.
     2dup imaginary 1 + swap imaginary = [
         nip real 1 +
     ] [
         nip >rect 1 + rect>
     ] ifte ; inline
 
-: 2times<= ( #{ a b } #{ c d } -- ? )
+: 2times<= ( #{ a b }# #{ c d }# -- ? )
     swap real swap real <= ; inline
 
 : (2times) ( limit n quot -- )
@@ -73,9 +73,9 @@ USE: kernel
         rot pick dupd 2times-succ pick 3slip (2times)
     ] ifte ; inline
 
-: 2times* ( #{ w h } quot -- )
+: 2times* ( #{ w h }# quot -- )
     #! Apply a quotation to each pair of complex numbers
-    #! #{ a b } such that a < w, b < h.
+    #! #{ a b }# such that a < w, b < h.
     0 swap (2times) ; inline
 
 : (repeat) ( i n quot -- )

library/sdl/sdl-utils.factor

@@ -68,7 +68,7 @@ SYMBOL: surface
 : clear-surface ( color -- )
     >r surface get 0 0 width get height get r> boxColor ;
 
-: pixel-step ( quot #{ x y } -- )
+: pixel-step ( quot #{ x y }# -- )
     tuck >r call >r surface get r> r> >rect rot pixelColor ;
     inline
 

library/syntax/parse-syntax.factor

@@ -55,7 +55,7 @@ USE: unparser
 ! ( and #! then add "stack-effect" and "documentation"
 ! properties to the current word if it is set.
 
-! Constants
+! Booleans
 : t t swons ; parsing
 : f f swons ; parsing
 
@@ -75,6 +75,10 @@ USE: unparser
 : {{ f ; parsing
 : }} alist>hash swons ; parsing
 
+! Complex numbers
+: #{ f ; parsing
+: }# 2unlist swap rect> swons ; parsing
+
 ! Do not execute parsing word
 : POSTPONE: ( -- ) scan-word swons ; parsing
 
@@ -101,11 +105,13 @@ USE: unparser
     #! Create a word with no definition. Used for mutually
     #! recursive words.
     CREATE drop ; parsing
+
 : FORGET: scan-word forget ; parsing
 
 : USE:
     #! Add vocabulary to search path.
     scan "use" cons@ ; parsing
+
 : IN:
     #! Set vocabulary for new definitions.
     scan dup "use" cons@ "in" set ; parsing
@@ -127,14 +133,6 @@ USE: unparser
     [ parse-string "col" get ] make-string
     swap "col" set swons ; parsing
 
-: expect ( word -- )
-    dup scan = [ drop ] [ "Expected " swap cat2 throw ] ifte ;
-
-: #{
-    #! Complex literal - #{ real imaginary #}
-    scan str>number scan str>number rect> "}" expect swons ;
-    parsing
-
 ! Comments
 : (
     #! Stack comment.

library/syntax/prettyprint.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2003, 2004 Slava Pestov.
+! Copyright (C) 2003, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:

library/syntax/unparser.factor

@@ -98,7 +98,7 @@ M: complex unparse ( num -- str )
         real unparse ,
         " " ,
         imaginary unparse ,
-        " }" ,
+        " }#" ,
     ] make-string ;
 
 : ch>ascii-escape ( ch -- esc )

library/test/compiler/ifte.factor

@@ -37,12 +37,12 @@ USE: math-internals
 
 : dead-code-rec
     t [
-        #{ 3 2 }
+        #{ 3 2 }#
     ] [
         dead-code-rec
     ] ifte ; compiled
 
-[ #{ 3 2 } ] [ dead-code-rec ] unit-test
+[ #{ 3 2 }# ] [ dead-code-rec ] unit-test
 
 : one-rec [ f one-rec ] [ "hi" ] ifte ; compiled
 

library/test/compiler/optimizer.factor

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

library/test/hashtables.factor

@@ -39,11 +39,11 @@ unit-test
 
 16 <hashtable> "testhash" set
 
-t #{ 2 3 } "testhash" get set-hash
+t #{ 2 3 }# "testhash" get set-hash
 f 100 fac "testhash" get set-hash
 { } { [ { } ] } "testhash" get set-hash
 
-[ t ] [ #{ 2 3 } "testhash" get hash ] unit-test
+[ t ] [ #{ 2 3 }# "testhash" get hash ] unit-test
 [ f ] [ 100 fac "testhash" get hash* cdr ] unit-test
 [ { } ] [ { [ { } ] } vector-clone "testhash" get hash* cdr ] unit-test
 

library/test/interpreter.factor

@@ -44,8 +44,8 @@ USE: kernel
     [ "XYZ" "XuZ" = ] test-interpreter
 ] unit-test
 
-[ { #{ 1 1.5 } { } #{ 1 1.5 } { } } ] [
-    [ #{ 1 1.5 } { } 2dup ] test-interpreter
+[ { #{ 1 1.5 }# { } #{ 1 1.5 }# { } } ] [
+    [ #{ 1 1.5 }# { } 2dup ] test-interpreter
 ] unit-test
 
 [ { 4 } ] [

library/test/lists/combinators.factor

@@ -40,3 +40,5 @@ USE: strings
 [ f ] [ [ 1 2 3 ] [ 10 > ] some? ] unit-test
 
 [ [ 2 3 4 ] ] [ 1 [ 1 2 3 ] [ + ] map-with ] unit-test
+
+[ [ 3 ] ] [ 2 [ 1 2 3 ] [ < ] subset-with ] unit-test

library/test/lists/namespaces.factor

@@ -29,9 +29,9 @@ USE: test
     "x" get
 ] unit-test
 
-[ [ "xyz" #{ 3 2 } 1/5 [ { } ] ] ] [
+[ [ "xyz" #{ 3 2 }# 1/5 [ { } ] ] ] [
     [ "xyz" , "xyz" unique,
-    #{ 3 2 } , #{ 3 2 } unique,
+    #{ 3 2 }# , #{ 3 2 }# unique,
     1/5 , 1/5 unique,
     [ { } unique, ] make-list , ] make-list
 ] unit-test

library/test/math/complex.factor

@@ -3,47 +3,47 @@ USE: kernel
 USE: math
 USE: test
 
-[ f ] [ #{ 5 12.5 } 5 ] [ = ] test-word
-[ t ] [ #{ 1.0 2.0 } #{ 1 2 } ] [ = ] test-word
-[ f ] [ #{ 1.0 2.3 } #{ 1 2 } ] [ = ] test-word
+[ f ] [ #{ 5 12.5 }# 5 ] [ = ] test-word
+[ t ] [ #{ 1.0 2.0 }# #{ 1 2 }# ] [ = ] test-word
+[ f ] [ #{ 1.0 2.3 }# #{ 1 2 }# ] [ = ] test-word
 
-[ #{ 2 5 } ] [ 2 5 ] [ rect> ] test-word
-[ 2 5 ] [ #{ 2 5 } ] [ >rect ] test-word
-[ #{ 1/2 1 } ] [ 1/2 i ] [ + ] test-word
-[ #{ 1/2 1 } ] [ i 1/2 ] [ + ] test-word
-[ t ] [ #{ 11 64 } #{ 11 64 } ] [ = ] test-word
-[ #{ 2 1 } ] [ 2 i ] [ + ] test-word
-[ #{ 2 1 } ] [ i 2 ] [ + ] test-word
-[ #{ 5 4 } ] [ #{ 2 2 } #{ 3 2 } ] [ + ] test-word
-[ 5 ] [ #{ 2 2 } #{ 3 -2 } ] [ + ] test-word
-[ #{ 1.0 1 } ] [ 1.0 i ] [ + ] test-word
+[ #{ 2 5 }# ] [ 2 5 ] [ rect> ] test-word
+[ 2 5 ] [ #{ 2 5 }# ] [ >rect ] test-word
+[ #{ 1/2 1 }# ] [ 1/2 i ] [ + ] test-word
+[ #{ 1/2 1 }# ] [ i 1/2 ] [ + ] test-word
+[ t ] [ #{ 11 64 }# #{ 11 64 }# ] [ = ] test-word
+[ #{ 2 1 }# ] [ 2 i ] [ + ] test-word
+[ #{ 2 1 }# ] [ i 2 ] [ + ] test-word
+[ #{ 5 4 }# ] [ #{ 2 2 }# #{ 3 2 }# ] [ + ] test-word
+[ 5 ] [ #{ 2 2 }# #{ 3 -2 }# ] [ + ] test-word
+[ #{ 1.0 1 }# ] [ 1.0 i ] [ + ] test-word
 
-[ #{ 1/2 -1 } ] [ 1/2 i ] [ - ] test-word
-[ #{ -1/2 1 } ] [ i 1/2 ] [ - ] test-word
-[ #{ 1/3 1/4 } ] [ 1 3 / 1 2 / i * + 1 4 / i * ] [ - ] test-word
-[ #{ -1/3 -1/4 } ] [ 1 4 / i * 1 3 / 1 2 / i * + ] [ - ] test-word
-[ #{ 1/5 1/4 } ] [ #{ 3/5 1/2 } #{ 2/5 1/4 } ] [ - ] test-word
-[ 4 ] [ #{ 5 10/3 } #{ 1 10/3 } ] [ - ] test-word
-[ #{ 1.0 -1 } ] [ 1.0 i ] [ - ] test-word
+[ #{ 1/2 -1 }# ] [ 1/2 i ] [ - ] test-word
+[ #{ -1/2 1 }# ] [ i 1/2 ] [ - ] test-word
+[ #{ 1/3 1/4 }# ] [ 1 3 / 1 2 / i * + 1 4 / i * ] [ - ] test-word
+[ #{ -1/3 -1/4 }# ] [ 1 4 / i * 1 3 / 1 2 / i * + ] [ - ] test-word
+[ #{ 1/5 1/4 }# ] [ #{ 3/5 1/2 }# #{ 2/5 1/4 }# ] [ - ] test-word
+[ 4 ] [ #{ 5 10/3 }# #{ 1 10/3 }# ] [ - ] test-word
+[ #{ 1.0 -1 }# ] [ 1.0 i ] [ - ] test-word
 
-[ #{ 0 1 } ] [ i 1 ] [ * ] test-word
-[ #{ 0 1 } ] [ 1 i ] [ * ] test-word
-[ #{ 0 1.0 } ] [ 1.0 i ] [ * ] test-word
+[ #{ 0 1 }# ] [ i 1 ] [ * ] test-word
+[ #{ 0 1 }# ] [ 1 i ] [ * ] test-word
+[ #{ 0 1.0 }# ] [ 1.0 i ] [ * ] test-word
 [ -1 ] [ i i ] [ * ] test-word
-[ #{ 0 1 } ] [ 1 i ] [ * ] test-word
-[ #{ 0 1 } ] [ i 1 ] [ * ] test-word
-[ #{ 0 1/2 } ] [ 1/2 i ] [ * ] test-word
-[ #{ 0 1/2 } ] [ i 1/2 ] [ * ] test-word
-[ 2 ] [ #{ 1 1 } #{ 1 -1 } ] [ * ] test-word
+[ #{ 0 1 }# ] [ 1 i ] [ * ] test-word
+[ #{ 0 1 }# ] [ i 1 ] [ * ] test-word
+[ #{ 0 1/2 }# ] [ 1/2 i ] [ * ] test-word
+[ #{ 0 1/2 }# ] [ i 1/2 ] [ * ] test-word
+[ 2 ] [ #{ 1 1 }# #{ 1 -1 }# ] [ * ] test-word
 [ 1 ] [ i -i ] [ * ] test-word
 
 [ -1 ] [ i -i ] [ / ] test-word
-[ #{ 0 1 } ] [ 1 -i ] [ / ] test-word
-[ t ] [ #{ 12 13 } #{ 13 14 } / #{ 13 14 } * #{ 12 13 } ] [ = ] test-word
+[ #{ 0 1 }# ] [ 1 -i ] [ / ] test-word
+[ t ] [ #{ 12 13 }# #{ 13 14 }# / #{ 13 14 }# * #{ 12 13 }# ] [ = ] test-word
 
-[ #{ -3 4 } ] [ #{ 3 -4 } ] [ neg ] test-word
+[ #{ -3 4 }# ] [ #{ 3 -4 }# ] [ neg ] test-word
 
-[ 5 ] [ #{ 3 4 } abs ] unit-test
+[ 5 ] [ #{ 3 4 }# abs ] unit-test
 [ 5 ] [ -5.0 abs ] unit-test
 
 ! Make sure arguments are sane

library/test/math/irrational.factor

@@ -9,7 +9,7 @@ USE: test
 [ 0.25 ] [ 2 -2 fpow ] unit-test
 
 [ 4.0 ] [ 16 sqrt ] unit-test
-[ #{ 0 4.0 } ] [ -16 sqrt ] unit-test
+[ #{ 0 4.0 }# ] [ -16 sqrt ] unit-test
 
 [ 4.0 ] [ 2 2 ^ ] unit-test
 [ 0.25 ] [ 2 -2 ^ ] unit-test

library/test/math/math-combinators.factor

@@ -6,15 +6,15 @@ USE: test
 [ 0 1 2 3 4 ] [ 5 [ ] times* ] unit-test
 [ ] [ 0 [ ] times* ] unit-test
 
-[ #{ 1 1 } ] [ #{ 2 3 } #{ 1 0 } 2times-succ ] unit-test
-[ #{ 1 2 } ] [ #{ 2 3 } #{ 1 1 } 2times-succ ] unit-test
-[ #{ 2 0 } ] [ #{ 3 3 } #{ 1 2 } 2times-succ ] unit-test
-[ #{ 2 1 } ] [ #{ 3 3 } #{ 2 0 } 2times-succ ] unit-test
-[ #{ 2 0 } ] [ #{ 2 2 } #{ 1 1 } 2times-succ ] unit-test
+[ #{ 1 1 }# ] [ #{ 2 3 }# #{ 1 0 }# 2times-succ ] unit-test
+[ #{ 1 2 }# ] [ #{ 2 3 }# #{ 1 1 }# 2times-succ ] unit-test
+[ #{ 2 0 }# ] [ #{ 3 3 }# #{ 1 2 }# 2times-succ ] unit-test
+[ #{ 2 1 }# ] [ #{ 3 3 }# #{ 2 0 }# 2times-succ ] unit-test
+[ #{ 2 0 }# ] [ #{ 2 2 }# #{ 1 1 }# 2times-succ ] unit-test
 
-[ #{ 0 0 } #{ 0 1 } #{ 1 0 } #{ 1 1 } ]
-[ #{ 2 2 } [ ] 2times* ] unit-test
+[ #{ 0 0 }# #{ 0 1 }# #{ 1 0 }# #{ 1 1 }# ]
+[ #{ 2 2 }# [ ] 2times* ] unit-test
 
-[ #{ 0 0 } #{ 0 1 } #{ 0 2 } #{ 1 0 } #{ 1 1 } #{ 1 2 } 
-  #{ 2 0 } #{ 2 1 } #{ 2 2 } ]
-[ #{ 3 3 } [ ] 2times* ] unit-test
+[ #{ 0 0 }# #{ 0 1 }# #{ 0 2 }# #{ 1 0 }# #{ 1 1 }# #{ 1 2 }# 
+  #{ 2 0 }# #{ 2 1 }# #{ 2 2 }# ]
+[ #{ 3 3 }# [ ] 2times* ] unit-test

library/test/parser.factor

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

library/test/unparser.factor

@@ -26,7 +26,7 @@ test-word
 [ "f" ] [ f unparse ] unit-test
 [ "t" ] [ t unparse ] unit-test
 [ "car" ] [ \ car unparse ] unit-test
-[ "#{ 1/2 2/3 }" ] [ #{ 1/2 2/3 } unparse ] unit-test
+[ "#{ 1/2 2/3 }#" ] [ #{ 1/2 2/3 }# unparse ] unit-test
 [ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
 
 [ ] [ { 1 2 3 } unparse drop ] unit-test

library/test/vectors.factor

@@ -11,7 +11,7 @@ USE: namespaces
 [ 3 ] [ { t f t } vector-length ] unit-test
 
 [ 3 { } vector-nth ] unit-test-fails
-[ 3 #{ 1 2 } vector-nth ] unit-test-fails
+[ 3 #{ 1 2 }# vector-nth ] unit-test-fails
 
 [ "hey" [ 1 2 ] set-vector-length ] unit-test-fails
 [ "hey" { 1 2 } set-vector-length ] unit-test-fails

library/threads.factor

@@ -2,7 +2,7 @@
 
 ! $Id$
 !
-! Copyright (C) 2004 Slava Pestov.
+! Copyright (C) 2004, 2005 Slava Pestov.
 ! 
 ! Redistribution and use in source and binary forms, with or without
 ! modification, are permitted provided that the following conditions are met:
@@ -35,14 +35,8 @@ USE: namespaces
 ! Core of the multitasker. Used by io-internals.factor and
 ! in-thread.factor.
 
-: run-queue ( -- queue )
-    9 getenv ;
-
-: set-run-queue ( queue -- )
-    9 setenv ;
-
-: init-threads ( -- )
-    f set-run-queue ;
+: run-queue ( -- queue ) 9 getenv ;
+: set-run-queue ( queue -- ) 9 setenv ;
 
 : next-thread ( -- quot )
     #! Get and remove the next quotation from the run queue.

library/tools/interpreter.factor

@@ -72,7 +72,7 @@ SYMBOL: meta-cf
     meta-cf get not ;
 
 : done? ( -- ? )
-    done-cf? meta-r get vector-empty? and ;
+    done-cf? meta-r get vector-length 0 = and ;
 
 ! Callframe.
 : up ( -- )

library/vectors.factor

@@ -66,9 +66,6 @@ BUILTIN: vector 11
     #! capacity.
     dup <vector> dup >r set-vector-length r> ;
 
-: vector-empty? ( obj -- ? )
-    vector-length 0 = ;
-
 : vector-push ( obj vector -- )
     #! Push a value on the end of a vector.
     dup vector-length swap set-vector-nth ;
@@ -165,12 +162,9 @@ M: vector = ( obj vec -- ? )
         ] ifte
     ] ifte ;
 
-: ?vector-nth ( n vec -- obj/f )
-    2dup vector-length >= [ 2drop f ] [ vector-nth ] ifte ;
-
 M: vector hashcode ( vec -- n )
-    0 swap 4 [
-        over ?vector-nth hashcode rot bitxor swap
+    0 swap dup vector-length 4 min [
+        over vector-nth hashcode rot bitxor swap
     ] times* drop ;
 
 : vector-head ( n vector -- list )

library/words.factor

@@ -73,6 +73,15 @@ PREDICATE: word primitive ( obj -- ? ) word-primitive 2 > ;
 PREDICATE: word symbol    ( obj -- ? ) word-primitive 2 = ;
 PREDICATE: word undefined ( obj -- ? ) word-primitive 0 = ;
 
+! These should really be somewhere in library/generic/, but
+! during bootstrap, we cannot execute parsing words after they
+! are defined by code loaded into the target image.
+PREDICATE: compound generic ( word -- ? )
+    "combination" word-property ;
+
+PREDICATE: compound promise ( obj -- ? )
+    "promise" word-property ;
+
 : define ( word primitive parameter -- )
     pick set-word-parameter
     over set-word-primitive