Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 64 lines (51 sloc) 2.346 kB
9cd3801 @xach Initial commit.
authored
1 ;;; -*- Mode: Common-Lisp; Syntax: Common-Lisp; Package: LINJ; Base: 10 -*-
2
3 ;;; Copyright (C) Antonio Menezes Leitao Created on Thu Sep 18 04:14:25 2003
4 ;;; Copyright (C) eValuator, Lda
5
6 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
7 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
8 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
9 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
10 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
11 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
12 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
13 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
14 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
15 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
16 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
17
18 (in-package "LINJ")
19
20 ;;This file requires the Linj readtable
21 (eval-when (:compile-toplevel :load-toplevel)
22 (setq *readtable* *linj-readtable*))
23
24
25 (def-macro-transform nil (ecase ?expr . ?clauses)
26 `(case ,?expr
27 ,@?clauses
28 (t (error "~A fell through ECASE expression." ,?expr))))
29
30
31 (def-macro-transform nil (typecase (?is ?expr atom) . ?clauses)
32 `(cond ,@(mapcar #'(lambda (clause)
33 (if (member (first clause) '(t otherwise))
34 clause
35 `((typep ,?expr ',(first clause))
36 ,@(rest clause))))
37 ?clauses)))
38
39 (def-macro-transform statement (typecase (?is ?expr consp) . ?clauses)
40 (with-new-names (type-expr)
41 `(let ((,type-expr ,?expr))
42 (typecase ,type-expr . ,?clauses))))
43
44 (def-macro-transform nil (etypecase ?expr . ?clauses)
45 `(typecase ,?expr
46 ,@?clauses
47 (t (error "~A fell through ETYPECASE expression." ,?expr))))
48
49 (def-macro assert (test &optional places datum-form &rest argument-forms)
50 (assert (listp places))
51 `(unless ,test
52 (error 'runtime-exception
53 (format nil
54 ,(or datum-form (format nil "The assertion ~A failed." test))
55 ,@argument-forms))))
56
57 (def-macro time (expr)
58 `(let ((start-time (in (the system) (current-time-millis))))
59 ,expr
60 (let ((end-time (in (the system) (current-time-millis))))
61 (format *trace-output*
62 "The evaluation took ~A milliseconds~%"
63 (- end-time start-time)))))
Something went wrong with that request. Please try again.