Merge pull request #17 from gendl/from-upstream

Add Clasp support
skypher · Jan 24, 2023 · adb52a1 · adb52a1
2 parents 8fbdb07 + 86b5cb5
commit adb52a1
Show file tree

Hide file tree

Showing 4 changed files with 25 additions and 8 deletions.
diff --git a/cl-store.asd b/cl-store.asd
@@ -9,18 +9,18 @@
 
 (in-package #:cl-store.system)
 
-#-(or lispworks mcl cmu clisp sbcl allegro ecl openmcl abcl)
+#-(or lispworks mcl cmu clisp sbcl allegro ecl openmcl abcl clasp)
 (error "This is an unsupported lisp implementation.
 Currently only MCL, OpenMCL, Lispworks, CMUCL, SBCL,
-CLISP, ECL and AllegroCL are supported.")
+CLISP, ECL, AllegroCL and CLASP are supported.")
 
 (defclass non-required-file (cl-source-file) ()
   (:documentation
    "File containing implementation dependent code which may or may not be there."))
 
 (defun lisp-system-shortname ()
   #+mcl :mcl #+lispworks :lispworks #+cmu :cmucl #+clisp :clisp #+sbcl :sbcl
-  #+allegro :acl #+ecl :ecl #+openmcl :openmcl #+abcl :abcl)
+  #+allegro :acl #+ecl :ecl #+openmcl :openmcl #+abcl :abcl #+clasp :clasp)
 
 (defmethod component-pathname ((component non-required-file))
   (let ((pathname (call-next-method))

diff --git a/package.lisp b/package.lisp
@@ -67,6 +67,23 @@
                       #:class-slots
                       #:ensure-class)
 
+  #+clasp (:import-from #:clos
+                        #:generic-function-name
+                        #:slot-definition-allocation
+                        #:slot-definition
+                        #:compute-slots
+                        #:slot-definition-initform
+                        #:slot-definition-initargs
+                        #:slot-definition-name
+                        #:slot-definition-readers
+                        #:slot-definition-type
+                        #:slot-definition-writers
+                        #:class-direct-default-initargs
+                        #:class-direct-slots
+                        #:class-direct-superclasses
+                        #:class-slots
+                        #:ensure-class)
+
   #+cmu  (:import-from #:pcl
                        #:generic-function-name
                        #:slot-definition-allocation

diff --git a/tests.lisp b/tests.lisp
@@ -535,7 +535,7 @@ bar")
                               (foo1-a (foo1-a (foo1-a ret)))))))
   t)
 
-#-abcl
+#-(or abcl clasp)
 (deftest circ.14 (let ((list '#1=(1 2 3 #1# . #1#)))
                    (store list *test-file*)
                    (let ((ret (restore *test-file*)))
@@ -546,7 +546,7 @@ bar")
 
 
 
-#-abcl
+#-(or abcl clasp)
 (deftest circ.15 (let ((list '#1=(1 2 3 #2=(#2#) . #1#)))
                    (store list *test-file*)
                    (let ((ret (restore *test-file*)))
@@ -560,7 +560,7 @@ bar")
 ;; this had me confused for a while since what was
 ;; restored #1=(1 (#1#) #1#) looks nothing like this list,
 ;; but it turns out that it is correct
-#-abcl
+#-(or abcl clasp)
 (deftest circ.16  (let ((list '#1=(1 #2=(#1#) . #2#)))
                     (store list *test-file*)
                     (let ((ret (restore *test-file*)))

diff --git a/utils.lisp b/utils.lisp
@@ -52,8 +52,8 @@
   (:documentation 
    "Return a list of slot details which can be used 
     as an argument to ensure-class")
-  (:method ((slot-definition #+(or ecl abcl (and clisp (not mop))) t 
-                             #-(or ecl abcl (and clisp (not mop))) slot-definition))
+  (:method ((slot-definition #+(or ecl clasp abcl (and clisp (not mop))) t 
+                             #-(or ecl clasp abcl (and clisp (not mop))) slot-definition))
    (list :name (slot-definition-name slot-definition)
          :allocation (slot-definition-allocation slot-definition)
          :initargs (slot-definition-initargs slot-definition)