fix M: complex hashcode

library/bootstrap/boot-stage2.factor

@@ -34,43 +34,44 @@ USE: stdio
 "Cold boot in progress..." print
 
 [
+    "/version.factor"
     "/version.factor"
     "/library/stack.factor"
-    "/library/kernel.factor"
-    "/library/generic/generic.factor"
-    "/library/generic/object.factor"
-    "/library/generic/builtin.factor"
-    "/library/generic/predicate.factor"
-    "/library/generic/traits.factor"
-    "/library/math/math.factor"
-    "/library/cons.factor"
     "/library/combinators.factor"
+    "/library/kernel.factor"
     "/library/logic.factor"
-    "/library/vectors.factor"
+    "/library/cons.factor"
-    "/library/lists.factor"
     "/library/assoc.factor"
+    "/library/math/generic.factor"
+    "/library/words.factor"
     "/library/math/arithmetic.factor"
     "/library/math/math-combinators.factor"
+    "/library/math/math.factor"
+    "/library/lists.factor"
+    "/library/vectors.factor"
     "/library/strings.factor"
     "/library/hashtables.factor"
     "/library/namespaces.factor"
     "/library/list-namespaces.factor"
     "/library/sbuf.factor"
-    "/library/continuations.factor"
     "/library/errors.factor"
+    "/library/continuations.factor"
     "/library/threads.factor"
     "/library/io/stream.factor"
+    "/library/io/stdio.factor"
     "/library/io/io-internals.factor"
     "/library/io/stream-impl.factor"
-    "/library/io/stdio.factor"
-    "/library/words.factor"
     "/library/vocabularies.factor"
     "/library/syntax/parse-numbers.factor"
     "/library/syntax/parser.factor"
-    "/library/syntax/parse-syntax.factor"
     "/library/syntax/parse-stream.factor"
-    "/library/math/generic.factor"
+    "/library/generic/generic.factor"
+    "/library/generic/object.factor"
+    "/library/generic/builtin.factor"
+    "/library/generic/predicate.factor"
+    "/library/generic/traits.factor"
     "/library/bootstrap/init.factor"
+    "/library/syntax/parse-syntax.factor"
 
     "/library/format.factor"
     "/library/syntax/unparser.factor"

library/hashtables.factor

@@ -93,27 +93,3 @@ PREDICATE: vector hashtable ( obj -- ? )
 
 : alist>hash ( alist -- hash )
     37 <hashtable> swap [ unswons pick set-hash ] each ;
-
-: hash-map ( hash code -- hash )
-    #! Apply the code to each key/value pair of the hashtable,
-    #! collecting return values in a new hashtable.
-    >r hash>alist r> map alist>hash ;
-
-! In case I break hashing:
-
-! : hash ( key table -- value )
-!     hash>alist assoc ;
-! 
-! : set-hash ( value key table -- )
-!     dup vector-length [
-!         ( value key table index )
-!         >r 3dup r>
-!         ( value key table value key table index )
-!         [
-!             swap vector-nth
-!             ( value key table value key alist )
-!             set-assoc
-!         ] keep
-!         ( value key table new-assoc index )
-!         pick set-vector-nth
-!     ] times* 3drop ;

library/kernel.factor

@@ -76,7 +76,7 @@ USE: vectors
         [ cons-hashcode     ] ! 2
         [ drop 0  ] ! 3
         [ >fixnum           ] ! 4
-        [ >fixnum           ] ! 5
+        [ >rect >fixnum swap >fixnum bitxor           ] ! 5
         [ drop 0  ] ! 6
         [ drop 0  ] ! 7
         [ drop 0  ] ! 8

library/syntax/parse-numbers.factor

@@ -27,6 +27,7 @@
 
 IN: parser
 USE: errors
+USE: generic
 USE: kernel
 USE: lists
 USE: math
@@ -47,14 +48,14 @@ USE: unparser
         [ drop t ] [ not-a-number ]
     ] cond ;
 
-: digit ( num digit base -- num )
+: digit+ ( num digit base -- num )
     2dup < [ rot * + ] [ not-a-number ] ifte ;
 
 : (base>) ( base str -- num )
     dup str-length 0 = [
         not-a-number
     ] [
-        0 swap [ digit> pick digit ] str-each nip
+        0 swap [ digit> pick digit+ ] str-each nip
     ] ifte ;
 
 : base> ( str base -- num )
@@ -62,16 +63,19 @@ USE: unparser
     #! conversion fails.
     swap "-" ?str-head [ (base>) neg ] [ (base>) ] ifte ;
 
-: str>ratio ( str -- num )
+DEFER: str>number
+FORGET: str>number
+GENERIC: str>number ( str -- num )
+
+M: string str>number 10 base> ;
+
+PREDICATE: string potential-ratio "/" swap str-contains? ;
+M: potential-ratio str>number ( str -- num )
     dup CHAR: / index-of str// swap 10 base> swap 10 base> / ;
 
-: str>number ( str -- num )
+PREDICATE: string potential-float "." swap str-contains? ;
-    #! Convert a string to a number; throws errors.
+M: potential-float str>number ( str -- num )
-    [
+    str>float ;
-        [ "/" swap str-contains? ] [ str>ratio ]
-        [ "." swap str-contains? ] [ str>float ]
-        [ drop t                 ] [ 10 base>  ]
-    ] cond ;
 
 : parse-number ( str -- num )
     #! Convert a string to a number; return f on error.

library/test/hashtables.factor

@@ -34,3 +34,15 @@ unit-test
 [ t ] [ 12 hashcode 12 hashcode = ] unit-test
 [ t ] [ 12 >bignum hashcode 12 hashcode = ] unit-test
 [ t ] [ 12.0 hashcode 12 >bignum hashcode = ] unit-test
+
+! Test various odd keys to see if they work.
+
+16 <hashtable> "testhash" set
+
+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
+[ f ] [ 100 fac "testhash" get hash* cdr ] unit-test
+[ { } ] [ { [ { } ] } vector-clone "testhash" get hash* cdr ] unit-test

library/words.factor

@@ -63,8 +63,3 @@ PREDICATE: word undefined ( obj -- ? ) word-primitive 0 = ;
 : word-vocabulary ( word -- str ) "vocabulary" word-property ;
 : stack-effect    ( word -- str ) "stack-effect" word-property ;
 : documentation   ( word -- str ) "documentation" word-property ;
-
-: word-clone ( word -- word )
-    dup word-primitive
-    over word-parameter
-    rot word-plist <word> ;

native/run.h

@@ -74,11 +74,6 @@ INLINE void cpush(CELL top)
 	put(cs,top);
 }
 
-INLINE CELL cpeek(void)
-{
-	return get(cs);
-}
-
 INLINE void call(CELL quot)
 {
 	/* tail call optimization */