fix M: complex hashcode

diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor
index 4471d3012bb56fe585f38c930c1f90dbad77fbfe..830a8f9b656edfb995243d4b55f390277d969897 100644 (file)
--- a/library/bootstrap/boot-stage2.factor
+++ b/library/bootstrap/boot-stage2.factor
@@ -34,43 +34,44 @@ USE: stdio
 "Cold boot in progress..." print\r
 \r
 [\r
+    "/version.factor"\r
     "/version.factor"\r
     "/library/stack.factor"\r
-    "/library/kernel.factor"\r
-    "/library/generic/generic.factor"\r
-    "/library/generic/object.factor"\r
-    "/library/generic/builtin.factor"\r
-    "/library/generic/predicate.factor"\r
-    "/library/generic/traits.factor"\r
-    "/library/math/math.factor"\r
-    "/library/cons.factor"\r
     "/library/combinators.factor"\r
+    "/library/kernel.factor"\r
     "/library/logic.factor"\r
-    "/library/vectors.factor"\r
-    "/library/lists.factor"\r
+    "/library/cons.factor"\r
     "/library/assoc.factor"\r
+    "/library/math/generic.factor"\r
+    "/library/words.factor"\r
     "/library/math/arithmetic.factor"\r
     "/library/math/math-combinators.factor"\r
+    "/library/math/math.factor"\r
+    "/library/lists.factor"\r
+    "/library/vectors.factor"\r
     "/library/strings.factor"\r
     "/library/hashtables.factor"\r
     "/library/namespaces.factor"\r
     "/library/list-namespaces.factor"\r
     "/library/sbuf.factor"\r
-    "/library/continuations.factor"\r
     "/library/errors.factor"\r
+    "/library/continuations.factor"\r
     "/library/threads.factor"\r
     "/library/io/stream.factor"\r
+    "/library/io/stdio.factor"\r
     "/library/io/io-internals.factor"\r
     "/library/io/stream-impl.factor"\r
-    "/library/io/stdio.factor"\r
-    "/library/words.factor"\r
     "/library/vocabularies.factor"\r
     "/library/syntax/parse-numbers.factor"\r
     "/library/syntax/parser.factor"\r
-    "/library/syntax/parse-syntax.factor"\r
     "/library/syntax/parse-stream.factor"\r
-    "/library/math/generic.factor"\r
+    "/library/generic/generic.factor"\r
+    "/library/generic/object.factor"\r
+    "/library/generic/builtin.factor"\r
+    "/library/generic/predicate.factor"\r
+    "/library/generic/traits.factor"\r
     "/library/bootstrap/init.factor"\r
+    "/library/syntax/parse-syntax.factor"\r
 \r
     "/library/format.factor"\r
     "/library/syntax/unparser.factor"\r

diff --git a/library/hashtables.factor b/library/hashtables.factor
index db3cd9316a109a44308714df184fbce9a5c18153..63238063be65b1032aabd260c7d6ac0fba8fccb1 100644 (file)
--- a/library/hashtables.factor
+++ b/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 ;

diff --git a/library/kernel.factor b/library/kernel.factor
index bd9e2aeae468b1cf978a031d3df85b7448456da2..28f700640cfb9b41cded1969eaa1c7d46d38296d 100644 (file)
--- a/library/kernel.factor
+++ b/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

diff --git a/library/syntax/parse-numbers.factor b/library/syntax/parse-numbers.factor
index 5d5f8ba80b8ed15f18f839022adbfa6e73f7e370..da8438c34d792d4794aecbf630828aafbb1aeab1 100644 (file)
--- a/library/syntax/parse-numbers.factor
+++ b/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 )
-    #! Convert a string to a number; throws errors.
-    [
-        [ "/" swap str-contains? ] [ str>ratio ]
-        [ "." swap str-contains? ] [ str>float ]
-        [ drop t                 ] [ 10 base>  ]
-    ] cond ;
+PREDICATE: string potential-float "." swap str-contains? ;
+M: potential-float str>number ( str -- num )
+    str>float ;
 
 : parse-number ( str -- num )
     #! Convert a string to a number; return f on error.

diff --git a/library/test/hashtables.factor b/library/test/hashtables.factor
index 663c052fc4b25632a6a13859635c084411e77c48..3f76647c60f9876180e28af7676a9923a382ada4 100644 (file)
--- a/library/test/hashtables.factor
+++ b/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

diff --git a/library/words.factor b/library/words.factor
index c5c93175064782b7dc2844e7f552d38e7e9a4ca1..406c72bce99189347fb430852e290fc02a11d7c0 100644 (file)
--- a/library/words.factor
+++ b/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> ;

diff --git a/native/run.h b/native/run.h
index 2a5d4691f4cce22ce7f1a2ca98ca169830c936c5..1033f23a0ddf9a21acee39b4824181853353cbcc 100644 (file)
--- a/native/run.h
+++ b/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 */