clean up

.gitignore

@@ -0,0 +1,2 @@
+*.*~
+*.*fasl

LICENSE

@@ -0,0 +1,24 @@
+This is free and unencumbered software released into the public domain.
+
+Anyone is free to copy, modify, publish, use, compile, sell, or
+distribute this software, either in source code form or as a compiled
+binary, for any purpose, commercial or non-commercial, and by any
+means.
+
+In jurisdictions that recognize copyright laws, the author or authors
+of this software dedicate any and all copyright interest in the
+software to the public domain. We make this dedication for the benefit
+of the public at large and to the detriment of our heirs and
+successors. We intend this dedication to be an overt act of
+relinquishment in perpetuity of all present and future rights to this
+software under copyright law.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+
+For more information, please refer to <https://unlicense.org>

package.lisp

@@ -2,28 +2,40 @@
 
 (cl:in-package :cl-user)
 
-(defpackage :srfi-43
+
+(defpackage "https://github.com/g000001/srfi-43"
   (:use)
-  (:export :make-vector :vector :vector-unfold :vector-unfold-right :vector-copy
-           :vector-reverse-copy :vector-append :vector-concatenate :vector?
-           :vector-empty? :vector= :vector-ref :vector-length :vector-fold
-           :vector-fold-right :vector-map :vector-map! :vector-for-each
-           :vector-count
-           :vector-index :vector-index-right :vector-skip :vector-skip-right
-           :vector-binary-search :vector-any :vector-every :vector-set!
-           :vector-swap!
-           :vector-fill! :vector-reverse! :vector-copy! :vector-reverse-copy!
-           :vector->list :reverse-vector->list :list->vector :reverse-list->vector
-           ))
-
-(defpackage :srfi-43.internal
-  (:use :srfi-43 :cl :mbe :fiveam :srfi-8)
-  (:shadowing-import-from :srfi-5 :let)
-  (:shadowing-import-from :srfi-23 :error)
-  (:shadow :lambda
-           :check-type
-           :loop
-           :vector)
-  (:shadow :test))
-
-;;; eof
+  (:export
+   make-vector vector vector-unfold vector-unfold-right vector-copy
+   vector-reverse-copy vector-append vector-concatenate vector?
+   vector-empty? vector= vector-ref vector-length vector-fold
+   vector-fold-right vector-map vector-map! vector-for-each
+   vector-count
+   vector-index vector-index-right vector-skip vector-skip-right
+   vector-binary-search vector-any vector-every vector-set!
+   vector-swap!
+   vector-fill! vector-reverse! vector-copy! vector-reverse-copy!
+   vector->list reverse-vector->list list->vector reverse-list->vector))
+
+
+(defpackage "https://github.com/g000001/srfi-43#internals"
+  (:use
+   "https://github.com/g000001/srfi-43"
+   "https://github.com/g000001/srfi-8"
+   cl 
+   mbe 
+   fiveam)
+  (:shadowing-import-from 
+   "https://github.com/g000001/srfi-5" let)
+  (:shadowing-import-from
+   "https://github.com/g000001/srfi-23" error)
+  (:shadow 
+   lambda
+   check-type
+   loop
+   vector)
+  (:shadow test))
+
+
+;;; *EOF*
+

srfi-43.asd

@@ -2,19 +2,43 @@
 
 (cl:in-package :asdf)
 
+
 (defsystem :srfi-43
+  :version "20200319"
+  :description "SRFI 43 for CL: Vector library"
+  :long-description "SRFI 43 for CL: Vector library
+https://srfi.schemers.org/srfi-43"
+  :author "Taylor Campbell"
+  :maintainer "CHIBA Masaomi"
   :serial t
   :depends-on (:fiveam :mbe :srfi-5 :srfi-23 :srfi-8)
   :components ((:file "package")
                (:file "util")
                (:file "srfi-43")
                (:file "test")))
 
+
+(defmethod perform :after ((o load-op) (c (eql (find-system :srfi-43))))
+  (let ((name "https://github.com/g000001/srfi-43")
+        (nickname :srfi-43))
+    (if (and (find-package nickname)
+             (not (eq (find-package nickname)
+                      (find-package name))))
+        (warn "~A: A package with name ~A already exists." name nickname)
+        (rename-package name name `(,nickname)))))
+
+
 (defmethod perform ((o test-op) (c (eql (find-system :srfi-43))))
-  (load-system :srfi-43)
-  (or (flet ((_ (pkg sym)
-               (intern (symbol-name sym) (find-package pkg))))
-         (let ((result (funcall (_ :fiveam :run) (_ :srfi-43.internal :srfi-43))))
-           (funcall (_ :fiveam :explain!) result)
-           (funcall (_ :fiveam :results-status) result)))
-      (error "test-op failed") ))
+  (let ((*package*
+         (find-package
+          "https://github.com/g000001/srfi-43#internals")))
+    (eval
+     (read-from-string
+      "
+      (or (let ((result (run 'srfi-43)))
+            (explain! result)
+            (results-status result))
+          (error \"test-op failed\") )"))))
+
+
+;;; *EOF*

srfi-43.lisp

@@ -1,6 +1,6 @@
 ;;;; srfi-43.lisp
 
-(cl:in-package :srfi-43.internal)
+(cl:in-package "https://github.com/g000001/srfi-43#internals")
 
 
 ;;;;;; SRFI 43: Vector library                           -*- Scheme -*-

test.lisp

@@ -1,12 +1,13 @@
-(cl:in-package :srfi-43.internal)
+(cl:in-package "https://github.com/g000001/srfi-43#internals")
 
-(def-suite srfi-43)
 
-(in-suite srfi-43)
+(def-suite* srfi-43)
+
 
 (defmacro λ (args &rest body)
   `(lambda ,args ,@body))
 
+
 (defmacro dotests (&body body)
   (do ((*gensym-counter* 0)
        (tests (reverse body)
@@ -120,6 +121,7 @@
   => t
   )
 
+
 (dotests
   ;; Selectors
   (vector-ref '#(a b c d) 2)
@@ -129,6 +131,7 @@
   =>  3
   )
 
+
 (dotests
   ;; Iteration
   (vector-fold-right (λ (index tail elt) index (cons elt tail))
@@ -172,6 +175,7 @@ zot
   =>  2
   )
 
+
 (dotests
   ;; Searching
   (vector-index #'evenp '#(3 1 4 1 5 9))
@@ -187,8 +191,11 @@ zot
   =>  2
   )
 
+
 #|(dotests
   ;; Mutators
   )|#
 
-;;; eof
+
+;;; *EOF*
+

util.lisp

@@ -1,6 +1,13 @@
-(cl:in-package :srfi-43.internal)
+(cl:in-package "https://github.com/g000001/srfi-43#internals")
 
-(progn
+
+(defmacro define.inline.function (name (&rest args) &body body)
+  `(progn
+     (declaim (inline ,name))
+     (defun ,name (,@args) ,@body)))
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (setf (fdefinition 'eq?) #'eq)
   (setf (fdefinition 'integer?) #'integerp)
   (setf (fdefinition 'list?) #'listp)
@@ -12,16 +19,17 @@
   (setf (fdefinition 'vector-ref) #'aref)
   (setf (fdefinition 'vector-length) #'length)
   (setf (fdefinition 'vector?) #'vectorp)
-  (setf (fdefinition 'procedure?) #'functionp)
-  )
+  (setf (fdefinition 'procedure?) #'functionp))
 
-(declaim (inline list-tail vector-set!))
-(defun list-tail (list k)
+
+(define.inline.function list-tail (list k)
   (nthcdr k list))
 
-(defun vector-set! (vec index val)
+
+(define.inline.function vector-set! (vec index val)
   (setf (aref vec index) val))
 
+
 (defun to-proper-lambda-list (list)
   (typecase list
     (list (if (tailp () list)
@@ -33,15 +41,11 @@
                     ,(cdr last)))))
     (symbol `(cl:&rest ,list))))
 
+
 (defmacro lambda (args &rest body)
   `(cl:lambda ,(to-proper-lambda-list args)
      ,@body))
 
-(defmacro define-function (name-args &body body)
-  (destructuring-bind (name . args)
-                      name-args
-    `(defun ,name ,(to-proper-lambda-list args)
-       ,@body)))
 
 (defmacro letrec ((&rest binds) &body body)
   `(let (,@(mapcar (cl:lambda (x)
@@ -65,6 +69,9 @@
                           name-args
         `(defun ,name ,(to-proper-lambda-list args)
            ,@body))
-      `(progn
+      `(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (fdefinition ',name-args)
                ,(car body)))))
+
+
+;;; *EOF*