/[cldoc]/cldoc/src/cldoc.asd
ViewVC logotype

Contents of /cldoc/src/cldoc.asd

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Thu Jan 11 00:05:06 2007 UTC (7 years, 3 months ago) by ihatchondo
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +1 -3 lines
Fixed: wrong system location with some lisp controllers, reported and patch proposed by Kilian Sprotte.
1 ;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
2 ;;; $Id: cldoc.asd,v 1.2 2007/01/11 00:05:06 ihatchondo Exp $
3 ;;; ---------------------------------------------------------------------------
4 ;;; Title: Common Lisp Universal Documentation Generator: system definition
5 ;;; Created: 2005 4 23 2:30
6 ;;; Author: Iban Hatchondo <hatchond@yahoo.fr>
7 ;;; ---------------------------------------------------------------------------
8 ;;; (c) copyright 2005 by Iban Hatchondo
9
10 ;;; The authors grant you the rights to distribute
11 ;;; and use this software as governed by the terms
12 ;;; of the Lisp Lesser GNU Public License
13 ;;; (http://opensource.franz.com/preamble.html),
14 ;;; known as the LLGPL.
15
16 ;;; ASDF system definition for Cludg.
17
18 (defpackage :cldoc.system
19 (:use :cl :asdf))
20
21 (in-package :cldoc.system)
22
23 (defsystem :cldoc
24 :components
25 ((:file "package")
26 (:file "cludg" :depends-on ("package"))
27 (:file "cache-system" :depends-on ("cludg"))
28 (:file "string-parser" :depends-on ("cludg"))
29 (:file "html" :depends-on ("cludg" "cache-system" "string-parser"))))
30
31 #+:sbcl
32 (defmethod perform :around (o f)
33 ;; SBCL signals an error if DEFCONSTANT is asked to redefine a
34 ;; constant unEQLly. For CLUDG's purposes, however, we are defining
35 ;; structured constants (lists and arrays) not for EQLity, but for
36 ;; the purposes of constant-folding operations such as (MEMBER FOO
37 ;; +BAR+), so it is safe to abort the redefinition provided the
38 ;; structured data is sufficiently equal.
39 (handler-bind
40 ((sb-ext:defconstant-uneql
41 (lambda (c)
42 ;; KLUDGE: this really means "don't warn me about
43 ;; efficiency of generic array access, please"
44 (declare (optimize (sb-ext:inhibit-warnings 3)))
45 (let ((old (sb-ext:defconstant-uneql-old-value c))
46 (new (sb-ext:defconstant-uneql-new-value c)))
47 (typecase old
48 (list (when (equal old new) (abort c)))
49 (string (when (and (typep new 'string)
50 (string= old new))
51 (abort c)))
52 (simple-vector
53 (when (and (typep new 'simple-vector)
54 (= (length old) (length new))
55 (every #'eql old new))
56 (abort c)))
57 (array
58 (when (and (typep new 'array)
59 (equal (array-dimensions old)
60 (array-dimensions new))
61 (equal (array-element-type old)
62 (array-element-type new))
63 (dotimes (i (array-total-size old) t)
64 (unless (eql (row-major-aref old i)
65 (row-major-aref new i))
66 (return nil))))
67 (abort c))))))))
68 (call-next-method)))

  ViewVC Help
Powered by ViewVC 1.1.5