1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: gentils.lisp
6 ;;;; Purpose: Main general utility functions for KMRCL package
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
10 ;;;; $Id: macros.lisp,v 1.1 2003/04/28 23:51:59 kevin Exp $
12 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; KMRCL users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
21 (defmacro let-when ((var test-form) &body body)
22 `(let ((,var ,test-form))
25 (defmacro let-if ((var test-form) if-true &optional if-false)
26 `(let ((,var ,test-form))
27 (if ,var ,if-true ,if-false)))
31 (defmacro aif (test then &optional else)
35 (defmacro awhen (test-form &body body)
39 (defmacro awhile (expr &body body)
40 `(do ((it ,expr ,expr))
44 (defmacro aand (&rest args)
46 ((null (cdr args)) (car args))
47 (t `(aif ,(car args) (aand ,@(cdr args))))))
49 (defmacro acond (&rest clauses)
52 (let ((cl1 (car clauses))
54 `(let ((,sym ,(car cl1)))
56 (let ((it ,sym)) ,@(cdr cl1))
57 (acond ,@(cdr clauses)))))))
59 (defmacro alambda (parms &body body)
60 `(labels ((self ,parms ,@body))
64 (defmacro aif2 (test &optional then else)
66 `(multiple-value-bind (it ,win) ,test
67 (if (or it ,win) ,then ,else))))
69 (defmacro awhen2 (test &body body)
73 (defmacro awhile2 (test &body body)
74 (let ((flag (gensym)))
81 (defmacro acond2 (&rest clauses)
84 (let ((cl1 (car clauses))
87 `(multiple-value-bind (,val ,win) ,(car cl1)
89 (let ((it ,val)) ,@(cdr cl1))
90 (acond2 ,@(cdr clauses)))))))
94 `(pprint (macroexpand-1 ',expr)))
96 (defmacro print-form-and-results (form)
97 `(format t "~&~A --> ~S~%" (write-to-string ',form) ,form))
102 (defmacro until (test &body body)
107 (defmacro while (test &body body)
112 (defmacro for ((var start stop) &body body)
113 (let ((gstop (gensym)))
114 `(do ((,var ,start (1+ ,var))
119 (defmacro with-each-stream-line ((var stream) &body body)
123 `(let ((,strm ,stream)
125 (do ((,var (read-line ,strm nil ,eof) (read-line ,strm nil ,eof)))
129 (defmacro with-each-file-line ((var file) &body body)
130 (let ((stream (gensym)))
131 `(with-open-file (,stream ,file :direction :input)
132 (with-each-stream-line (,var ,stream)
136 (defmacro in (obj &rest choices)
137 (let ((insym (gensym)))
138 `(let ((,insym ,obj))
139 (or ,@(mapcar #'(lambda (c) `(eql ,insym ,c))
142 (defmacro mean (&rest args)
143 `(/ (+ ,@args) ,(length args)))
145 (defmacro with-gensyms (syms &body body)
146 `(let ,(mapcar #'(lambda (s) `(,s (gensym)))
151 (defmacro time-iterations (n &body body)
156 (format t "~&Test with ~d iterations: ~W" ,count (quote ,body))
157 (let ((t1 (get-internal-real-time)))
160 (let* ((t2 (get-internal-real-time))
161 (secs (coerce (/ (- t2 t1)
162 internal-time-units-per-second)
164 (format t "~&Total time: ")
166 (format t ", time per iteration: ")
167 (print-seconds (coerce (/ secs ,n) 'double-float))))))))