Common Lisp: read/write speed

lisp

;;; -*- mode: Lisp; coding: utf-8  -*-

(defpackage :read-write-test (:use :cl))


(in-package :read-write-test)


(defconstant one-hundred-million 100000000)


(defun lexical-var-write ()
  (let ((x 0))
    (dotimes (i one-hundred-million)
      (setf x i))))


(defun lexical-var-read ()
  (let ((x 0))
    (dotimes (i one-hundred-million)
      (values x))))


(defun lexical-cons-1-write ()
  (let ((x (list 0)))
    (dotimes (i one-hundred-million)
      (setf (car x) i))))


(defun lexical-cons-1-read ()
  (let ((x (list 0)))
    (dotimes (i one-hundred-million)
      (values (car x)))))


(defun lexical-cons-10-write ()
  (let ((x (make-list 10 :initial-element 0)))
    (dotimes (i one-hundred-million)
      (setf (car (nthcdr 9 x)) i))))


(defun lexical-cons-10-read ()
  (let ((x (make-list 10 :initial-element 0)))
    (dotimes (i one-hundred-million)
      (values (car (nthcdr 9 x))))))


(defun lexical-vector-1-write ()
  (let ((x (make-array 1 :initial-element 0)))
    (dotimes (i one-hundred-million)
      (setf (aref x 0) i))))


(defun lexical-vector-1-read ()
  (let ((x (make-array 1 :initial-element 0)))
    (dotimes (i one-hundred-million)
      (values (aref x 0)))))


(defun lexical-vector-10-write ()
  (let ((x (make-array 10 :initial-element 0)))
    (dotimes (i one-hundred-million)
      (setf (aref x 9) i))))


(defun lexical-vector-10-read ()
  (let ((x (make-array 10 :initial-element 0)))
    (dotimes (i one-hundred-million)
      (values (aref x 9)))))


(defun lexical-plist-1-write ()
  (let ((x (list :x 0)))
    (dotimes (i one-hundred-million)
      (setf (getf x :x) i))))


(defun lexical-plist-1-read ()
  (let ((x (list :x 0)))
    (dotimes (i one-hundred-million)
      (values (getf x :x)))))


(defun lexical-plist-10-write ()
  (let ((x (append (make-list 18) (list :x 0))))
    (dotimes (i one-hundred-million)
      (setf (getf x :x) i))))


(defun lexical-plist-10-read ()
  (let ((x (append (make-list 18) (list :x 0))))
    (dotimes (i one-hundred-million)
      (values (getf x :x)))))


(defun symbol-plist-1-write ()
  (let ((x (gensym)))
    (dotimes (i one-hundred-million)
      (setf (get x :x) i))))


(defun symbol-plist-1-read ()
  (let ((x (gensym)))
    (dotimes (i one-hundred-million)
      (values (get x :x)))))


(defun symbol-plist-10-write ()
  (let ((x (gensym)))
    (setf (symbol-plist x)
          (append (make-list 18) (list :x 0)))
    (dotimes (i one-hundred-million)
      (setf (get x :x) i))))


(defun symbol-plist-10-read ()
  (let ((x (gensym)))
    (setf (symbol-plist x)
          (append (make-list 18) (list :x 0)))
    (dotimes (i one-hundred-million)
      (values (get x :x)))))


(defun closure-1-write ()
  (let ((fctn (let ((x 0))
                (declare (ignorable x))
                (lambda (n)
                  (setf x n)))))
    (dotimes (i one-hundred-million)
      (funcall fctn i))))


(defun closure-1-read ()
  (let ((fctn (let ((x 0))
                (lambda () (values x)))))
    (dotimes (i one-hundred-million)
      (values (funcall fctn)))))


(defstruct foo
  (x 0))


(defun struct-1-write ()
  (let ((s (make-foo)))
    (dotimes (i one-hundred-million)
      (setf (foo-x s) i))))


(defun struct-1-read ()
  (let ((s (make-foo)))
    (dotimes (i one-hundred-million)
      (values (foo-x s)))))


(defstruct foo10
  y z a b c d e f g (x 0))


(defun struct-10-write ()
  (let ((s (make-foo10)))
    (dotimes (i one-hundred-million)
      (setf (foo10-x s) i))))


(defun struct-10-read ()
  (let ((s (make-foo10)))
    (dotimes (i one-hundred-million)
      (values (foo10-x s)))))


(defclass bar ()
  ((x :initform 0 :accessor bar-x)))


(defun class-1-write ()
  (let ((o (make-instance 'bar)))
    (dotimes (i one-hundred-million)
      (setf (bar-x o) i))))


(defun class-1-read ()
  (let ((o (make-instance 'bar)))
    (dotimes (i one-hundred-million)
      (values (bar-x o)))))


(defclass bar10 ()
  #.(cons '(x :initform 0 :accessor bar10-x)
          (mapcar (lambda (x)
                    (list* (gensym) :initform 0 :accessor (gensym) x))
                  (make-list 9))))


(defun class-10-write ()
  (let ((o (make-instance 'bar10)))
    (dotimes (i one-hundred-million)
      (setf (bar10-x o) i))))


(defun class-10-read ()
  (let ((o (make-instance 'bar10)))
    (dotimes (i one-hundred-million)
      (values (bar10-x o)))))


(defun hash-1-write ()
  (let ((h (make-hash-table)))
    (setf (gethash :x h) 0)
    (dotimes (i one-hundred-million)
      (setf (gethash :x h) i))))


(defun hash-1-read ()
  (let ((h (make-hash-table)))
    (setf (gethash :x h) 0)
    (dotimes (i one-hundred-million)
      (values (gethash :x h)))))


(defun hash-10-write ()
  (let ((h (make-hash-table)))
    (setf (gethash :x h) 0)
    (dotimes (i 9)
      (setf (gethash (gensym) h) 0))
    (dotimes (i one-hundred-million)
      (setf (gethash :x h) i))))


(defun hash-10-read ()
  (let ((h (make-hash-table)))
    (setf (gethash :x h) 0)
    (dotimes (i 9)
      (setf (gethash (gensym) h) 0))
    (dotimes (i one-hundred-million)
      (values (gethash :x h)))))


(defun symbol-value-1-write ()
  (let ((sym (gensym)))
    (setf (symbol-value sym) 0)
    (dotimes (i one-hundred-million)
      (setf (symbol-value sym) i))))


(defun symbol-value-1-read ()
  (let ((sym (gensym)))
    (setf (symbol-value sym) 0)
    (dotimes (i one-hundred-million)
      (values (symbol-value sym)))))


(defvar *x* 0)


(defun global-special-1-write ()
  (dotimes (i one-hundred-million)
    (setf *x* i)))


(defun global-special-1-read ()
  (dotimes (i one-hundred-million)
    (values *x*)))


(defun local-special-1-write ()
  (let ((*ls*))
    (declare (special *ls*))
    (dotimes (i one-hundred-million)
      (setf *ls* i))))


(defun local-special-1-read ()
  (let ((*ls*))
    (declare (special *ls*))
    (dotimes (i one-hundred-million)
      (values *ls*))))


(defun lexical-alist-1-write ()
  (let ((x (acons :x 0 ())))
    (dotimes (i one-hundred-million)
      (setf (cdr (assoc :x x)) i))))


(defun lexical-alist-1-read ()
  (let ((x (acons :x 0 ())))
    (dotimes (i one-hundred-million)
      (values (cdr (assoc :x x))))))


(defun lexical-alist-10-write ()
  (let ((x (reverse (acons :x 0 (make-list 9 :initial-element (list (gensym) (gensym)))))))
    (dotimes (i one-hundred-million)
      (setf (cdr (assoc :x x)) i))))


(defun lexical-alist-10-read ()
  (let ((x (reverse (acons :x 0 (make-list 9 :initial-element (list (gensym) (gensym)))))))
    (dotimes (i one-hundred-million)
      (values (cdr (assoc :x x))))))


(defun find/writers ()
  (let ((ans () ))
    (do-symbols (s :read-write-test)
      (when (and (eq :internal (nth-value 1 (find-symbol (string s))))
                 (search "-WRITE" (string s)))
        (push s ans)))
    ans))


(defun find/readers ()
  (let ((ans () ))
    (do-symbols (s :read-write-test)
      (when (and (eq :internal (nth-value 1 (find-symbol (string s))))
                 (search "-READ" (string s)))
        (push s ans)))
    ans))


(defun run/writers ()
  (format t "~&~60,,,'=:@< ~A ~>~%" 'write)
  (format t
          "~:{~7,3F sec. ~A~%~}"
          (sort
           (mapcar (lambda (x)
                     (let ((t1 (get-internal-real-time)))
                       (funcall x)
                       (list (/ (- (get-internal-real-time) t1) internal-time-units-per-second)
                             x)))
                   (find/writers))
           #'<
           :key #'first)))


(defun run/readers ()
  (format t "~&~60,,,'=:@< ~A ~>~%" 'read)
  (format t
          "~:{~7,3F sec. ~A~%~}"
          (sort
           (mapcar (lambda (x)
                     (let ((t1 (get-internal-real-time)))
                       (funcall x)
                       (list (/ (- (get-internal-real-time) t1) internal-time-units-per-second)
                             x)))
                   (find/readers))
           #'<
           :key #'first)))


(progn
  (run/readers)
  (run/writers))


;;; *EOF*

=========================== READ ===========================
  0.141 sec. LOCAL-SPECIAL-1-READ
  0.141 sec. SYMBOL-VALUE-1-READ
  0.141 sec. LEXICAL-VAR-READ
  0.142 sec. GLOBAL-SPECIAL-1-READ
  0.146 sec. LEXICAL-CONS-1-READ
  0.237 sec. SYMBOL-PLIST-1-READ
  0.253 sec. CLOSURE-1-READ
  0.286 sec. STRUCT-10-READ
  0.315 sec. LEXICAL-ALIST-1-READ
  0.315 sec. STRUCT-1-READ
  0.346 sec. LEXICAL-CONS-10-READ
  0.347 sec. LEXICAL-VECTOR-1-READ
  0.347 sec. LEXICAL-VECTOR-10-READ
  0.475 sec. LEXICAL-PLIST-1-READ
  1.139 sec. HASH-1-READ
  1.167 sec. HASH-10-READ
  1.200 sec. SYMBOL-PLIST-10-READ
  2.075 sec. CLASS-10-READ
  2.095 sec. CLASS-1-READ
  3.090 sec. LEXICAL-PLIST-10-READ
  5.215 sec. LEXICAL-ALIST-10-READ
=========================== WRITE ==========================
  0.141 sec. LEXICAL-VAR-WRITE
  0.219 sec. LEXICAL-CONS-1-WRITE
  0.347 sec. LEXICAL-PLIST-1-WRITE
  0.347 sec. GLOBAL-SPECIAL-1-WRITE
  0.363 sec. LOCAL-SPECIAL-1-WRITE
  0.376 sec. STRUCT-10-WRITE
  0.378 sec. STRUCT-1-WRITE
  0.469 sec. LEXICAL-ALIST-1-WRITE
  0.471 sec. LEXICAL-VECTOR-1-WRITE
  0.471 sec. LEXICAL-VECTOR-10-WRITE
  0.503 sec. LEXICAL-CONS-10-WRITE
  0.536 sec. SYMBOL-VALUE-1-WRITE
  0.758 sec. SYMBOL-PLIST-1-WRITE
  1.892 sec. CLOSURE-1-WRITE
  2.108 sec. LEXICAL-PLIST-10-WRITE
  2.243 sec. CLASS-10-WRITE
  2.246 sec. CLASS-1-WRITE
  2.519 sec. SYMBOL-PLIST-10-WRITE
  3.548 sec. HASH-10-WRITE
  3.555 sec. HASH-1-WRITE
  5.095 sec. LEXICAL-ALIST-10-WRITE
International Allegro CL Free Express Edition
11.0 [64-bit macOS (Apple Silicon)]
Copyright (C) 1985-2023, Franz Inc., Lafayette, CA, USA.  All Rights Reserved.

This development copy of Allegro CL is licensed to:
   Allegro CL 11.0 Express user