source: trunk/abcl/src/org/armedbear/lisp/deftype.lisp

Last change on this file was 14914, checked in by Mark Evenson, 4 years ago

Dramatically improve source recording on SYS::SOURCE plist for a symbol (Alan Ruttenberg)

The interface to recording information on the SYS:%SOURCE plist for a
symbol is now deprecated and will be removed with abcl-1.7.


Source information for ABCL is now recorded on the SYS::SOURCE
property. The appropiate information for type is recorded by the

record-source-information-by-type (name type &optional source-pathname source-position)

TYPE is either a symbol or list.

Source information for functions, methods, and generic functions are
represented as lists of the following form:

(:generic-function function-name)
(:function function-name)
(:method method-name qualifiers specializers)

Where FUNCTION-NAME or METHOD-NAME can be a either be of the form
'symbol or '(setf symbol).

Source information for all other forms have a symbol for TYPE which is
one of the following:

:class, :variable, :condition, :constant, :compiler-macro, :macro
:package, :structure, :type, :setf-expander, :source-transform

These values follow SBCL'S implemenation in SLIME
c.f. <>

Modifications are in two places, one at the definitions, calling
record-source-information-by-type and then again in the file-compiler,
which writes forms like

(put 'source name (cons (list type pathname position) (get 'source name)))

In theory this can lead to redundancy if a fasl is loaded again and
again. I'm not sure how to fix this yet. Forms in the loader get
called early in build when many of the sequence functions aren't
present. Will probably just filter when presenting in slime.

<> :closes <> .
<> :merges <> .

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 3.1 KB
1;;; deftype.lisp
3;;; Copyright (C) 2004-2005 Peter Graves
4;;; $Id: deftype.lisp 14914 2016-11-24 10:31:17Z mevenson $
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; GNU General Public License for more details.
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
20;;; As a special exception, the copyright holders of this library give you
21;;; permission to link this library with independent modules to produce an
22;;; executable, regardless of the license terms of these independent
23;;; modules, and to copy and distribute the resulting executable under
24;;; terms of your choice, provided that you also meet, for each linked
25;;; independent module, the terms and conditions of the license of that
26;;; module.  An independent module is a module which is not derived from
27;;; or based on this library.  If you modify this library, you may extend
28;;; this exception to your version of the library, but you are not
29;;; obligated to do so.  If you do not wish to do so, delete this
30;;; exception statement from your version.
32(in-package #:system)
34(defmacro deftype (name lambda-list &rest body)
35  (when (eq (symbol-package name) +cl-package+)
36    (error :format-control "Attempt to define ~S, a symbol in the COMMON-LISP package, as a type specifier."
37           :format-arguments (list name)))
38  (check-declaration-type name)
39  ;; Optional and keyword parameters default to * rather than NIL.
40  (when (or (memq '&optional lambda-list)
41            (memq '&key lambda-list))
42    (let ((new-lambda-list ())
43          (state nil))
44      (dolist (thing lambda-list)
45        (cond ((eq thing '&optional)
46               (setf state '&optional))
47              ((eq thing '&key)
48               (setf state '&key))
49              ((memq thing lambda-list-keywords)
50               (setf state nil))
51              ((eq state '&optional)
52               (when (symbolp thing)
53                 (setf thing (list thing ''*))))
54              ((eq state '&key)
55               (when (symbolp thing)
56                 (setf thing (list thing ''*)))))
57        (push thing new-lambda-list))
58      (setf lambda-list (nreverse new-lambda-list))))
59  `(progn
60     (record-source-information-for-type ',name :type)
61     (setf (get ',name 'deftype-definition)
62           #'(lambda ,lambda-list (block ,name ,@body)))
63     ',name))
65(defun expand-deftype (type)
66  (let (tp i)
67    (loop
68      (if (consp type)
69          (setf tp (%car type) i (%cdr type))
70          (setf tp type
71                i nil))
72      (if (and (symbolp tp) (get tp 'deftype-definition))
73          (setf type (apply (get tp 'deftype-definition) i))
74          (return))))
75  type)
Note: See TracBrowser for help on using the repository browser.