What is the easiest way to promise a Common Lisp compiler that the result of an arithmetic expression is a fixnum?

Question

I wanted to tell sbcl that the following function will only be called with fixnum values for which the result fits in a fixnum:

(defun layer (x y z n)
  (+ (* 2 (+ (* x y) (* y z) (* x z)))
     (* 4 (+ x y z n -2) (1- n))))

My first attempt was to do

(defun layer (x y z n)
  (declare (fixnum x y z n))
  (the fixnum
    (+ (* 2 (+ (* x y) (* y z) (* x z)))
       (* 4 (+ x y z n -2) (1- n))))

But that return type declaration doesn't promise that all intermediate results will also be fixnums, as I found out by looking at the wonderfully useful compilation notes sbcl produced. So then I did this:

(defmacro fixnum+ (&rest args)
  (reduce
    (lambda (x y) `(the fixnum (+ ,x ,y)))
    args))

(defmacro fixnum* (&rest args)
  (reduce
    (lambda (x y) `(the fixnum (* ,x ,y)))
    args))

(defun layer (x y z n)
  (declare (fixnum x y z n))
  (fixnum+ (fixnum* 2 (fixnum+ (fixnum* x y) (fixnum* y z) (fixnum* x z)))
     (fixnum* 4 (fixnum+ x y z n -2) (the fixnum (1- n)))))

And that worked just fine. My question is: is there an easier, more idiomatic way to do this?

For example, maybe I can redeclare the types of +, -, *, 1- to promise fixnum results? (I know that's a bad idea in general, but I might want to do it in certain programs.) CHICKEN scheme has (declare (fixnum-arithmetic)) that does what I want: it (unsafely) assumes that the results of all arithmetic operations on fixnums are fixnums.

Clove

Answer 1

You can declare types for functions using FTYPE.

Example:

(defun foo (a b)
  (declare (ftype (function (&rest fixnum) fixnum) + * 1-)
           (type fixnum a b)
           (inline + * 1-)
           (optimize (speed 3) (safety 0) (debug 0) (space 0)))
  (+ a (* a (1- b))))

Does that make a difference?

Amiens

I tried (ftype (function (&rest fixnum) fixnum) + * 1-) and the compiler complains that the COMMON-LISP package is locked; so I added (eval-when (:compile-toplevel :execute) (unlock-package 'cl)) and then it compiled cleanly but the performance is ruined! My original program runs in 1.7 seconds with no type declarations at all; with the declarations I mention in the question (using the fixnum+ macro), it runs in 0.36 seconds; but with this suggestion it runs in 5.8 seconds! – Belemnite

Yes! That worked, it gave exactly the same performance as the "wrap everything in (the fixnum ...)" strategy that I started with. Without the inline declaration it runs in those 6 seconds I mentioned, making it much slower than if I remove all the type declarations... Thanks for the help! Given that this approach requires unlocking the COMMON-LISP package and the ftype and inline declarations, I think I might go with Paul Graham's idea of a with-type macros that wraps all intermediate results in (the type ...); but thanks anyway, this was very instructive. – Belemnite

Wow, I've never seen inline used like that! Cheers – Flong

Answer 2

In his book ANSI Common Lisp, Paul Graham shows the macro with-type, that wraps an expression and all its sub-expressions inthe forms, also ensuring that operators given more than two arguments are properly handled.

E.g. (with-type fixnum (+ 1 2 3)) will expand to the form

(the fixnum (+ (the fixnum (+ (the fixnum 1) (the fixnum 2))) 
               (the fixnum 3))

The code for the macro with helper functions is

(defmacro with-type (type expr)
  `(the ,type ,(if (atom expr) 
                   expr
                   (expand-call type (binarize expr)))))

(defun expand-call (type expr)
  `(,(car expr) ,@(mapcar #'(lambda (a) 
                              `(with-type ,type ,a))
                          (cdr expr))))

(defun binarize (expr)
  (if (and (nthcdr 3 expr)
           (member (car expr) '(+ - * /)))
      (destructuring-bind (op a1 a2 . rest) expr
        (binarize `(,op (,op ,a1 ,a2) ,@rest)))
      expr))

A link to the code from the book in found at http://www.paulgraham.com/acl.html

A comment in the code states that "This code is copyright 1995 by Paul Graham, but anyone who wants to use it is free to do so."

Thrust

Thanks! That's definitely nicer than the interface I have (but it is basically the same solution.) – Belemnite

Answer 3

Try this:

(defun layer (x y z n)
  (declare (optimize speed) (fixnum x y z n))
  (logand most-positive-fixnum
          (+ (* 2 (+ (* x y) (* y z) (* x z)))
             (* 4 (+ x y z n -2) (1- n)))))

See SBCL User Manual, Sec 6.3 Modular arithmetic.

Edit:

As mentioned in the comments, SBCL-1.1.9 (or later) is required for this to work. Also, it's possible to shave another ~40% time off by inlining the subroutines:

;;; From: https://gist.github.com/oantolin/6073417
(declaim (optimize (speed 3) (safety 0)))

(defmacro with-type (type expr)
  (if (atom expr)
      expr
      (let ((op (car expr)))
        (reduce
         (lambda (x y)
           `(the ,type
                 (,op ,@(if x (list x) '())
                      (with-type ,type ,y))))
         (cdr expr)
         :initial-value nil))))
 
(defun layer (x y z n)
  (declare (fixnum x y z n))
  (with-type fixnum
    (+ (* 2 (+ (* x y) (* y z) (* x z)))
       (* 4 (+ x y z n -2) (1- n)))))

(defun cubes (n)
  (declare (fixnum n))
  (let ((count (make-array (+ n 1) :element-type 'fixnum)))
    (loop for x of-type fixnum from 1 while (<= (layer x x x 1) n) do
      (loop for y of-type fixnum from x while (<= (layer x y y 1) n) do
        (loop for z of-type fixnum from y while (<= (layer x y z 1) n) do
          (loop for k of-type fixnum from 1 while (<= (layer x y z k) n) do
            (incf (elt count (layer x y z k)))))))
    count))

(defun first-time (x)
  (declare (fixnum x))
  (loop for n of-type fixnum = 1000 then (* 2 n)
        for k = (position x (cubes n))
        until k
        finally (return k)))

;;; With modarith and inlining
(defun first-time/inline (x)
  (declare (fixnum x))
  (labels
      ((layer (x y z n)
         (logand #.(1- (ash 1 (integer-length most-positive-fixnum)))
                 (+ (* 2 (+ (* x y) (* y z) (* x z)))
                    (* 4 (+ x y z n -2) (1- n)))))
       (cubes (n)
         (let ((count (make-array (+ n 1) :element-type 'fixnum)))
           (loop for x of-type fixnum from 1 while (<= (layer x x x 1) n) do
             (loop for y of-type fixnum from x while (<= (layer x y y 1) n) do
               (loop for z of-type fixnum from y while (<= (layer x y z 1) n) do
                 (loop for k of-type fixnum from 1 while (<= (layer x y z k) n)
                       do (incf (elt count (layer x y z k)))))))
           count)))
    (declare (inline layer cubes))
    (loop for n of-type fixnum = 1000 then (* 2 n)
          thereis (position x (cubes n)))))

#+(or) 
(progn
  (time (print (first-time 1000)))
  (time (print (first-time/inline 1000))))

;; 18522 
;; Evaluation took:
;;   0.448 seconds of real time
;;   0.448028 seconds of total run time (0.448028 user, 0.000000 system)
;;   100.00% CPU
;;   1,339,234,815 processor cycles
;;   401,840 bytes consed
;;   
;; 
;; 18522 
;; Evaluation took:
;;   0.259 seconds of real time
;;   0.260016 seconds of total run time (0.260016 user, 0.000000 system)
;;   100.39% CPU
;;   776,585,475 processor cycles
;;   381,024 bytes consed
  

Condensable

That totally ruined performance! The program I used the layer function in runs in 1.7 seconds with no type declarations at all; with the declarations I mention in the question (using the fixnum+ macro), it runs in 0.36 seconds; but with this suggestion it runs in 15 seconds! (That's not a typo.) The compilation notes are full of "forced to do generic-+", "forced to do generic-*", etc. The documentation you linked to suggests a possible culprit: the optimization does not apply to * (in the terminology of the docs, * is not a "good" function). – Belemnite

Which version of SBCL are you using? With 1.1.9, I saw no performance note when compiling. See edit. It'll be great if you can isolate your code to produce a benchmark. – Condensable

This gist gist.github.com/oantolin/6073417 contains the actual code I'm running. It currently uses your version of the function and runs in 15 seconds on my machine (using sbcl 1.1.8). To test the solution of wrapping every operation in (the fixnum ...) comment the line with logand and uncomment the line above; that runs in 0.3 seconds on my machine. – Belemnite

(By the way, in that gist I replaced my fixnum+ and fixnum* macros with (my version of) Paul Graham's with-type macro as suggested by @TerjeD. It makes no difference in the performance but makes the code look prettier.) – Belemnite

Curious. On my machine, the version using logand is still slightly better than the version using with-type: paste.lisp.org/+2YMG Perhaps SBCL has some improvements made in the latest version. – Condensable

Must be improvements going from 1.1.8 to 1.1.9, then. I tested your code on my machine and it gives the same times as I said above: 0.3 seconds for first-time/0 and 15 seconds (!) for first-time/1. – Belemnite

I looked at the release notes for 1.1.9 and it does mention several improvements related to modular arithmetic. So, I guess mystery solved. – Belemnite

Huh! So SBCL wasn't inlining those procedures? How polite of the compiler to wait until it's asked... :P Well, with that modification, the code is faster than the Python version I have, but still not as fast as Lua (obviously the implementations I use are PyPy and LuaJIT!). – Belemnite

Answer 4

Declaring the layer function inline results in a much faster speed even when block compilation is on.

On my Apple Air M1 with layer inlined and block compilation on it runs in 0.06 second under the Arm64 version of SBCL 2.1.2.

CL-USER> (time (first-time 1000))
Evaluation took:
  0.060 seconds of real time
  0.060558 seconds of total run time (0.060121 user, 0.000437 system)
  101.67% CPU
  303,456 bytes consed

I've just remembered that declaring the count array in cube should help as well.

(declare (type (simple-array fixnum (*)) count))

Without inlining the layer function it is around 0.2 second.

CL-USER> (time (first-time 1000))
Evaluation took:
  0.201 seconds of real time
  0.201049 seconds of total run time (0.200497 user, 0.000552 system)
  100.00% CPU
  251,488 bytes consed

Or converting the layer function to a macro makes it even faster.

(defmacro layer (x y z n)
  (declare (fixnum x y z n))
  `(logand #.(1- (ash 1 (integer-length most-positive-fixnum)))
      (+ (* 2 (+ (* ,x ,y) (* ,y ,z) (* ,x ,z)))
         (* 4 (+ ,x ,y ,z ,n -2) (1- ,n)))))

CL-USER> (time (first-time 1000))
Evaluation took:
  0.047 seconds of real time
  0.047032 seconds of total run time (0.046854 user, 0.000178 system)
  100.00% CPU
  312,576 bytes consed

Benchmarked with trivial-benchmark on average it runs just bellow 0.04 second:

CL-USER> (benchmark:with-timing (100) (first-time 1000))
-                SAMPLES  TOTAL     MINIMUM   MAXIMUM   MEDIAN    AVERAGE    DEVIATION  
REAL-TIME        100      3.985173  0.039528  0.06012   0.039595  0.039852   0.002046   
RUN-TIME         100      3.985848  0.039534  0.06014   0.039605  0.039858   0.002048   
USER-RUN-TIME    100      3.975407  0.039466  0.059829  0.039519  0.039754   0.002026   
SYSTEM-RUN-TIME  100      0.010469  0.00005   0.000305  0.000088  0.000105   0.00005    
PAGE-FAULTS      100      0         0         0         0         0          0.0        
GC-RUN-TIME      100      0         0         0         0         0          0.0        
BYTES-CONSED     100      50200736  273056    504320    504320    502007.38  23010.477  
EVAL-CALLS       100      0         0         0         0         0          0.0

Dressing