From 8af5ce4c8ac20ab37da538421789a6b47158b698 Mon Sep 17 00:00:00 2001 From: Alex Wood Date: Wed, 26 Jun 2024 11:07:46 -0400 Subject: [PATCH] Save specifiers for nicer printing (#30) --- classes.lisp | 3 ++- generic-functions.lisp | 11 ++++++++--- parse.lisp | 2 ++ 3 files changed, 12 insertions(+), 4 deletions(-) diff --git a/classes.lisp b/classes.lisp index 261b4a8..fc0ea3c 100644 --- a/classes.lisp +++ b/classes.lisp @@ -1,6 +1,7 @@ (in-package #:ctype) -(defclass ctype () ()) +(defclass ctype () + ((%specifier :accessor %specifier :initform nil))) (defmethod make-load-form ((obj ctype) &optional env) (make-load-form-saving-slots obj :environment env)) diff --git a/generic-functions.lisp b/generic-functions.lisp index b846f1d..539e432 100644 --- a/generic-functions.lisp +++ b/generic-functions.lisp @@ -81,13 +81,18 @@ (defgeneric unparse (ctype)) +(defun specifier (ctype) + ;; If we've saved the original specifier use that. + ;; Otherwise try to compute a reasonable unparse. + (or (%specifier ctype) (unparse ctype))) + (defmethod print-object ((ct ctype) stream) - (multiple-value-bind (unparse failure) - (ignore-errors (unparse ct)) + (multiple-value-bind (specifier failure) + (ignore-errors (specifier ct)) (if failure (call-next-method) (print-unreadable-object (ct stream :type t) - (write unparse :stream stream)))) + (write specifier :stream stream)))) ct) (macrolet diff --git a/parse.lisp b/parse.lisp index 0f511fe..5eea92c 100644 --- a/parse.lisp +++ b/parse.lisp @@ -555,10 +555,12 @@ (let ((ct (parse client specifier env))) (when (typep ct 'cvalues) (error "Found ~s in non-~s context" (unparse ct) 'values)) + (setf (%specifier ct) specifier) ct)) (defun values-specifier-ctype (client specifier &optional env) (let ((ct (parse client specifier env))) + (setf (%specifier ct) specifier) (if (typep ct 'cvalues) ct ;; Treat X as (values X).