Add support for uninterned symbols

s-expressionists · May 6, 2024 · 0d8cb2e · 0d8cb2e
1 parent 1fd76bd
commit 0d8cb2e
Show file tree

Hide file tree

Showing 4 changed files with 49 additions and 20 deletions.
diff --git a/code/client.lisp b/code/client.lisp
@@ -79,6 +79,13 @@
                               (cl:package-name (symbol-package symbol))
                               (cl:symbol-name symbol)))))))))
 
+(defmethod reader:interpret-symbol ((client            client)
+                                    (input-stream      t)
+                                    (package-indicator null)
+                                    (symbol-name       t)
+                                    (internp           t))
+  (make-instance 'uninterned-symbol-token :name symbol-name))
+
 ;;; Source position
 
 (defmethod eclector.base:source-position ((client client) (stream buffer-stream))

diff --git a/code/package.lisp b/code/package.lisp
@@ -23,7 +23,9 @@
    #:package-name
    #:name
 
-   #:non-existing-package-symbol-token ; classes
+   #:uninterned-symbol-token ; classes
+   #:interned-symbol-token
+   #:non-existing-package-symbol-token
    #:non-existing-symbol-token
    #:existing-symbol-token)
 

diff --git a/code/token.lisp b/code/token.lisp
@@ -26,21 +26,9 @@
          symbol-name)))
 
 (defclass symbol-token (token)
-  ((%package-marker-1 :initarg  :package-marker-1
-                      :type     (or null integer)
-                      :reader   package-marker-1
-                      :initform nil)
-   (%package-marker-2 :initarg  :package-marker-2
-                      :type     (or null integer)
-                      :reader   package-marker-2
-                      :initform nil)
-   (%package-name     :initarg  :package-name
-                      :type     (or null string)
-                      :reader   package-name
-                      :initform nil)
-   (%name             :initarg  :name
-                      :type     string
-                      :reader   name)))
+  ((%name :initarg  :name
+          :type     string
+          :reader   name)))
 
 (defun maybe-truncate-string (thing &key (limit 32))
   (cond ((not (stringp thing))
@@ -52,17 +40,43 @@
 
 (defmethod print-object ((object symbol-token) stream)
   (print-unreadable-object (object stream :type t :identity t)
-    (format stream "[~A]~:[~;:~]~:[~;:~]~A"
+    (format stream "~@[[~A]~]~:[~;:~]~:[~;:~]~A"
             (maybe-truncate-string (package-name object))
             (package-marker-1 object)
             (package-marker-2 object)
             (maybe-truncate-string (name object)))))
 
-(defclass non-existing-package-symbol-token (symbol-token)
+(defclass uninterned-symbol-token (symbol-token)
+  ())
+
+(defmethod package-marker-1 ((symbol-token uninterned-symbol-token))
+  nil)
+
+(defmethod package-marker-2 ((symbol-token uninterned-symbol-token))
+  nil)
+
+(defmethod package-name ((symbol-token uninterned-symbol-token))
+  nil)
+
+(defclass interned-symbol-token (symbol-token)
+  ((%package-marker-1 :initarg  :package-marker-1
+                      :type     (or null integer)
+                      :reader   package-marker-1
+                      :initform nil)
+   (%package-marker-2 :initarg  :package-marker-2
+                      :type     (or null integer)
+                      :reader   package-marker-2
+                      :initform nil)
+   (%package-name     :initarg  :package-name
+                      :type     (or null string)
+                      :reader   package-name
+                      :initform nil)))
+
+(defclass non-existing-package-symbol-token (interned-symbol-token)
   ())
 
-(defclass non-existing-symbol-token (symbol-token)
+(defclass non-existing-symbol-token (interned-symbol-token)
   ())
 
-(defclass existing-symbol-token (symbol-token)
+(defclass existing-symbol-token (interned-symbol-token)
   ())
diff --git a/test/test.lisp b/test/test.lisp
@@ -16,6 +16,12 @@
     ("\".\""
      '((inc:atom-wad ((0 0) (0 3)) (:raw ".")
         (inc:text-wad ((0 1) (0 2))))))
+    ("#:foo"
+     `((inc:atom-wad ((0 0) (0 5))
+        (:raw (inc:uninterned-symbol-token :symbol (nil "FOO")))
+        (inc:punctuation-wad ((0 0) (0 1)))
+        (inc:punctuation-wad ((0 1) (0 2)))
+        (inc:word-wad ((0 2) (0 5))))))
     ("foo::bar"
      '((inc:atom-wad ((0 0) (0 8))
         (:raw (inc:symbol-token :symbol ("FOO" "BAR")))