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>

README.org → README.md

@@ -1,4 +1,5 @@
-* SRFI 58: Array Notation
+# SRFI 58 for CL: Array Notation
+
 - Copyright (C) Aubrey Jaffer (2004, 2005). All Rights Reserved.
 
 Permission is hereby granted, free of charge, to any person obtaining

package.lisp

@@ -1,11 +1,19 @@
 ;;;; package.lisp
 
-(cl:in-package :cl-user)
+(cl:in-package cl-user)
 
-(defpackage :srfi-58
-  (:use)
-  (:export))
 
-(defpackage :srfi-58.internal
-  (:use :srfi-58 :cl :named-readtables :fiveam))
+(defpackage "https://github.com/g000001/srfi-58"
+  (:use
+   cl
+   named-readtables
+   fiveam
+   "https://github.com/g000001/srfi-63")
+  (:shadowing-import-from
+   "https://github.com/g000001/srfi-63"
+   array-rank
+   array-dimensions
+   make-array ))
 
+
+;;; *EOF*

readtable.lisp

@@ -1,9 +1,15 @@
 ;;;; readtable.lisp
 
-(cl:in-package :srfi-58.internal)
+(cl:in-package "https://github.com/g000001/srfi-58")
+
+
 (in-readtable :common-lisp)
 
+
 (defreadtable :srfi-58
   (:merge :standard)
   (:dispatch-macro-char #\# #\a #'sharp-a)
   (:case :upcase))
+
+
+;;; *EOF*

srfi-58.asd

@@ -2,7 +2,14 @@
 
 (cl:in-package :asdf)
 
+
 (defsystem :srfi-58
+  :version "20200314"
+  :description ""
+  :long-description "
+https://srfi.schemers.org/srfi-58"
+  :author "Aubrey Jaffer"
+  :maintainer "CHIBA Masaomi"
   :serial t
   :depends-on (:fiveam
                :srfi-63
@@ -12,11 +19,28 @@
                (:file "readtable")
                (:file "test")))
 
+
+(defmethod perform :after ((o load-op) (c (eql (find-system :srfi-58))))
+  (let ((name "https://github.com/g000001/srfi-58")
+        (nickname :srfi-58))
+    (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-58))))
-  (load-system :srfi-58)
-  (or (flet ((_ (pkg sym)
-               (intern (symbol-name sym) (find-package pkg))))
-         (let ((result (funcall (_ :fiveam :run) (_ :srfi-58.internal :srfi-58))))
-           (funcall (_ :fiveam :explain!) result)
-           (funcall (_ :fiveam :results-status) result)))
-      (error "test-op failed") ))
+  (let ((*package*
+         (find-package
+          "https://github.com/g000001/srfi-58")))
+    (eval
+     (read-from-string
+      "
+      (or (let ((result (run 'srfi-58)))
+            (explain! result)
+            (results-status result))
+          (error \"test-op failed\") )"))))
+
+
+;;; *EOF*

srfi-58.lisp

@@ -1,15 +1,17 @@
 ;;;; srfi-58.lisp
 
-(cl:in-package :srfi-58.internal)
+(cl:in-package "https://github.com/g000001/srfi-58")
+
 
 (defvar *eof* (list nil))
 
+
 (defun eof-object? (c)
   (eq *eof* c))
 
 
 ;;; Read integer up to first non-digit
-(defun read..try-number (port &rest  ic)
+(defun read$try-number (port &rest  ic)
   (let ((chr0 (char-code #\0)))
     (labels ((iter (arg)
                (let ((c (peek-char nil port nil *eof* T)))
@@ -20,11 +22,13 @@
                        (:else arg)))))
       (iter (and (not (null ic)) (- (char-code (car ic)) chr0))))))
 
+
 (defun bomb (pc wid)
   (error (format nil
                  "~@{~A~^ ~}"
                  'array 'syntax? "#" 'rank "A" pc wid)))
 
+
 (defun read-array-type (port)
   (case (char-downcase (peek-char nil port nil *eof* T))
     ((#\:) (read-char port)
@@ -36,33 +40,33 @@
                                  (and (not (eof-object? c))
                                       (iter (cons (char-upcase c) arg)))))))
                   (iter 'nil)))
-            (wid (and typ (not (eq 'bool typ)) (read..try-number port))))
+            (wid (and typ (not (eq 'bool typ)) (read$try-number port))))
        (flet ((check-suffix (chrs)
                 ;; (print (list :chrs chrs))
                 (let ((chr (read-char port)))
                   (if (and (characterp chr)
                            (not (member (char-downcase chr) chrs)))
                       (error "array-type?: ~A ~A ~A" typ wid chr)))))
          (let ((prot (assoc typ `((floC
-                                   (128 . ,#'a:floc128b)
-                                   (64  . ,#'a:floc64b)
-                                   (32  . ,#'a:floc32b)
-                                   (16  . ,#'a:floc16b))
+                                   (128 . ,#'a$floc128b)
+                                   (64  . ,#'a$floc64b)
+                                   (32  . ,#'a$floc32b)
+                                   (16  . ,#'a$floc16b))
                                   (floR
-                                   (128 . ,#'a:flor128b)
-                                   (64  . ,#'a:flor64b)
-                                   (32  . ,#'a:flor32b)
-                                   (16  . ,#'a:flor16b))
+                                   (128 . ,#'a$flor128b)
+                                   (64  . ,#'a$flor64b)
+                                   (32  . ,#'a$flor32b)
+                                   (16  . ,#'a$flor16b))
                                   (fixZ
-                                   (64 . ,#'a:fixz64b)
-                                   (32 . ,#'a:fixz32b)
-                                   (16 . ,#'a:fixz16b)
-                                   (8  . ,#'a:fixz8b))
+                                   (64 . ,#'a$fixz64b)
+                                   (32 . ,#'a$fixz32b)
+                                   (16 . ,#'a$fixz16b)
+                                   (8  . ,#'a$fixz8b))
                                   (fixN
-                                   (64 . ,#'a:fixn64b)
-                                   (32 . ,#'a:fixn32b)
-                                   (16 . ,#'a:fixn16b)
-                                   (8  . ,#'a:fixn8b))
+                                   (64 . ,#'a$fixn64b)
+                                   (32 . ,#'a$fixn32b)
+                                   (16 . ,#'a$fixn16b)
+                                   (8  . ,#'a$fixn8b))
                                   (char . #'vector)
                                   (bool . #'vector))
                             :test #'equal)))
@@ -79,17 +83,19 @@
        prot))))
     (otherwise NIL)))
 
+
 #|(defun list->uniform-array (&rest args)
   args)|#
 
-;;; We come into read..array with number or #f for RANK.
-#|(defun read..array (rank dims port reader)
+
+;;; We come into read$array with number or #f for RANK.
+#|(defun read$array (rank dims port reader)
   (let ((rank (or rank
                   (and (char-equal reader #\a)
                        1))))
     (labels ((iter (dims)
                    (declare (optimize (debug 0) (space 3)))
-                   (let ((dim (read..try-number port)))
+                   (let ((dim (read$try-number port)))
                      (if dim
                          (iter (cons dim dims))
                          (case (peek-char nil port)
@@ -101,11 +107,12 @@
                             (list->uniform-array rank dims nil (read port) )))))))
       (iter dims) )))|#
 
-(defun read..array (rank dims port reader)
+
+(defun read$array (rank dims port reader)
   (declare (ignore reader))
   (labels ((iter (dims)
                  (declare (optimize (debug 0) (space 3)))
-                 (let ((dim (read..try-number port)))
+                 (let ((dim (read$try-number port)))
                    (if dim
                        (iter (cons dim dims))
                        (case (peek-char nil port)
@@ -123,29 +130,33 @@
                                                (read port) ) ))))))
     (iter dims) ))
 
+
 (defun list->uniform-array (rank dims type list)
   (let ((rank (or rank (let ((dim (length dims)))
                          (if (zerop dim) 1 dim) ) )))
     (srfi-63:list->array rank (funcall type) list) ))
 
-(defun read..sharp (c port read)
+
+(defun read$sharp (c port read)
   (let ((rank read))
   (case c
-    ((#\a #\A) (read..array rank '() port c))
+    ((#\a #\A) (read$array rank '() port c))
     ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-     (let* ((num (read..try-number port c))
+     (let* ((num (read$try-number port c))
             (chr (peek-char nil port)))
        (case chr
          ((#\a #\A) (read-char port)
-          (read..array num '() port c))
+          (read$array num '() port c))
          ((#\*) (read-char nil port)
-          (read..array rank (list num) port c))
+          (read$array rank (list num) port c))
          (:else
-          (read..array 1 (list num) port c)))))
+          (read$array 1 (list num) port c)))))
     (otherwise
      (error "unknown # object ~A" c)))))
 
+
 (defun sharp-a (stream char arg)
-  (read..sharp char stream arg))
+  (read$sharp char stream arg))
+
 
-;;; eof
+;;; *EOF*

test.lisp

@@ -1,9 +1,11 @@
-(cl:in-package :srfi-58.internal)
+(cl:in-package "https://github.com/g000001/srfi-58")
+
+
 (in-readtable :srfi-58)
 
-(def-suite srfi-58)
 
-(in-suite srfi-58)
+(def-suite* srfi-58)
+
 
 #||
   array-prefix :: rank `A' [ dimensions ] [ `:' type-specifier ] |
@@ -26,16 +28,19 @@
   decwidth :: `32' | `64' | `128'
 ||#
 
+
 (defun read-from-string/sharp-a (str)
   (let ((*readtable* (copy-readtable nil)))
      (set-dispatch-macro-character #\# #\A #'sharp-a)
      (read-from-string str)))
 
-(test read..try-number
+
+(test read$try-number
   (is (= 888 (with-input-from-string (in "888a")
-               (read..try-number in))))
+               (read$try-number in))))
   (is (= 0 (with-input-from-string (in "0a")
-             (read..try-number in)))))
+             (read$try-number in)))))
+
 
 (test 2*3
   (let ((a #2A:fixN16b((0 1 2) (3 5 4))))
@@ -50,14 +55,22 @@
     (is (= 2 (srfi-63:array-rank a)))
     (is (equal '(2 3) (srfi-63:array-dimensions a)))))
 
-#|(read-from-string/sharp-a "#2A:fixN16b((0 1 2) (3 5 4))")|#
+
+#|(read$rom-string/sharp-a "#2A:fixN16b((0 1 2) (3 5 4))")|#
+
+
 ;=>  (:RANK 2 :DIMS NIL :TYPE 16 ((0 1 2) (3 5 4)))
 ;    28
 
-#|(read-from-string/sharp-a "#2A2*3:fixN16b((0 1 2) (3 5 4))")|#
+#|(read$rom-string/sharp-a "#2A2*3:fixN16b((0 1 2) (3 5 4))")|#
+
+
 ;=>  (:RANK 2 :DIMS (3 2) :TYPE 16 ((0 1 2) (3 5 4)))
 ;    31
 
-#|(read-from-string/sharp-a "#A2*3:fixN16b((0 1 2) (3 5 4))")|#
+#|(read$rom-string/sharp-a "#A2*3:fixN16b((0 1 2) (3 5 4))")|#
+
+
+;;; *EOF*
 ;=>  (:RANK NIL :DIMS (3 2) :TYPE 16 ((0 1 2) (3 5 4)))
 ;    30