我想告诉sbcl只能使用fixnum值调用以下函数，其结果适合fixnum：
(defun layer (x y z n)
(+ (* 2 (+ (* x y) (* y z) (* x z)))
(* 4 (+ x y z n -2) (1- n))))
我的第一次尝试是
(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))))
但是返回类型声明并不保证所有中间结果也都是fixnums，正如我通过查看sbcl产生的非常有用的编译说明所发现的那样。那么我就这样做了：
(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)))))
这很好用。我的问题是：是否有更简单，更惯用的方式来做到这一点？
例如，也许我可以重新声明+， - ，*，1-的类型以承诺fixnum结果？ （我知道这通常是一个坏主意，但我可能想在某些程序中这样做。）CHICKEN方案有(declare (fixnum-arithmetic))可以做我想要的：它（不安全）假定所有算术操作的结果都在fixnums上是固定的。
答案 0 :(得分：9)
您可以使用FTYPE声明函数的类型。
示例：
(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))))
这会有所作为吗？
答案 1 :(得分：6)
在他的书“ANSI Common Lisp”中，Paul Graham展示了宏with-type，它以the形式包装表达式及其所有子表达式，同时确保给出两个以上参数的运算符是正确的处理。
E.g。 (with-type fixnum (+ 1 2 3))将扩展为
(the fixnum (+ (the fixnum (+ (the fixnum 1) (the fixnum 2)))
(the fixnum 3))
具有辅助函数的宏的代码是
(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))
指向http://www.paulgraham.com/acl.html
中找到的图书代码的链接代码中的评论指出“这段代码是Paul Graham 1995年版权所有，但任何人都想要 使用它是免费的。“
答案 2 :(得分：2)
试试这个：
(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)))))
请参阅SBCL User Manual, Sec 6.3 Modular arithmetic。
如评论中所述，SBCL-1.1.9（或更高版本）是必需的。此外，通过内联子程序可以减少约40％的时间：
;;; 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
答案 3 :(得分：2)
即使在块编译打开时，内联声明层函数也会导致速度更快。
在我的带有层内联和块编译的 Apple Air M1 上，在 SBCL 2.1.2 的 Arm64 版本下运行时间为 0.06 秒。
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
我刚刚记得在多维数据集中声明计数数组也应该有帮助。
(declare (type (simple-array fixnum (*)) count))
如果没有内联层函数，它大约是 0.2 秒。
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
或者将图层函数转换为宏，速度会更快。
(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
以平凡的基准进行基准测试，它的平均运行时间仅为 0.04 秒以下：
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