changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/std/macs/loop.lisp

changeset 698: 96958d3eb5b0
parent: 571685ae64f1
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; loop.lisp --- Loop-like Macros
     2 
     3 ;; LOOP extensions
     4 
     5 ;;; Code:
     6 (in-package :std/macs)
     7 ;; ref: https://github.com/bendudson/array-operations
     8 (defmacro nested-loop (syms dimensions &body body)
     9   "Iterates over a multidimensional range of indices.
    10 
    11    SYMS must be a list of symbols, with the first symbol
    12    corresponding to the outermost loop.
    13 
    14    DIMENSIONS will be evaluated, and must be a list of
    15    dimension sizes, of the same length as SYMS.
    16 
    17    Example:
    18     (nested-loop (i j) '(10 20) (format t '~a ~a~%' i j))"
    19   (unless syms (return-from nested-loop `(progn ,@body))) ; No symbols
    20   ;; Generate gensyms for dimension sizes
    21   (let* ((rank (length syms))
    22          ;; reverse our symbols list,
    23          ;; since we start from the innermost.
    24          (syms-rev (reverse syms))
    25          ;; innermost dimension first:
    26          (dims-rev (loop for i from 0 below rank
    27                          collecting (gensym)))
    28          ;; start with innermost expression
    29          (result `(progn ,@body)))
    30     ;; Wrap previous result inside a loop for each dimension
    31     (loop for sym in syms-rev for dim in dims-rev do
    32          (unless (symbolp sym)
    33            (error "~S is not a symbol. First argument to nested-loop must be a list of symbols" sym))
    34          (setf result
    35                `(loop for ,sym from 0 below ,dim do
    36                      ,result)))
    37     ;; Add checking of rank and dimension types,
    38     ;; and get dimensions into gensym list.
    39     (let ((dims (gensym)))
    40       `(let ((,dims ,dimensions))
    41          (unless (= (length ,dims) ,rank)
    42            (error "Incorrect number of dimensions: Expected ~a but got ~a" ,rank (length ,dims)))
    43          (dolist (dim ,dims)
    44            (unless (integerp dim)
    45              (error "Dimensions must be integers: ~S" dim)))
    46          ;; dimensions reversed so that innermost is last:
    47          (destructuring-bind ,(reverse dims-rev) ,dims
    48            ,result)))))