Merge pull request #8 from s-expressionists/minor-api-additions

Define symbol-plist and map-all-packages

Code/Basic/basic.lisp

@@ -86,7 +86,11 @@
     :type cons)
    (symbol-macro-expander
     :accessor symbol-macro-expander
-    :type (or function null)))
+    :type (or function null))
+   (plist
+    :initform nil
+    :accessor plist
+    :type list))
   (:default-initargs :name (error "The initarg :NAME is required.")))
 
 ;;; Make sure NAME names a variable entry in ENVIRONMENT.
@@ -246,6 +250,17 @@
   ;; changing its STATUS. So we don't need the (or ... (variable-entry ...))
   (setf (symbol-macro-expander (ensure-variable-entry symbol environment)) new))
 
+(defmethod sys:symbol-plist (client (environment run-time-environment) symbol)
+  (declare (ignore client))
+  (let ((entry (variable-entry symbol environment)))
+    (if (null entry)
+        nil
+        (plist entry))))
+(defmethod (setf sys:symbol-plist)
+    (new client (environment run-time-environment) symbol)
+  (declare (ignore client))
+  (setf (plist (ensure-variable-entry symbol environment)) new))
+
 
 ;;; Types and classes.
 
@@ -291,6 +306,13 @@
       (remhash name (packages environment))
       (setf (gethash name (packages environment)) new-package)))
 
+(defmethod sys:map-all-packages
+    (client (environment run-time-environment) function)
+  (maphash (lambda (name package)
+             (declare (ignore name))
+             (funcall function package))
+           (packages environment)))
+
 
 ;;; Declarations.
 

Code/clostrum.lisp

@@ -29,13 +29,16 @@
 (defgeneric sys:variable-cell-boundp (client cell))
 (defgeneric sys:variable-cell-makunbound (client cell))
 
+(define-accessor sys:symbol-plist (client environment symbol))
+
 (defgeneric sys:type-cell (client environment type-name))
 (define-accessor sys:type-expander (client environment type-name))
 (define-accessor sys:type-cell-value (client cell))
 (defgeneric sys:type-cell-boundp (client cell))
 (defgeneric sys:type-cell-makunbound (client cell))
 
 (define-accessor sys:find-package (client environment name))
+(defgeneric sys:map-all-packages (client environment function))
 (define-accessor sys:proclamation (client environment name))
 
 ;;; Compilation environment.

Code/documentation.lisp

@@ -55,7 +55,11 @@ This is NIL if no expander has been set, or else the object set by (SETF VARIABL
     "Return true iff CELL has a value. The CELL is an object returned by VARIABLE-CELL.")
   (function sys:variable-cell-makunbound
     "Make CELL have no value. The CELL is an object returned by VARIABLE-CELL.
-The return values of this function are undefined."))
+The return values of this function are undefined.")
+  (function sys:symbol-plist
+    "Retrieve the plist attached to SYMBOL in ENVIRONMENT.")
+  (function (setf sys:symbol-plist)
+    "Set the plist attached to SYMBOL in ENVIRONMENT."))
 
 (documentation-utils:define-docs
   (function sys:type-cell
@@ -81,6 +85,8 @@ The return values of this function are undefined."))
     "Find the package bound to NAME in ENVIRONMENT, or NIL if none has been defined.")
   (function (setf sys:find-package)
     "Set the package bound to NAME in ENVIRONMENT.")
+  (function sys:map-all-packages
+    "Call FUNCTION on all PACKAGES in ENVIRONMENT, in some undefined order. This can be used for example to implement LIST-ALL-PACKAGES.")
   (function sys:proclamation
     "Find the proclamation associated with NAME in ENVIRONMENT. The nature of proclamations is client-defined.")
   (function (setf sys:proclamation)

Code/packages.lisp

@@ -1,7 +1,7 @@
 ;;; Low level API.
 (defpackage #:clostrum-sys
   (:use #:cl)
-  (:shadow #:compiler-macro-function #:find-package)
+  (:shadow #:compiler-macro-function #:find-package #:symbol-plist)
   (:export #:evaluation-environment)
   ;; Run-time environment accessors and readers
   ;; Operators
@@ -13,13 +13,14 @@
   ;; Variables
   (:export #:variable-status #:variable-cell #:variable-macro-expander
            #:variable-cell-value #:variable-cell-boundp
-           #:variable-cell-makunbound)
+           #:variable-cell-makunbound
+           #:symbol-plist)
   ;; Types and classes
   (:export #:type-cell #:type-expander #:type-cell-value #:type-cell-boundp
            #:type-cell-makunbound)
   ;; Packages
   (:shadow #:find-package)
-  (:export #:find-package)
+  (:export #:find-package #:map-all-packages)
   ;; Proclamations
   (:export #:proclamation)
   ;; Compilation environment accessors
@@ -30,10 +31,12 @@
   (:use #:cl)
   ;; for reexport
   (:shadowing-import-from #:clostrum-sys
-                          #:find-package #:compiler-macro-function)
+                          #:find-package #:compiler-macro-function
+                          #:symbol-plist)
   (:import-from #:clostrum-sys #:type-expander
                 #:function-description #:variable-description
-                #:type-description #:proclamation #:evaluation-environment)
+                #:type-description #:proclamation #:evaluation-environment
+                #:map-all-packages)
   ;; Protocol classes:
   (:export #:run-time-environment #:compilation-environment)
   ;; Protocol functions:
@@ -49,12 +52,13 @@
   (:export #:symbol-value #:boundp #:makunbound)
   (:export #:make-variable #:make-parameter #:make-constant
            #:make-symbol-macro)
+  (:export #:symbol-plist)
   ;; Types and classes
   (:shadow #:find-class)
   (:export #:find-class)
   (:export #:make-type #:type-expand-1 #:type-expand #:type-expander)
   ;; Packages
-  (:export #:find-package)
+  (:export #:find-package #:map-all-packages)
   ;; Proclamations
   (:export #:proclamation)
   ;; General