Adaptation of the grid approach to 2D arrays from PicoLisp to Common Lisp

grid.lisp

(defun pair-to-alphanumeric (a b)
  (loop
    for n = a then (truncate n 26)
    until (zerop n)
    collect (mod n 26) into chars
    finally
       (setf chars (nreverse chars))
       (when (cdr chars)
	 (decf (car chars)))
       (unless chars
	 (push 0 chars))
       (return (concatenate 'string
			    (coerce (mapcar #'(lambda (x)
						(code-char (+ x (char-code #\a))))
					    chars)
				    'string)
			    (prin1-to-string b)))))

(defun grid (n m &key wrap-rows wrap-cols)
  (loop
    with hash = (make-hash-table :test #'equalp)
    for row from 0 below n
    collect (loop
	      for col from 0 below m
	      for sym = (gethash (cons row col) hash
				 (gensym (concatenate 'string (pair-to-alphanumeric row col) "-")))
	      do
		 (when (> col 0)	;left
		   (setf (get sym :left)
			 (gethash (cons row (1- col)) hash
				  (gensym (concatenate 'string (pair-to-alphanumeric row (1- col)) "-")))))
		 (when (< col (1- m))	;right
		   (setf (get sym :right)
			 (gethash (cons row (1+ col)) hash
				  (gensym (concatenate 'string (pair-to-alphanumeric row (1+ col)) "-")))))
		 (when (> row 0)	;up
		   (setf (get sym :up)
			 (gethash (cons (1- row) col) hash
				  (gensym (concatenate 'string (pair-to-alphanumeric (1- row) col) "-")))))
		 (when (< row (1- n))	;down
		   (setf (get sym :down)
			 (gethash (cons (1+ row) col) hash
				  (gensym (concatenate 'string (pair-to-alphanumeric (1+ row) col) "-")))))
	      collect sym)))


(defmacro def-dir (d)
  `(defun ,d (field)
     (get field ,(intern (symbol-name d) 'keyword))))

(def-dir up)
(def-dir down)
(def-dir left)
(def-dir right)