From d448780ebac179cab9e330057357faa93e3053e9 Mon Sep 17 00:00:00 2001
Message-Id: <d448780ebac179cab9e330057357faa93e3053e9.1718283869.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Fri, 6 Jul 2018 23:23:45 +0100
Subject: [PATCH] src/pset-impl.lisp: Introduce a property type for booleans.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

---
 doc/SYMBOLS        |  3 +++
 src/pset-impl.lisp | 22 ++++++++++++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 44d2040..54a38ff 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -878,12 +878,15 @@ codegen-push
 codegen-target
   method-codegen
 coerce-property-value
+  cl:integer (eql :int) (eql :boolean)
+  cl:string (eql :id) (eql :boolean)
   cl:string (eql :id) (eql :keyword)
   cl:string (eql :id) (eql :symbol)
   cl:string (eql :id) (eql :type)
   cl:string (eql :string) (eql :id)
   cl:string (eql :string) (eql :keyword)
   cl:string (eql :string) (eql :symbol)
+  cl:symbol (eql :symbol) (eql :boolean)
   cl:symbol (eql :symbol) (eql :id)
   cl:symbol (eql :symbol) (eql :keyword)
   t t (eql cl:t)
diff --git a/src/pset-impl.lisp b/src/pset-impl.lisp
index 60674ff..e6986a5 100644
--- a/src/pset-impl.lisp
+++ b/src/pset-impl.lisp
@@ -74,6 +74,14 @@ (defun string-to-symbol
 		 (error "Symbol `~A' not external in package `~A'"
 			name (package-name package)))))))))
 
+(let ((truish '("true" "t" "yes" "verily"))
+      (falsish '("false" "nil" "no" "nowise")))
+  (defun truishp (string)
+    "Convert STRING to a boolean."
+    (cond ((member string truish :test #'string=) t)
+	  ((member string falsish :test #'string=) nil)
+	  (t (error "Unrecognized boolean value `~A'" string)))))
+
 ;;;--------------------------------------------------------------------------
 ;;; Property representation.
 
@@ -114,6 +122,20 @@ (defmethod coerce-property-value
     ((value symbol) (type (eql :symbol)) (wanted (eql :id)))
   (frob-identifier (symbol-name value)))
 
+;;; Boolean.
+
+(defmethod coerce-property-value
+    ((value symbol) (type (eql :symbol)) (wanted (eql :boolean)))
+  value)
+
+(defmethod coerce-property-value
+    ((value string) (type (eql :id)) (wanted (eql :boolean)))
+  (truishp value))
+
+(defmethod coerce-property-value
+    ((value integer) (type (eql :int)) (wanted (eql :boolean)))
+  (not (zerop value)))
+
 ;;; Types.
 
 (defmethod coerce-property-value
-- 
[mdw]