 
 <PRIVATE
 
+! Object cache; we only consider numbers equal if they have the
+! same type
+TUPLE: id obj ;
+
+C: <id> id
+
+M: id hashcode* obj>> hashcode* ;
+
+M: id equal?
+    over id? [
+        [ obj>> ] bi@
+        [ = ] [
+            dup number? [
+                [ class ] bi@ =
+            ] [
+                2drop t
+            ] if
+        ] 2bi and
+    ] [
+        2drop f
+    ] if ;
+
+SYMBOL: objects
+
+: (objects) <id> objects get ; inline
+
+: lookup-object ( obj -- n/f ) (objects) at ;
+
+: put-object ( n obj -- ) (objects) set-at ;
+
+: cache-object ( obj quot -- value )
+    >r (objects) r> [ obj>> ] prepose cache ; inline
+
 ! Constants
 
 : image-magic HEX: 0f0e0d0c ; inline

        ] bi
        \ word type-number object tag-number
        [ emit-seq ] emit-object
    ] keep objects get set-at ;

: word-error ( word msg -- * )
    [ % dup word-vocabulary % " " % word-name % ] "" make throw ;

M: string '
    #! We pool strings so that each string is only written once
    #! to the image
    [ emit-string ] cache-object ;

: assert-empty ( seq -- )
    length 0 assert= ;
