cleanup

Author: phantomics

aplesque/aplesque.lisp

@@ -1736,20 +1736,8 @@
             ;; containing output array is small
             (symbol-macrolet ((output-element (row-major-aref output o)))
               (dotimes (i (size (row-major-aref output o)))
-                ;; (let ((iindex 0) (remaining o))
-                ;;   (loop :for ofactor :across output-factors :for ix :from 0
-                ;;         :do (multiple-value-bind (index remainder) (floor remaining ofactor)
-                ;;               (if (= ix axis)
-                ;;                   (incf iindex (* i (aref input-factors axis))))
-                ;;               (incf iindex (* index (aref input-factors (+ ix (if (< ix axis) 0 1)))))
-                ;;               (setq remaining remainder)))
-                ;;   (if (= axis (rank output)) (incf iindex i))
-                ;;   (setf (row-major-aref output-element i)
-                ;;         (row-major-aref input iindex)))
                 (setf (row-major-aref output-element i)
-                      (row-major-aref input (funcall indexer o i)))
-
-                )))
+                      (row-major-aref input (funcall indexer o i))))))
           output))))
 
 (defun ravel (count-from input &optional axes)

functions.lisp

@@ -431,7 +431,6 @@
 (defun assign-by-selection (function value omega &key index-origin)
   "Assign to elements of an array selected by a function. Used to implement (3↑x)←5 etc."
   (multiple-value-bind (base-object ivec) (invert-assigned-varray (funcall function omega))
-    ;; (print (list :bb (setf rri base-object) ivec))
     (typecase base-object
       (varray::vader-select
        (setf (varray::vasel-assign base-object) value)
@@ -608,8 +607,6 @@
            (omrank (aref rank 0))
            (fn-meta (funcall function :get-metadata nil))
            (operand-lex-ref (getf fn-meta :lexical-reference)))
-      ;; (princ (list :ar rank (shape-of omega) (shape-of alpha) (getf fn-meta :lexical-reference) omega))
-      ;; (princ #\Newline)
 
       (when (or (not (and (integerp ocrank) (or (zerop ocrank) (plusp ocrank))))
                 (not (and (integerp acrank) (or (zerop acrank) (plusp acrank))))

grammar.lisp

@@ -148,7 +148,6 @@
   "Process a function token."
   (let* ((current-path (or (getf (rest (getf (getf properties :special) :closure-meta)) :ns-point)
                            (symbol-value (intern "*NS-POINT*" space)))))
-    ;; (print (list :it this-item))
     (if (listp this-item)
         ;; process a function specification starting with :fn
         (if (eq :fn (first this-item))

libraries/dfns/array/array.apl

@@ -33,8 +33,8 @@ acc ← { ⊃⍺⍺{(⊂⍺ ⍺⍺⊃⍬⍴⍵),⍵}/1↓{⍵,⊂⍬⍴⍵}¯1
 
 ⍝ From http://dfns.dyalog.com/c_disp.htm
 
-disp ← { ⎕IO←0                               ⍝ Boxed sketch of nested array.
-  ⍺←⍬ ⋄ dec ctd←2↑⍺                          ⍝ 1:decorated, 1:centred.
+disp ← { ⎕IO←0 ⋄ ⍺←⍬                         ⍝ Boxed sketch of nested array.
+  dec ctd←2↑⍺                                ⍝ 1:decorated, 1:centred.
 
   box←{                                      ⍝ Recursive boxing of nested array.
     isor ⍵:⎕FMT⊂⍵                            ⍝ ⎕or: '∇name'.
@@ -146,7 +146,7 @@ display ← { ⎕IO←0                            ⍝ Boxed display of array.
     top←'─⊖→'[¯1↑⍺],hrz                      ⍝ upper border with axis
     bot←(⊃⍺),hrz                             ⍝ lower border with type
     rgt←'┐│',vrt,'┘'                         ⍝ right side with corners
-    lax←'│⌽↓'[¯1↓1↓⍺],¨⊂vrt    ⍝⍝              ⍝ left side(s) with axes,
+    lax←'│⌽↓'[¯1↓1↓⍺],¨⊂vrt                  ⍝ left side(s) with axes,
     lft←⍉'┌',(↑lax),'└'                      ⍝ ... and corners
     lft,(top⍪⍵⍪bot),rgt                      ⍝ fully boxed array
   }
@@ -159,7 +159,7 @@ display ← { ⎕IO←0                            ⍝ Boxed display of array.
   type←{{(1=⍴⍵)⊃'+'⍵}∪,char¨⍵}               ⍝ simple array type
   line←{(49=⎕DT 1⍴⍵)⊃' -'}                   ⍝ underline for atom
 
-  { ⎕IO←0                                         ⍝ recursive boxing of arrays:
+  { ⎕IO←0                                    ⍝ recursive boxing of arrays:
     0=≡⍵:' '⍪(open ⎕FMT ⍵)⍪line ⍵            ⍝ simple scalar
     1 ⍬≡(≡⍵)(⍴⍵):'∇' 0 0 box ⎕FMT ⍵          ⍝ object rep: ⎕OR
     1=≡⍵:(deco ⍵)box open ⎕FMT open ⍵        ⍝ simple array

libraries/dfns/graph/graph.apl

@@ -11,7 +11,6 @@ dsp pmat ← 'ARRAY-LIB-SPACE' ⎕XWF 'dsp' 'pmat'
 ⍝ From http://dfns.dyalog.com/c_assign.htm
 
 assign ← {                                   ⍝ Hungarian method cost assignment.
-
   step0←{step1(⌽⌈\⌽⍴⍵)↑⍵}                    ⍝ 0: at least as many rows as cols.
 
   step1←{step2↑(↓⍵)-⌊/⍵}                     ⍝ 1: reduce rows by minimum value.

libraries/dfns/numeric/demo.lisp

@@ -125,12 +125,12 @@
                " ⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕                                                                  "
                " ⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕                                                                  "
                " ⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕⎕                                                                  "))
-         ;; (is "{∧/⍵∧.=⍵∘.{+/⍺ nicediv ⍵}⍵}⍳50" 1) ;; TODO: why is this so slow when lazified?
+         (is "{∧/⍵∧.=⍵∘.{+/⍺ nicediv ⍵}⍵} ⍳50" 1)
          (is "osc¨⍳30" #(1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1))
          (is "0 5 10 15 range ¯2+⍳18" #(0 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 4 4))
          (is "¯1 0 1 range 1○⍳40"
              #(2 2 2 1 1 1 2 2 2 1 1 1 2 2 2 1 1 1 2 2 2 1 1 1 1 2 2 2 1 1 1 2 2 2 1 1 1 2 2 2))
-         (is "(5 7 to 20)range 2 3 4⍴1 to 24"
+         (is "(5 7 to 20) range 2 3 4⍴1 to 24"
              #3A(((0 0 0 0) (1 1 2 2) (3 3 4 4)) ((5 5 6 6) (7 7 8 8) (8 8 8 8))))
          (is "rational 0.75" #(3.0d0 4.0d0))
          (is "rational (+∘÷)/¨1<⍳¨⍳10" #2A((0 1 1 2 3 5 8 13 21 34) (1 1 2 3 5 8 13 21 34 55)))

libraries/dfns/numeric/numeric.apl

@@ -184,7 +184,6 @@ rational ← {                                 ⍝ Rational approximation to rea
 ⍝ From http://dfns.dyalog.com/c_roman.htm
 
 roman ← {                                    ⍝ Roman numeral arithmetic.
-
   num←{⎕IO←0 ⋄ {⍵+.××0.5+×⍵-1↓⍵,0}(,⍉1 5∘.×10*⍳4)[7|'IVXLCDMivxlcdm'⍳⍵]}
   fmt←{⎕IO←0 ⋄ ~∘' ',1 0 0⍉(' '⍪3 4⍴'MCXI DLV ')[(0 4 2 2⊤0 16 20 22 24 32 36 38 39 28)[;⍵⊤⍨4⍴10];]}
 
@@ -324,8 +323,7 @@ kcell ← {                                    ⍝ Relationship between point an
 
 ⍝ From http://dfns.dyalog.com/c_kball.htm
 
-kball ← {                                    ⍝ Relationship between point and k-ball.
-  ⍺←1
+kball ← { ⍺←1                                ⍝ Relationship between point and k-ball.
   r←⊃⍺ ⋄ p←1/⍵                               ⍝ Default is ball w/radius 1 at origin.
   c←(≢p)↑1↓⍺                                 ⍝ Remaining coordinates are center.
   ×↑-/(⍉p-[⎕IO]c)r+.*¨2                      ⍝ Perform signum difference.
@@ -429,7 +427,6 @@ roots ← {                                    ⍝ Roots of quadratic.
 ⍝ From http://dfns.dyalog.com/c_polar.htm
 
 polar ← {                                    ⍝ Polar from/to cartesian coordinates.
-
   pol_car←{                                  ⍝ polar from cartesian (default).
     radius←{(+⌿⍵*2)*0.5}                     ⍝ radius (pythagorus).
 
@@ -466,8 +463,7 @@ poly ← { 2 1∘.○(○2÷⍵)×(⍳⍵)-⍳1 }
 
 ⍝ From http://dfns.dyalog.com/c_xtimes.htm
 
-xtimes ← { ⎕IO←0                             ⍝ Fast multi-digit product using FFT.
-  m←0
+xtimes ← { ⎕IO←0 ⋄ m←0                       ⍝ Fast multi-digit product using FFT.
   xroots    ← {×\1,1↓(⍵÷2)⍴¯1*2÷⍵}
   cube      ← {⍵⍴⍨2⍴⍨⌊2⍟⍴⍵}
   extend    ← {(2*⌈2⍟¯1+(⍴⍺)+⍴⍵)↑¨⍺ ⍵}
@@ -476,6 +472,7 @@ xtimes ← { ⎕IO←0                             ⍝ Fast multi-digit product
   iFFT      ← {(⍴⍵)÷⍨,(cube+xroots⍴⍵)floop cube ⍵}
   rconvolve ← {(¯1+(⍴⍺)+⍴⍵)↑iFFT⊃×/FFT¨⍺ extend ⍵}
   carry     ← {1↓+⌿1 0⌽0,0 10⊤⍵}
+
   (+/∧\0=t)↓t←carry⍣≡0,⌊0.5+9○⍺ rconvolve ⍵
 }
 

novelties.lisp

@@ -83,10 +83,10 @@ This will invoke a progress bar with different demarcations (at each third rathe
 (defun april-print-progress-bar (count &key (increments (april "1 2 3÷4"))
                                          (width 64) (glyphs "⋄⌺∘○ ╷╓╖─┼╟╢"))
   "Print a progress bar that will grow toward completion as a process advances."
-  (let* ((total 0) (printed 0) (interval-index 0) (current-interval 0)
-         (breadth (* width count))
-         (marked-intervals (april-c (with (:state :in ((glyphs glyphs))))
-                                    "{
+  (let ((total 0) (printed 0) (interval-index 0) (current-interval 0)
+        (breadth (* width count))
+        (marked-intervals (april-c (with (:state :in ((glyphs glyphs))))
+                                   "{
   ⎕IO ← 0
   mrk ← 1+⍸ind ← ¯1⌽(⊢<1∘⌽)(⍵×int ← ⍺[⍋⍺])⍸⍳⍵-2
       ⍝ locations of marked intervals, with width minus 2 for enclosing chars
@@ -98,7 +98,7 @@ This will invoke a progress bar with different demarcations (at each third rathe
 
   mrk ⍝ return indices of marked increments
 }"
-                                    width increments)))
+                                   width increments)))
     ;; the returned advance function should be called upon each iteration of the process
     (lambda ()
       (when (< total breadth)

spec.lisp

@@ -953,8 +953,9 @@
      (meta (primary :axes axes :implicit-args (index-origin))
            (monadic :inverse #'identity)
            (dyadic :on-axis :last))
-     (tests (is "⊆ ⍳3" #0A#(1 2 3))
-            (is "⊆⊂⍳3" #0A#(1 2 3))
+     (tests (is " ⊆ ⍳3" #0A#(1 2 3))
+            (is " ⊆⊂⍳3" #0A#(1 2 3))
+            (is "⊃⊆⊂⍳3"    #(1 2 3))
             (is "⊆1 2 (1 2 3)" #(1 2 #(1 2 3)))
             (is "⊆ 'hello'" #0A"hello")
             (is "⊆⊂'hello'" #0A"hello")
@@ -2081,8 +2082,8 @@
   (for "Aliasing of [⌸ key] operator."
        "{k←⌸ ⋄ {⍴⍵}k ⍵} 'Apple' 'Orange' 'Apple' 'Pear' 'Orange' 'Peach'" #2A((2) (2) (1) (1)))
   (for "Aliasing of [. inner product] operator." "{ip←. ⋄ ⍵ +ip× 4 5 6} 1 2 3" 32)
-  (for "Aliasing of [∘ compose] operator." "{c←∘ ⋄ ⍴ c ⍴ ⍵} ⍳9" #*1)
-  (for "Aliasing of [⍛ reverse compose] operator." "{c←⍛ ⋄ ⍵ - c - ⍵} 1" -2)
+  (for "Aliasing of [∘ beside] operator." "{c←∘ ⋄ ⍴ c ⍴ ⍵} ⍳9" #*1)
+  (for "Aliasing of [⍛ before] operator." "{c←⍛ ⋄ ⍵ - c - ⍵} 1" -2)
   (for "Aliasing of [⍤ rank] operator." "{r←⍤ ⋄ ⍵+r 1⊢3 3⍴⍳9} ⍳3" #2A((2 4 6) (5 7 9) (8 10 12)))
   (for "Aliasing of [⍥ over] operator." "8 10 12 {o←⍥ ⋄ (⍺×⍵)÷o(+/)⍺} 16 32 64" 608/15)
   (for "Aliasing of [⍣ power] operator." "{p←⍣ ⋄ ⍳ p ¯1⊢⍵} ⍳9" 9)

utilities.lisp

@@ -393,8 +393,6 @@
 
 (defun reg-symfn-call (function space meta-form)
   "Add a reference to a call to a symbolic function to a closure metadata object."
-  ;; (print (list :ff function meta-form))
-  ;; (print :ff)
   (when (and meta-form function (listp function))
     (if (eql 'sub-lex (first function))
         (reg-symfn-call (second function) space meta-form)
@@ -1007,33 +1005,6 @@
       (setf (symbol-function 'parse-apl-number-string) #'nparser)
       #'nparser)))
 
-;; (defun parse-apl-number-string (number-string &optional component-of)
-;;   "Parse an APL numeric string into a Lisp value, handling high minus signs, J-notation for complex numbers and R-notation for rational numbers."
-;;   (ignore-errors ;; if number parsing fails, just return nil
-;;     (let ((nstring (string-upcase (regex-replace-all "[_]" number-string ""))))
-;;       (if (and (not (eql 'complex component-of))
-;;                (position #\J nstring :test #'char=))
-;;           (let ((halves (cl-ppcre:split #\J nstring)))
-;;             (when (and (= 2 (length halves))
-;;                        (< 0 (length (first halves)))
-;;                        (< 0 (length (second halves))))
-;;               (complex (parse-apl-number-string (first halves) 'complex)
-;;                        (parse-apl-number-string (second halves) 'complex))))
-;;           (if (position #\E nstring :test #'char=)
-;;               (let ((exp-float (parse-number:parse-number (regex-replace-all "[¯]" nstring "-")
-;;                                                           :float-format 'double-float)))
-;;                 (if (< double-float-epsilon (nth-value 1 (floor exp-float)))
-;;                     exp-float (let ((halves (mapcar #'parse-apl-number-string (cl-ppcre:split #\E nstring))))
-;;                                 (floor (* (first halves) (expt 10 (second halves)))))))
-;;               (if (and (not (eql 'rational component-of))
-;;                        (position #\R nstring :test #'char=))
-;;                   (let ((halves (cl-ppcre:split #\R nstring)))
-;;                     (/ (parse-apl-number-string (first halves) 'rational)
-;;                        (parse-apl-number-string (second halves) 'rational)))
-;;                   ;; the macron character is converted to the minus sign
-;;                   (parse-number:parse-number (regex-replace-all "[¯]" nstring "-")
-;;                                              :float-format 'double-float)))))))
-
 (defun print-apl-number-string (number &optional segments precision decimals realpart-multisegment)
   "Format a number as appropriate for APL, using high minus signs and J-notation for complex numbers, optionally at a given precision and post-decimal length for floats."
   (cond ((complexp number)
@@ -1198,15 +1169,14 @@
                                           :functions-scalar-monadic))))
          (arguments (loop :for arg :in arguments :collect (if (or (not (symbolp arg)))
                                                               arg `(vrender ,arg :may-be-deferred t)))))
-    ;; (print (list :aa arguments))
     (or (when (and (listp function)
                    (eql 'function (first function))
                    (eql 'change-namespace (second function)))
           `(identity t))
         (progn (when (and (listp function) (eql 'nspath (first function)))
                  (let* ((ns-sym (intern "*NS-POINT*" (package-name (symbol-package (second function)))))
                         (namespace (if (boundp ns-sym) (symbol-value ns-sym))))
-                   (when namespace (setq function
+                   (when namespace (setf function
                                          (cons 'nspath (append (if (listp namespace) namespace
                                                                    (list namespace))
                                                                (list (intern (string (second function))
@@ -1216,17 +1186,6 @@
                   (apply ,@(when is-scalar (list '#'apply-scalar))
                          ,function ,arg-list))))))
 
-#|
-This is a minimalistic implementation of (a-call) that doesn't perform any function composition.
-It remains here as a standard against which to compare methods for composing APL functions.
-
-(defmacro a-call (function &rest arguments)
-  `(,(if (and (listp function)
-              (eql 'scalar-function (first function)))
-         'apply-scalar 'funcall)
-    ,function  ,@arguments))
-|#
-
 (defmacro ac-wrap (type form)
   "Wrap a function form in a function that calls it via (a-call). Used for specification of inverse scalar functions."
   (list (if (eq :m type) 'λω 'λωα)
@@ -1342,9 +1301,6 @@ It remains here as a standard against which to compare methods for composing APL
                                  (= 1 (size-of ,condition)))
                              (disclose-atom (vrender ,condition))
                              (error "Predicates within an [$ if] statement must be unitary or scalar."))))
-                  ;; (if (not (is-unitary ,condition))
-                  ;;     (error "Predicates within an [$ if] statement must be unitary or scalar.")
-                  ;; (print (list :co ,condition ,output))
                   (if (zerop ,output)
                       ,(if (third clauses)
                            (if (fourth clauses)
@@ -2030,7 +1986,6 @@ It remains here as a standard against which to compare methods for composing APL
            this-form))
         ((guard symbol (member symbol '(⍺ ⍵ ⍶ ⍹ ⍺⍺ ⍵⍵)))
          ;; handle argument symbols, adding them to the closure-meta list
-         ;; (print (list :sy symbol closure-meta))
          (unless closure-meta
            ;; create the meta form if not present, needed for cases like 2{⍶⋄⍹}3⊢10
            (setf closure-meta (list :arg-syms nil)))
@@ -2116,17 +2071,6 @@ It remains here as a standard against which to compare methods for composing APL
                                                          :inverse-right :inverse))
                                             ,arg1 ,(funcall to-wrap form))))))))))))))
 
-;; (defmacro plain-ref (function &optional axes)
-;;   "Wrap a lexical function; this is needed to implement some meta-functionality."
-;;   ;; TODO: can the functionality here and in amb-ref be factored out and merged?
-;;   (let ((this-fn (gensym)) (args (gensym)) (iargs (gensym)))
-;;     `(labels ((,this-fn (&rest ,args)
-;;                 ,@(when axes `((when (eq :assign-axes (first ,args))
-;;                                  (setq ,axes (second ,args)
-;;                                        ,args (cddr ,args)))))
-;;                 (apply ,function ,args)))
-;;        #',this-fn)))
-
 (defmacro plain-ref (function &optional axes)
   "Wrap a lexical function; this is needed to implement some meta-functionality."
   ;; TODO: can the functionality here and in amb-ref be factored out and merged?
@@ -2284,7 +2228,6 @@ It remains here as a standard against which to compare methods for composing APL
                                               (push `(symbol-function ',aliased) assignment-forms)
                                               (case spec-type (functions (incf afn-count))
                                                     (operators (incf aop-count)))
-                                              ;; (print (list :ach achar lexicons))
                                               ;; assign the alias to lexicons according to the lexicon
                                               ;; membership (as specified in this form or already
                                               ;; present in the current lexicon) of the character