Refactoring more or less complete. Maybe I should test it.

[sod] / src / pset-proto.lisp

diff --git a/src/pset-proto.lisp b/src/pset-proto.lisp
index aafa306..91668ed 100644 (file)
--- a/src/pset-proto.lisp
+++ b/src/pset-proto.lisp
@@ -38,27 +38,14 @@
     (symbol name)
     (string (intern (frob-identifier name) :keyword))))
 
-(export 'property-type)
-(defgeneric property-type (value)
-  (:documentation "Guess a sensible property type to use for VALUE.")
-  (:method ((value symbol)) :symbol)
-  (:method ((value integer)) :int)
-  (:method ((value string)) :string)
-  (:method ((value character)) :char)
-  (:method (value) :other))
-
-(export '(property propertyp make-property
-         p-name p-value p-type p-key p-seenp))
+(export '(property propertyp p-name p-value p-type p-key p-seenp))
 (defstruct (property
             (:predicate propertyp)
             (:conc-name p-)
-            (:constructor make-property
-              (name value
-               &key (type (property-type value))
-                    ((:location %loc))
-                    seenp
-               &aux (key (property-key name))
-                    (location (file-location %loc)))))
+            (:constructor %make-property
+                          (name value
+                           &key type location seenp
+                           &aux (key (property-key name)))))
   "A simple structure for holding a property in a property set.
 
    The main useful feature is the ability to tick off properties which have
@@ -75,6 +62,27 @@
   (key nil :type symbol)
   (seenp nil :type boolean))
 
+(export 'decode-property)
+(defgeneric decode-property (raw)
+  (:documentation "Decode a RAW value into a TYPE, VALUE pair.")
+  (:method ((raw symbol)) (values :symbol raw))
+  (:method ((raw integer)) (values :int raw))
+  (:method ((raw string)) (values :string raw))
+  (:method ((raw character)) (values :char raw))
+  (:method ((raw property)) (values (p-type raw) (p-value raw)))
+  (:method ((raw cons)) (values (car raw) (cdr raw))))
+
+(export 'make-property)
+(defun make-property (name raw-value &key type location seenp)
+  (multiple-value-bind (type value)
+      (if type
+         (values type raw-value)
+         (decode-property raw-value))
+    (%make-property name value
+                   :type type
+                   :location (file-location location)
+                   :seenp seenp)))
+
 (defun string-to-symbol
     (string &key (package *package*) (swap-case t) (swap-hyphen t))
   "Convert STRING to a symbol in PACKAGE.
@@ -186,9 +194,9 @@
   (with-gensyms (next win key value)
     `(with-hash-table-iterator (,next (%pset-hash ,pset))
        (macrolet ((,name ()
-                   (multiple-value-bind (,win ,key ,value) (,next)
-                     (declare (ignore ,key))
-                     (and ,win ,value))))
+                   `(multiple-value-bind (,',win ,',key ,',value) (,',next)
+                     (declare (ignore ,',key))
+                     (and ,',win ,',value))))
         ,@body))))
 
 ;;;--------------------------------------------------------------------------
@@ -196,7 +204,7 @@
 
 (export 'store-property)
 (defun store-property
-    (pset name value &key (type (property-type value)) location)
+    (pset name value &key type location)
   "Store a property in PSET."
   (pset-store pset
              (make-property name value :type type :location location)))
@@ -233,8 +241,7 @@
                     (p-location prop)))))))
 
 (export 'add-property)
-(defun add-property
-    (pset name value &key (type (property-type value)) location)
+(defun add-property (pset name value &key type location)
   "Add a property to PSET.
 
    If a property with the same NAME already exists, report an error."
@@ -257,7 +264,7 @@
    An attempt is made to guess property types from the Lisp types of the
    values.  This isn't always successful but it's not too bad.  The
    alternative is manufacturing a `property-value' object by hand and
-   stuffing into the set."
+   stuffing it into the set."
 
   (property-set plist))