about to bootstrap hashstable

TODO.FACTOR.txt

@@ -7,7 +7,6 @@
       f f G:110887
   } } }
 - intrinsic char-slot set-char-slot for x86
-- fix remaining GL issues
 - closing ui does not stop timers
 - adding/removing timers automatically for animated gadgets
 - saving image with UI open
@@ -18,6 +17,9 @@
 - remove word transfer hack in bootstrap
 - the invalid recursion form case needs to be fixed, for inlines too
 - what about tasks and timers between image restarts
+- new hashtable
+  - bootstrap it in
+  - double hash
 
 + ui:
 

library/bootstrap/boot-stage1.factor

@@ -11,14 +11,7 @@ vectors words ;
 
 ! The [ ] make form creates a boot quotation
 [
-    [
+    \ boot ,
-        ! initialize it twice so that we get a catchstack
-        ! early on for each-object.
-        init-error-handler
-        [ hashtable? ] instances
-        [ dup hash-size 1 max swap set-bucket-count ] each
-        boot
-    ] %
 
     {
         "/version.factor"

library/bootstrap/image.factor

@@ -188,8 +188,7 @@ M: f ' ( obj -- ptr )
 
 : transfer-word ( word -- word )
     #! This is a hack. See doc/bootstrap.txt.
-    dup dup word-name swap word-vocabulary lookup
+    dup target-word [ ] [ dup "Missing DEFER: " word-error ] ?if ;
-    [ ] [ dup "Missing DEFER: " word-error ] ?if ;
 
 : pooled-object ( object -- ptr ) objects get hash ;
 

library/generic/generic.factor

@@ -96,12 +96,18 @@ M: generic definer drop \ G: ;
         over word-name " is not a class" append throw
     ] unless 2drop ;
 
+: with-methods ( word quot -- | quot: methods -- )
+    #! Applies a quotation to the method hash and regenerates
+    #! the generic.
+    swap [ "methods" word-prop swap call ] keep make-generic ;
+    inline
+
 : define-method ( definition class generic -- )
-    >r reintern r> 2dup check-method
+    >r bootstrap-word r> 2dup check-method
-    [ "methods" word-prop set-hash ] keep make-generic ;
+    [ set-hash ] with-methods ;
 
 : forget-method ( class generic -- )
-    [ "methods" word-prop remove-hash ] keep make-generic ;
+    [ remove-hash ] with-methods ;
 
 : init-methods ( word -- )
      dup "methods" word-prop
@@ -111,13 +117,7 @@ M: generic definer drop \ G: ;
 
 : bootstrap-combination ( quot -- quot )
     #! Bootstrap hack.
-    global [
+    global [ [ dup word? [ target-word ] when ] map ] bind ;
-        [
-            dup word? [
-                dup word-name swap word-vocabulary lookup
-            ] when
-        ] map
-    ] bind ;
 
 : define-generic* ( word combination -- )
     bootstrap-combination
@@ -196,10 +196,9 @@ PREDICATE: word predicate "definition" word-prop ;
     ] map [ drop f ] swap alist>quot ;
 
 : set-members ( class members -- )
-    [ reintern ] map "members" set-word-prop ;
+    [ bootstrap-word ] map "members" set-word-prop ;
 
 : define-union ( class predicate members -- )
-    #! We have to turn the f object into the f word, same for t.
     3dup nip set-members pick define-class
     union-predicate define-predicate ;
 

library/generic/math-combination.factor

@@ -38,7 +38,7 @@ TUPLE: no-math-method left right generic ;
     [ ] [ [ no-math-method ] curry ] ?if ;
 
 : object-method ( generic -- quot )
-    object reintern applicable-method ;
+    object bootstrap-word applicable-method ;
 
 : math-method ( word left right -- quot )
     [ type>class ] 2apply 2dup and [

library/generic/standard-combination.factor

@@ -20,7 +20,7 @@ namespaces sequences vectors words ;
 : sort-methods ( assoc n -- vtable )
     #! Input is a predicate -> method association.
     [
-        type>class [ object reintern ] unless*
+        type>class [ object bootstrap-word ] unless*
         swap [ car classes-intersect? ] subset-with
     ] map-with ;
 
@@ -43,7 +43,7 @@ namespaces sequences vectors words ;
 
 : <vtable> ( picker word n -- vtable )
     #! n is vtable size; either num-types or num-tags.
-    >r 2dup empty-method \ object reintern
+    >r 2dup empty-method \ object bootstrap-word
     swons >r methods r> swons r> sort-methods vtable-methods ;
 
 : small-generic ( picker word -- def )

library/generic/tuple.factor

@@ -72,7 +72,7 @@ PREDICATE: word tuple-class "tuple-size" word-prop ;
     >r create-in
     dup intern-symbol
     dup tuple-predicate
-    dup \ tuple reintern "superclass" set-word-prop
+    dup \ tuple bootstrap-word "superclass" set-word-prop
     dup define-class
     dup r> tuple-slots
     default-constructor ;

library/test/benchmark/hashtables.factor

@@ -1,15 +1,17 @@
-USING: compiler hashtables kernel math namespaces sequences test ;
+IN: temporary
+USING: compiler hashtables kernel math memory namespaces
+sequences strings test ;
 
-: store-hash ( hashtable n -- )
+: store-hash ( hashtable seq -- )
     [ dup pick set-hash ] each drop ;
 
-: lookup-hash ( hashtable n -- )
+: lookup-hash ( hashtable seq -- )
     [ over hash drop ] each drop ;
 
-: hashtable-benchmark ( -- )
+: hashtable-benchmark ( seq -- )
     100 [
         drop
-        80000 100000 <hashtable> swap 2dup store-hash lookup-hash
+        100000 <hashtable> swap 2dup store-hash lookup-hash
-    ] each ; compiled
+    ] each-with ; compiled
 
-[ ] [ hashtable-benchmark ] unit-test
+[ ] [ [ string? ] instances hashtable-benchmark ] unit-test

library/vocabularies.factor

@@ -79,12 +79,15 @@ SYMBOL: vocabularies
     #! Test if the word is a member of its vocabulary.
     dup word-name over word-vocabulary lookup eq? ;
 
-: reintern ( word -- word )
+: bootstrap-word ( word -- word )
     dup word-name swap word-vocabulary
     bootstrapping? get [
         dup "syntax" = [ drop "!syntax" ] when
     ] when lookup ;
 
+: target-word ( word -- word )
+    dup word-name swap word-vocabulary lookup ;
+
 "scratchpad" "in" set
 [
     "scratchpad"

native/factor.c

@@ -42,7 +42,7 @@ int main(int argc, char** argv)
 	CELL generations = 2;
 	CELL young_size = 8;
 	CELL aging_size = 16;
-	CELL code_size = 2;
+	CELL code_size = 4;
 	CELL literal_size = 128;
 	CELL args;
 	CELL i;

native/hashtable.c

@@ -19,10 +19,14 @@ void primitive_hashtable(void)
 
 void fixup_hashtable(F_HASHTABLE* hashtable)
 {
+	data_fixup(&hashtable->count);
+	data_fixup(&hashtable->deleted);
 	data_fixup(&hashtable->array);
 }
 
 void collect_hashtable(F_HASHTABLE* hashtable)
 {
+	copy_handle(&hashtable->count);
+	copy_handle(&hashtable->deleted);
 	copy_handle(&hashtable->array);
 }