aboutsummaryrefslogtreecommitdiff
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
generated by cgit
it/gnu/tests?id=65c77f608916f0c206d0d821db1afa2558c5a74f'>gnu: lightdm: Apply patch to fix VNC server address binding ordering....* gnu/packages/patches/lightdm-vnc-ipv6.patch: New patch file. * gnu/local.mk (dist_patch_DATA): Register it. * gnu/packages/display-managers.scm (lightdm): Apply it. * gnu/tests/lightdm.scm (run-lightdm-test): Remove comment and expected fail directive for the "can connect to TCP port 5900 on IPv6" test. Suggested-by: Bruno Victal <mirai@makinata.eu> Maxim Cournoyer 2023-07-07image: Prefer gpt partition table for efi images...* gnu/system/image.scm (efi-disk-image): Use gpt partition-table-type. (efi32-disk-image): Use gpt partition-table-type. (qcow2-image-type): Use mbr partition-table-type explicitly. * gnu/tests/image.scm: Assert partition table type of efi-disk-image. Signed-off-by: Josselin Poiret <dev@jpoiret.xyz> Sergey Trofimov 2023-05-25tests: Fix the Jami service system tests....This fixes a regression introduced with commit a09c7da ("tests: Fork and exec a new Guile for the marionette REPL.") and only partially fixed with the follow-up commit f518882 (" tests: Add missing module imports for marionette-evaluated code."). * gnu/tests/telephony.scm (run-jami-test): Remove extraneous module imports. Move the setting of the DBUS_SESSION_BUS_ADDRESS environment variable inside the first marionette-eval'd setup test. ["service can be stopped"]: Add missing (gnu build dbus-service) module. Maxim Cournoyer 2023-05-18services: rsync: Use make-inetd-constructor....* gnu/services/rsync.scm (rsync-shepherd-service): Use make-inetd-constructor if available in start slot. * gnu/tests/rsync.scm (run-rsync-test): Delete "PID file" test. Reviewed-by: Ludovic Courtès <ludo@gnu.org> Maxim Cournoyer 2023-05-14tests: elogind: Wait until 'elogind' is up....Previously we could find ourselves typing in too early. * gnu/tests/desktop.scm (run-elogind-test)["login on tty1"]: Wait for 'elogind in to 'term-tty1. ["screendump"]: New test. Ludovic Courtès 2023-05-14tests: dhcpd: Avoid race conditions....Those tests were racy: it could take a while for those files to appear and for the shepherd service to be up. Thus, wait a little longer for each of them. * gnu/tests/networking.scm (run-dhcpd-test)["pid file exists"] ["lease file exists"]: Use 'wait-for-file'. ["dhcpd is alive"]: Use 'wait-for-service'. Ludovic Courtès 2023-05-11tests: vnstat: Avoid call to 'getservbyname'....This would break "make as-derivation" because /etc/services is unavailable in the build environment: [ 38/ 80] loading... 95.0% of 40 filesBacktrace: In guix/build/compile.scm: 249:8 19 (compile-files "." "/gnu/store/s5nadqd6hkzivkxp33svwqslfn608ng5-guix-system-tests" ("gnu/tests/audio.scm" "gnu/tests/base.scm" "gnu/tests/ci.scm" "gnu/tests/cups.scm" "gnu/tests/d…" …) …) […] In unknown file: 0 (getserv "discard" "tcp") ERROR: In procedure getserv: In procedure getserv: no such service discard builder for `/gnu/store/…-guix-system-tests.drv' failed with exit code 1 * gnu/tests/vnstat.scm (run-vnstat-test): Hard-code 'guest-port' instead of calling 'getservbyname'. Ludovic Courtès 2023-05-11tests: Add vnstat tests....* gnu/tests/vnstat.scm: New file. * gnu/local.mk: Register it. Signed-off-by: Ludovic Courtès <ludo@gnu.org> Bruno Victal 2023-05-11tests: openvswitch: Wait for 'openvswitch-configuration' to be up....Checking for "br0" should only be done once the 'openvswitch-configuration' service is up because it's the one that sets it up. * gnu/tests/networking.scm (run-openvswitch-test)["openvswitch-configuration is running"]: New test. Ludovic Courtès 2023-05-10tests: docker-system: Add missing import....This is a followup to f51888272558d98cf5c196b93fb6c499056fbf6c. * gnu/tests/docker.scm (run-docker-system-test)["load system image and run it"]: Use (guix build utils). Ludovic Courtès 2023-05-06tests: Add missing module imports for marionette-evaluated code....This missing imports became apparent with commit a09c7da8f8d8e732f969cf0a09aaa78f87032ab1, which runs the marionette service in a fresh Guile process with fewer imports. * gnu/tests/databases.scm (run-postgresql-test, run-timescaledb-test) (run-mysql-test): Add missing module imports for code passed to 'marionette-eval'. * gnu/tests/docker.scm (run-docker-test, run-docker-system-test): Likewise. * gnu/tests/mail.scm (run-dovecot-test, run-getmail-test): Likewise. * gnu/tests/monitoring.scm (run-zabbix-server-test): Likewise. * gnu/tests/pam.scm (run-test-pam-limits): Likewise. * gnu/tests/reconfigure.scm (run-switch-to-system-test) (run-install-bootloader-test): Likewise. * gnu/tests/security-token.scm (run-pcscd-test): Likewise. * gnu/tests/install.scm (gui-test-program): Likewise. * gnu/tests/telephony.scm (run-jami-test): Add modules to the #:imported-modules argument of 'marionette-operating-system'. [test]: Remove them from 'with-imported-modules'; remove 'with-extensions'. Add "d-bus tooling loaded" test to set up %load-path and %load-compiled-path so the marionette process can find guile-ac-d-bus and guile-packrat. Ludovic Courtès 2023-04-21tests: Use the client 'start-service' procedure....The previous code worked "by chance": 'start' from (shepherd service) happened to be in scope because the marionette REPL is created by a mere 'primitive-fork', and 'start' happened to kinda work. * gnu/tests/base.scm (run-basic-test): Use 'start-service' from (gnu services herd), not 'start' from (shepherd service), which is not supposed to work. * gnu/tests/install.scm (run-install): Likewise. Ludovic Courtès