-(defvar *quark-counter* 0)
-
-(defun %quark-get-reserved ()
- ;; The string is just a dummy
- (%quark-from-string (format nil "#@£$%&-quark-~D" (incf *quark-counter*))))
-
-(defvar *quark-from-object* (make-hash-table))
-(defvar *quark-to-object* (make-hash-table))
-
-(defun quark-from-object (object &key (test #'eq))
- (let ((hash-code (sxhash object)))
- (or
- (assoc-ref object (gethash hash-code *quark-from-object*) :test test)
- (let ((quark (%quark-get-reserved)))
- (setf
- (gethash hash-code *quark-from-object*)
- (append
- (gethash hash-code *quark-from-object*)
- (list (cons object quark))))
- (setf (gethash quark *quark-to-object*) object)
- quark))))
-
-(defun quark-to-object (quark)
- (gethash quark *quark-to-object*))
-
-(defun remove-quark (quark)
- (let* ((object (gethash quark *quark-to-object*))
- (hash-code (sxhash object)))
- (remhash quark *quark-to-object*)
- (unless (setf
- (gethash hash-code *quark-from-object*)
- (assoc-delete object (gethash hash-code *quark-from-object*)))
- (remhash hash-code *quark-from-object*))))
+(defun quark-intern (object)
+ (etypecase object
+ (quark object)
+ (string (%quark-from-string object))
+ (symbol (%quark-from-string (format nil "clg-~A:~A"
+ (package-name (symbol-package object))
+ object)))))