From 0809e4a4fa84733cb8f97a8a856a2e43edeafc18 Mon Sep 17 00:00:00 2001
From: Guillaume Le Vaillant <glv@posteo.net>
Date: Tue, 1 Dec 2020 10:13:19 +0100
Subject: [PATCH] gnu: Add clml.

* gnu/packages/lisp-xyz.scm (cl-clml, sbcl-clml): New variables.
* gnu/packages/patches/sbcl-clml-fix-types.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
---
 gnu/local.mk                                  |   1 +
 gnu/packages/lisp-xyz.scm                     |  40 +++
 .../patches/sbcl-clml-fix-types.patch         | 280 ++++++++++++++++++
 3 files changed, 321 insertions(+)
 create mode 100644 gnu/packages/patches/sbcl-clml-fix-types.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index 7777891896..c14e2aa56d 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1591,6 +1591,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/rust-reproducible-builds.patch		 \
   %D%/packages/patches/rust-openssl-sys-no-vendor.patch	\
   %D%/packages/patches/rxvt-unicode-escape-sequences.patch	\
+  %D%/packages/patches/sbcl-clml-fix-types.patch		\
   %D%/packages/patches/sbcl-geco-fix-organism-class.patch	\
   %D%/packages/patches/scalapack-blacs-mpi-deprecations.patch	\
   %D%/packages/patches/scheme48-tests.patch			\
diff --git a/gnu/packages/lisp-xyz.scm b/gnu/packages/lisp-xyz.scm
index dd47659b35..d49d460db1 100644
--- a/gnu/packages/lisp-xyz.scm
+++ b/gnu/packages/lisp-xyz.scm
@@ -11699,3 +11699,43 @@ (define-public cl-array-operations
 
 (define-public ecl-array-operations
   (sbcl-package->ecl-package sbcl-array-operations))
+
+(define-public sbcl-clml
+  (let ((commit "95505b54c8c7b4b27f500c3be97fa5732f4b51a8")
+        (revision "0"))
+    (package
+      (name "sbcl-clml")
+      (version (git-version "0.0.0" revision commit))
+      (source
+       (origin
+         (method git-fetch)
+         (uri (git-reference
+               (url "https://github.com/mmaul/clml")
+               (commit commit)))
+         (file-name (git-file-name "clml" version))
+         (sha256
+          (base32 "006pii59nmpc61n7p7h8ha5vjg6x0dya327i58z0rnvxs249h345"))
+         ;; TODO: Remove this when the patch has been merged upstream.
+         (patches (search-patches "sbcl-clml-fix-types.patch"))))
+      (build-system asdf-build-system/sbcl)
+      (inputs
+       `(("alexandia" ,sbcl-alexandria)
+         ("array-operations" ,sbcl-array-operations)
+         ("cl-fad" ,sbcl-cl-fad)
+         ("cl-ppcre" ,sbcl-cl-ppcre)
+         ("drakma" ,sbcl-drakma)
+         ("introspect-environment" ,sbcl-introspect-environment)
+         ("iterate" ,sbcl-iterate)
+         ("lparallel" ,sbcl-lparallel)
+         ("parse-number" ,sbcl-parse-number)
+         ("split-sequence" ,sbcl-split-sequence)
+         ("trivial-garbage" ,sbcl-trivial-garbage)))
+      (synopsis "Common Lisp machine learning library")
+      (description
+       "CLML (Common Lisp Machine Learning) is a high performance and large
+scale statistical machine learning package")
+      (home-page "https://mmaul.github.io/clml/")
+      (license license:llgpl))))
+
+(define-public cl-clml
+  (sbcl-package->cl-source-package sbcl-clml))
diff --git a/gnu/packages/patches/sbcl-clml-fix-types.patch b/gnu/packages/patches/sbcl-clml-fix-types.patch
new file mode 100644
index 0000000000..689a2fbfc2
--- /dev/null
+++ b/gnu/packages/patches/sbcl-clml-fix-types.patch
@@ -0,0 +1,280 @@
+commit 9920bf86604b536c735b6478488a3cb89413e000
+Author: Guillaume Le Vaillant <glv@posteo.net>
+Date:   Tue Dec 1 09:38:41 2020 +0100
+
+    Fix some type declarations
+    
+    This allows compiling with SBCL 2.0.11 which is less tolerant with wrong type
+    declarations.
+
+diff --git a/som/src/lvq_pak.lisp b/som/src/lvq_pak.lisp
+index 1a062cc..4006ed6 100644
+--- a/som/src/lvq_pak.lisp
++++ b/som/src/lvq_pak.lisp
+@@ -53,7 +53,7 @@
+      (current :accessor entries-current :initarg :current :initform 0
+               :documentation "index of current data-entry inside data-entries")
+      (entries :accessor entries-entries :initarg :entries :initform nil
+-              :type #-ccl cons #+ccl list
++              :type #-ccl (or null cons) #+ccl list
+               :documentation "list of data-entries")
+      (num-loaded :accessor entries-num-loaded :initarg :num-loaded :initform nil
+                  :documentation "number of lines loaded in entries list")
+diff --git a/statistics/src/rand/rand.lisp b/statistics/src/rand/rand.lisp
+index 3cd806a..c8f9952 100644
+--- a/statistics/src/rand/rand.lisp
++++ b/statistics/src/rand/rand.lisp
+@@ -154,7 +154,7 @@
+        (xn (make-array (1+ n) :element-type 'double-float)))
+   (declare (type double-float r v d)
+            (type fixnum k n n-minus-1)
+-           (type (vector double-float *) xn))
++           (type (simple-array double-float (*)) xn))
+   ;; build xn
+   (setf (aref xn n) (* v (exp (/ (* r r) 2))))
+   (setf (aref xn (1- n)) r)
+@@ -233,8 +233,8 @@
+          (base (expt 2 (- +bit-operation-m+ k 1))))
+     (declare (type double-float r v d)
+              (type fixnum k n n-minus-1 base)
+-             (type (vector double-float *) wn fn)
+-             (type (vector fixnum *) kn))
++             (type (simple-array double-float (*)) wn fn)
++             (type (simple-array fixnum (*)) kn))
+     ;; build arrays
+     (setf (aref wn (- n 1)) (/ (* v (exp (/ (* r r) 2))) base))
+     (setf (aref wn (- n 2)) (/ r base))
+@@ -347,8 +347,8 @@
+          (base (expt 2 (- +bit-operation-m+ k))))
+     (declare (type double-float r v d)
+              (type fixnum k n n-minus-1 base)
+-             (type (vector double-float *) wn fn)
+-             (type (vector fixnum *) kn))
++             (type (simple-array double-float (*)) wn fn)
++             (type (simple-array fixnum (*)) kn))
+     ;; build arrays
+     (setf (aref wn (- n 1)) (/ (* v (exp (/ (* r r) 2))) base))
+     (setf (aref wn (- n 2)) (/ r base))
+@@ -546,8 +546,8 @@
+          (base (expt 2 (- +bit-operation-m+ k 1))))
+     (declare (type double-float r v tr1 tr2)
+              (type fixnum k n n-minus-1 base)
+-             (type (vector double-float *) wn fn)
+-             (type (vector fixnum *) kn))
++             (type (simple-array double-float (*)) wn fn)
++             (type (simple-array fixnum (*)) kn))
+     ;; build arrays
+     (setf (aref wn (- n 1)) (/ (* v (+ 1 (* r r))) base))
+     (setf (aref wn (- n 2)) (/ r base))
+@@ -663,8 +663,8 @@
+        (base (expt 2 (- +bit-operation-m+ k))))
+   (declare (type double-float r v)
+            (type fixnum k n n-minus-1 base)
+-           (type (vector double-float *) wn fn)
+-           (type (vector fixnum *) kn))
++           (type (simple-array double-float (*)) wn fn)
++           (type (simple-array fixnum (*)) kn))
+   ;; build arrays
+   (setf (aref wn (- n 1)) (/ (* v (exp r)) base))
+   (setf (aref wn (- n 2)) (/ r base))
+@@ -804,8 +804,8 @@
+          (base (expt 2 (- +bit-operation-m+ k 1))))
+     (declare (type double-float r v)
+              (type fixnum k n n-minus-1 base)
+-             (type (vector double-float *) wn fn)
+-             (type (vector fixnum *) kn))
++             (type (simple-array double-float (*)) wn fn)
++             (type (simple-array fixnum (*)) kn))
+     ;; build arrays
+     (setf (aref wn (- n 1)) (/ (* v (exp r)) base))
+     (setf (aref wn (- n 2)) (/ r base))
+@@ -2083,8 +2083,8 @@
+        (base (expt 2 (- +bit-operation-m+ k 1))))
+   (declare (type double-float r v tr)
+            (type fixnum k n n-minus-1 base)
+-           (type (vector double-float *) wn fn)
+-           (type (vector fixnum *) kn))
++           (type (simple-array double-float (*)) wn fn)
++           (type (simple-array fixnum (*)) kn))
+   ;; build arrays
+   (setf (aref wn (- n 1)) (/ (* (expt (+ 1d0 tr) 2) v) tr base))
+   (setf (aref wn (- n 2)) (/ r base))
+@@ -2383,7 +2383,7 @@
+                ans)))
+     (declare (type double-float s a d)
+              (type vector tix)
+-             (type (vector fixnum *) si))
++             (type (simple-array fixnum (*)) si))
+     (values tix si)))
+ 
+ (defun binomial-table-lookup (tix si)
+@@ -2415,7 +2415,7 @@
+          (b (expt 2 k)))
+     (declare (type double-float s a)
+              (type fixnum nsq k b)
+-             (type (vector double-float *) pbins))
++             (type (simple-array double-float (*)) pbins))
+     ;; build pbins
+     (setf (aref pbins 0) (int-power (- 1d0 probability) size))
+     (loop for i from 1 to size do
+@@ -2438,7 +2438,7 @@
+                                do (incf j tx)) :initial-element -1 :element-type 'fixnum))
+           (thetan 0d0))
+       (declare (type double-float w thetan)
+-               (type (vector fixnum *) table))
++               (type (simple-array fixnum (*)) table))
+       (loop with j = 0
+             for x from 0
+             for pbin across pbins
+@@ -2454,8 +2454,8 @@
+             (vi (make-array nsq :element-type 'double-float
+                             :initial-contents (loop for i from 0 to size collect (dfloat (/ (+ i 1) nsq)))))
+             (c (dfloat (/ nsq))))
+-        (declare (type (vector fixnum *) ki)
+-                 (type (vector double-float *) vi)
++        (declare (type (simple-array fixnum (*)) ki)
++                 (type (simple-array double-float (*)) vi)
+                  (type double-float c))
+         (loop repeat size do
+               (let ((maxp 0)
+@@ -2658,7 +2658,7 @@
+           (thetan 0d0)
+           (sum 0d0))
+       (declare (type double-float w thetan sum)
+-               (type (vector fixnum *) table))
++               (type (simple-array fixnum (*)) table))
+       (loop with j = 0
+           for x from 0
+           for pgeo across pgeos
+@@ -2675,8 +2675,8 @@
+             (vi (make-array nsq :element-type 'double-float
+                             :initial-contents (loop for i from 0 below nsq collect (dfloat (/ (+ i 1) nsq)))))
+             (c (dfloat (/ nsq))))
+-        (declare (type (vector fixnum *) ki)
+-                 (type (vector double-float *) vi)
++        (declare (type (simple-array fixnum (*)) ki)
++                 (type (simple-array double-float (*)) vi)
+                  (type double-float c))
+         (loop repeat (1- nsq) do
+               (let ((maxp 0)
+@@ -2911,7 +2911,7 @@
+            (sum 0d0))
+       (declare (type double-float w thetan sum pl pu)
+                (type fixnum nsq d)
+-               (type (vector fixnum *) table))
++               (type (simple-array fixnum (*)) table))
+       (unless (= xl 0)
+         (setf pps (subseq pps xl)))
+       (loop with j = 0
+@@ -2930,8 +2930,8 @@
+             (vi (make-array nsq :element-type 'double-float
+                             :initial-contents (loop for i from 0 below nsq collect (dfloat (/ (+ i 1) nsq)))))
+             (c (dfloat (/ nsq))))
+-        (declare (type (vector fixnum *) ki)
+-                 (type (vector double-float *) vi)
++        (declare (type (simple-array fixnum (*)) ki)
++                 (type (simple-array double-float (*)) vi)
+                  (type double-float c))
+         (loop repeat (1- nsq) do
+               (let ((maxp 0)
+@@ -3174,7 +3174,7 @@
+          (k 7)
+          (b (expt 2 k)))
+     (declare (type fixnum a1 a2 nsq k b)
+-             (type (vector double-float *) phs))
++             (type (simple-array double-float (*)) phs))
+     ;; build phs
+     (setf (aref phs 0)
+       (/ (dfloat (the fixnum (* (combination successes a1) (combination (- elements successes) (- samples a1)))))
+@@ -3200,7 +3200,7 @@
+           (table (make-array b :initial-element -1 :element-type 'fixnum))
+           (thetan 0d0))
+       (declare (type double-float w thetan)
+-               (type (vector fixnum *) table))
++               (type (simple-array fixnum (*)) table))
+       (loop with j = 0
+           for x from a1
+           for i from 0
+@@ -3217,8 +3217,8 @@
+             (vi (make-array nsq :element-type 'double-float
+                             :initial-contents (loop for i from 0 below nsq collect (dfloat (/ (+ i 1) nsq)))))
+             (c (dfloat (/ nsq))))
+-        (declare (type (vector fixnum *) ki)
+-                 (type (vector double-float *) vi)
++        (declare (type (simple-array fixnum (*)) ki)
++                 (type (simple-array double-float (*)) vi)
+                  (type double-float c))
+         (loop repeat (1- nsq) do
+               (let ((maxp 0)
+@@ -3442,7 +3442,7 @@
+            (sum 0d0))
+       (declare (type double-float w thetan sum pl pu)
+                (type fixnum nsq d)
+-               (type (vector fixnum *) table))
++               (type (simple-array fixnum (*)) table))
+       (unless (= xl 0)
+         (setf pnbs (subseq pnbs xl)))
+       (loop with j = 0
+@@ -3461,8 +3461,8 @@
+             (vi (make-array nsq :element-type 'double-float
+                             :initial-contents (loop for i from 0 below nsq collect (dfloat (/ (+ i 1) nsq)))))
+             (c (dfloat (/ nsq))))
+-        (declare (type (vector fixnum *) ki)
+-                 (type (vector double-float *) vi)
++        (declare (type (simple-array fixnum (*)) ki)
++                 (type (simple-array double-float (*)) vi)
+                  (type double-float c))
+         (loop repeat (1- nsq) do
+               (let ((maxp 0)
+diff --git a/time-series/src/ts-read-data.lisp b/time-series/src/ts-read-data.lisp
+index 09ad933..a692514 100644
+--- a/time-series/src/ts-read-data.lisp
++++ b/time-series/src/ts-read-data.lisp
+@@ -5,7 +5,7 @@
+   ((frequency :initarg :frequency
+               :accessor ts-freq
+               :initform nil
+-              :type number)
++              :type (or null number))
+    (start :initarg :start :accessor ts-start :initform nil)
+    (end :initarg :end :accessor ts-end :initform nil)
+    (ts-type :initarg :ts-type :accessor ts-type :initform nil)
+diff --git a/time-series/src/ts-state-space-model.lisp b/time-series/src/ts-state-space-model.lisp
+index 4dbf56a..ad9e5cc 100644
+--- a/time-series/src/ts-state-space-model.lisp
++++ b/time-series/src/ts-state-space-model.lisp
+@@ -348,8 +348,8 @@
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ (eval-when (:execute :compile-toplevel :load-toplevel)
+  (defclass trend-model (gaussian-stsp-model)
+-   ((diff-k :initarg :diff-k :initform nil :type integer :accessor diff-k)
+-    (tau^2 :initarg :tau^2 :initform nil :type number :accessor tau^2)
++   ((diff-k :initarg :diff-k :initform nil :type (or null integer) :accessor diff-k)
++    (tau^2 :initarg :tau^2 :initform nil :type (or null number) :accessor tau^2)
+     (aic :initarg :aic :initform +nan+ :type number))
+    (:documentation "- parent: gaussian-stsp-model
+ - accessors:
+@@ -492,9 +492,9 @@
+ ; seasonal model ;
+ ;;;;;;;;;;;;;;;;;;
+ (defclass seasonal-model (gaussian-stsp-model)
+-  ((s-deg  :initarg :s-deg :initform nil :type fixnum :accessor s-deg)
+-   (s-freq  :initarg :s-freq :initform nil :type fixnum :accessor s-freq)
+-   (tau^2 :initarg :tau^2 :initform nil :type number :accessor tau^2))
++  ((s-deg  :initarg :s-deg :initform nil :type (or null fixnum) :accessor s-deg)
++   (s-freq  :initarg :s-freq :initform nil :type (or null fixnum) :accessor s-freq)
++   (tau^2 :initarg :tau^2 :initform nil :type (or null number) :accessor tau^2))
+   (:documentation "- parent: gaussian-stsp-model
+ - accessors
+   - s-deg  : Degree for seasonal model
+@@ -593,8 +593,8 @@
+ ; seasonal-adjustment-model ;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ (defclass seasonal-adjustment-model (gaussian-stsp-model)
+-  ((trend :initarg :trend :initform nil :type trend-model :accessor trend-model)
+-   (seasonal :initarg :seasonal :initform nil :type seasonal-model :accessor seasonal-model))
++  ((trend :initarg :trend :initform nil :type (or null trend-model) :accessor trend-model)
++   (seasonal :initarg :seasonal :initform nil :type (or null seasonal-model) :accessor seasonal-model))
+   (:documentation "Standard seasonal adjustment model ( Trend + Seasonal )
+ - parent: gaussian-stsp-model
+ - accessors