external/clem/src/mloop.lisp

   1 ;;; -*- Mode: lisp; outline-regexp: ";;;;;*"; indent-tabs-mode: nil -*-;;;
   2 ;;;
   3 ;;; file: mloop.cl
   4 ;;; author: cyrus harmon
   5 ;;;
   6
   7 ;;; macros for looping over matrices and doing operations with the benefit
   8 ;;; of type declarations
   9
  10 (in-package :clem)
  11
  12 (defun parse-mloop-vars (vars)
  13   (apply #'mapcar (cons #'list vars)))
  14
  15 (defmacro mloop ((mspecs m n i j) &body body)
  16   (destructuring-bind (matrices types vars)
  17       (parse-mloop-vars mspecs)
  18     `(destructuring-bind (,m ,n) (clem:dim ,(car matrices))
  19        (declare (type fixnum ,m ,n))
  20        (let (,@(loop for var in vars and matrix in matrices
  21                   collect
  22                     `(,var (clem::matrix-vals ,matrix))))
  23          ,@(loop for type in types and var in vars
  24               collect
  25                 `(declare (type (simple-array ,type *) ,var)))
  26          (dotimes (,i ,m)
  27            (declare (type fixnum ,i))
  28            (dotimes (,j ,n)
  29              (declare (type fixnum ,j))
  30              ,@body))))))
  31
  32 (defmacro mloop-range ((mspecs startr endr startc endc i j) &body body)
  33   (destructuring-bind (matrices types vars)
  34       (parse-mloop-vars mspecs)
  35     `(let (,@(loop for var in vars and matrix in matrices
  36                 collect
  37                   `(,var (clem::matrix-vals ,matrix))))
  38        ,@(loop for type in types and var in vars
  39             collect
  40               `(declare (type (simple-array ,type *) ,var)))
  41        (do ((,i ,startr (1+ ,i)))
  42            ((> ,i ,endr))
  43          (declare (type fixnum ,i))
  44          (do ((,j ,startc (1+ ,j)))
  45              ((> ,j ,endc))
  46            (declare (type fixnum ,j))
  47            ,@body)))))
  48
  49