elisp property lists

* module/language/elisp/boot.el (%plist-member, %plist-get, %plist-put)
  (plist-get, plist-put, plist-member, lax-plist-get, lax-plist-put)
  (symbol-plist, setplist, get, put): New functions.
  (plist-function): New variable.

module/language/elisp/boot.el

@@ -261,3 +261,50 @@
 
 (defun mapcar (function sequence)
   (funcall (@ (guile) map) function sequence))
+
+;;; Property lists
+
+(defun %plist-member (plist property test)
+  (catch 'loop
+    (while plist
+      (if (funcall test (car plist) property)
+          (throw 'loop (cdr plist))
+        (setq plist (cddr plist))))))
+
+(defun %plist-get (plist property test)
+  (car (%plist-member plist property test)))
+
+(defun %plist-put (plist property value test)
+  (lexical-let ((x (%plist-member plist property test)))
+    (if x
+        (progn (setcar x value) plist)
+      (cons property (cons value plist)))))
+
+(defun plist-get (plist property)
+  (%plist-get plist property #'eq))
+
+(defun plist-put (plist property value)
+  (%plist-put plist property value #'eq))
+
+(defun plist-member (plist property)
+  (%plist-member plist property #'eq))
+
+(defun lax-plist-get (plist property)
+  (%plist-get plist property #'equal))
+
+(defun lax-plist-put (plist property value)
+  (%plist-put plist property value #'equal))
+
+(defvar plist-function (funcall (@ (guile) make-object-property)))
+
+(defun symbol-plist (symbol)
+  (funcall plist-function symbol))
+
+(defun setplist (symbol plist)
+  (funcall (funcall (@ (guile) setter) plist-function) symbol plist))
+
+(defun get (symbol propname)
+  (plist-get (symbol-plist symbol) propname))
+
+(defun put (symbol propname value)
+  (setplist symbol (plist-put (symbol-plist symbol) propname value)))