utils.lisp

   1 ;;;;***************************************************************************
   2 ;;;;
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;;  Name:           reversi-base.cl
   6 ;;;;  Purpose:        Basic functions for reversi
   7 ;;;;  Programer:      Kevin M. Rosenberg, M.D.
   8 ;;;;  Date Started:   1 Nov 2001
   9 ;;;;  CVS Id:         $Id: utils.lisp,v 1.1 2002/10/25 08:36:42 kevin Exp $
  10 ;;;;
  11 ;;;;***************************************************************************
  12
  13 (in-package :reversi)
  14 (declaim (optimize (safety 1) (debug 3) (speed 3)))
  15
  16
  17 ;; Anaphoric macros
  18
  19 (defmacro aif (test then &optional else)
  20   `(let ((it ,test))
  21      (if it ,then ,else)))
  22
  23 (defmacro awhen (test-form &body body)
  24   `(aif ,test-form
  25         (progn ,@body)))
  26
  27 (defmacro awhile (expr &body body)
  28   `(do ((it ,expr ,expr))
  29        ((not it))
  30      ,@body))
  31
  32 (defmacro aand (&rest args)
  33   (cond ((null args) t)
  34         ((null (cdr args)) (car args))
  35         (t `(aif ,(car args) (aand ,@(cdr args))))))
  36
  37 (defmacro acond (&rest clauses)
  38   (if (null clauses)
  39       nil
  40       (let ((cl1 (car clauses))
  41             (sym (gensym)))
  42         `(let ((,sym ,(car cl1)))
  43            (if ,sym
  44                (let ((it ,sym)) ,@(cdr cl1))
  45                (acond ,@(cdr clauses)))))))
  46
  47 (defmacro alambda (parms &body body)
  48   `(labels ((self ,parms ,@body))
  49      #'self))
  50
  51
  52 (defun mappend (fn list)
  53   "Append the results of calling fn on each element of list.
  54   Like mapcon, but uses append instead of nconc."
  55   (apply #'append (mapcar fn list)))
  56
  57 (defun random-elt (seq)
  58   "Pick a random element out of a sequence."
  59   (elt seq (random (length seq))))
  60
  61 (defun concat-symbol (&rest args)
  62   "Concatenate symbols or strings to form an interned symbol"
  63   (intern (format nil "~{~a~}" args)))
  64
  65 (defun cross-product (fn xlist ylist)
  66   "Return a list of all (fn x y) values."
  67   (mappend #'(lambda (y)
  68                (mapcar #'(lambda (x) (funcall fn x y))
  69                        xlist))
  70            ylist))
  71
  72
  73 (defmacro until (test &body body)
  74   `(do ()
  75        (,test)
  76      ,@body))
  77
  78 (defmacro while (test &body body)
  79   `(do ()
  80        ((not ,test))
  81      ,@body))
  82
  83 #+ignore
  84 (defmacro while (test &body body)
  85   `(do ()
  86        (not ,test)
  87      ,@body))
  88
  89 #+excl
  90 (defun list-to-delimited-string (list &optional (separator #\space))
  91   (excl:list-to-delimited-string list separator))
  92
  93 #-excl
  94 (defun list-to-delimited-string (list &optional (separator #\space))
  95   (let ((output (when list (format nil "~A" (car list)))))
  96     (dolist (obj (rest list))
  97       (setq output (concatenate 'string output
  98                                 (format nil "~A" separator)
  99                                 (format nil "~A" obj))))
 100     output))
 101
 102
 103