Very ragged work-in-progress.

[sod] / pset.lisp

diff --git a/pset.lisp b/pset.lisp
index f1c1172..67a77fc 100644 (file)
--- a/pset.lisp
+++ b/pset.lisp
@@ -39,11 +39,13 @@
 
 (defun property-type (value)
   "Guess the right property type to use for VALUE."
 
 (defun property-type (value)
   "Guess the right property type to use for VALUE."

-  (etypecase value
+  (typecase value

     (symbol :symbol)
     (integer :integer)
     (string :string)
     (symbol :symbol)
     (integer :integer)
     (string :string)

-    (c-fragment :frag)))
+    (character :char)
+    (c-fragment :frag)
+    (t :other)))

 
 (defstruct (property
             (:conc-name p-)
 
 (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."
 
    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)
   (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
    "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)))
 
   (: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)
   ;; 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 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)))
 
   (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'"
   (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.
 
 ;;;--------------------------------------------------------------------------
 ;;; Property set parsing.


@@ -190,8 +190,8 @@
 (defun parse-expression (lexer)
   "Parse an expression from the LEXER.
 
 (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:
    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.
 
               ;; 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)
                (push (cons (token-type lexer)
                            (token-value lexer))
                      valstack)