X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/abdf50aad1a95f1df8d11c54ff1623077eb84193..1f1d88f5234188f70548a04fd117ac6e251fe8de:/pset.lisp?ds=sidebyside

diff --git a/pset.lisp b/pset.lisp
index f1c1172..67a77fc 100644
--- a/pset.lisp
+++ b/pset.lisp
@@ -39,11 +39,13 @@
 
 (defun property-type (value)
   "Guess the right property type to use for VALUE."
-  (etypecase value
+  (typecase value
     (symbol :symbol)
     (integer :integer)
     (string :string)
-    (c-fragment :frag)))
+    (character :char)
+    (c-fragment :frag)
+    (t :other)))
 
 (defstruct (property
 	     (:conc-name p-)
@@ -87,7 +89,6 @@
    processed; don't put colons in package names if you want to use them from
    SOD property sets."
 
-  (declare (optimize debug))
   (let* ((length (length string))
 	 (colon (position #\: string)))
     (multiple-value-bind (start internalp)
@@ -120,18 +121,17 @@
    "Convert VALUE, a property of type TYPE, to be of type WANTED.")
 
   ;; If TYPE matches WANTED, we'll assume that VALUE already has the right
-  ;; form.
-  (:method :around (value type wanted)
-    (if (eq type wanted)
-	value
-	(call-next-method)))
-
-  ;; If nothing else matched, then I guess we'll have to say it didn't work.
+  ;; form.  Otherwise, if nothing else matched, then I guess we'll have to
+  ;; say it didn't work.
   (:method (value type wanted)
     (if (eql type wanted)
 	value
 	(error "Incorrect type: expected ~A but found ~A" wanted type)))
 
+  ;; If the caller asks for type T then give him the raw thing.
+  (:method (value type (wanted (eql t)))
+    value)
+
   ;; Keywords.
   (:method ((value symbol) (type (eql :symbol)) (wanted (eql :keyword)))
     value)
@@ -158,10 +158,10 @@
    the value and its file location.  In the latter case, mark the property as
    having been used.
 
-   The value returned depends on the TYPE argument provided.  If you pass T
-   (meaning any type) then you get back the entire PROPERTY object.
-   Otherwise the value is coerced to the right kind of thing (where possible)
-   and returned."
+   The value returned depends on the TYPE argument provided.  If you pass NIL
+   then you get back the entire PROPERTY object.  If you pass T, then you get
+   whatever was left in the property set, uninterpreted.  Otherwise the value
+   is coerced to the right kind of thing (where possible) and returned."
 
   (let ((prop (find name pset :key #'p-key)))
     (with-default-error-location ((and prop (p-location prop)))
@@ -182,7 +182,7 @@
   (dolist (prop pset)
     (unless (p-seenp prop)
       (cerror*-with-location (p-location prop) "Unknown property `~A'"
-			     (p-name prop)))))a
+			     (p-name prop)))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Property set parsing.
@@ -190,8 +190,8 @@
 (defun parse-expression (lexer)
   "Parse an expression from the LEXER.
 
-   The return values are the expression's VALUE and TYPE; currently the
-   types are :ID, :INTEGER and :STRING.  If an error prevented a sane value
+   The return values are the expression's VALUE and TYPE; currently the types
+   are :ID, :INTEGER, :STRING, and :CHAR.  If an error prevented a sane value
    being produced, the TYPE :INVALID is returned.
 
    Expression syntax is rather limited at the moment:
@@ -283,7 +283,7 @@
 
 	       ;; Aha.  A primary.  Push it onto the stack, and see if
 	       ;; there's an infix operator.
-	       ((:integer :id :string)
+	       ((:integer :id :string :char)
 		(push (cons (token-type lexer)
 			    (token-value lexer))
 		      valstack)