9

次の関数は、結果が fixnum に収まる fixnum 値でのみ呼び出されることを sbcl に伝えたかったのです。

(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))))

しかし、sbcl が作成した非常に有用なコンパイル ノートを見て分かったように、その戻り値の型宣言は、すべての中間結果も fixnum になるとは約束していません。それで、私はこれをしました：

(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))（安全ではありませんが）fixnum に対するすべての算術演算の結果が fixnum であると仮定します。

4

4 に答える 4

11

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))))

それは違いがありますか？

于 2013-07-24T16:43:52.660 に答える
7

Paul Graham は、著書 ANSI Common Lisp でwith-type、式とそのすべての部分式をtheフォームでラップするマクロ を示し、2 つ以上の引数が与えられた演算子が適切に処理されるようにします。

たとえば(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にあります。

コード内のコメントには、「このコードの著作権は 1995 年に Paul Graham にありますが、使用したい人は誰でも自由に使用できます」と述べられています。

于 2013-07-24T18:07:30.493 に答える
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 ユーザー マニュアルのセクション 6.3 モジュラー演算を参照してください。

編集：

コメントで述べたように、これが機能するには 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
于 2013-07-24T16:56:20.503 に答える