source: branches/1.2-devel/ccl/compiler/lambda-list.lisp @ 15278

Last change on this file since 15278 was 4020, checked in by gb, 14 years ago

%LFUN-INFO & friends: do (FUNCTION-TO-FUNCTION-VECTOR).

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.1 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17
18(in-package "CCL")
19
20
21;;; Compiler functions needed elsewhere
22
23;;; used-by: backtrace, arglist
24(defun function-symbol-map (fn)
25  (getf (%lfun-info fn) 'function-symbol-map))
26
27(defun %lfun-info-index (fn)
28  (and (compiled-function-p fn)
29       (let ((bits (lfun-bits fn)))
30         (declare (fixnum bits))
31         (and (logbitp $lfbits-symmap-bit bits)
32               (%i- (uvsize (function-to-function-vector fn))
33                              (if (logbitp $lfbits-noname-bit bits) 2 3))))))
34(defun %lfun-info (fn)
35  (let* ((index (%lfun-info-index fn)))
36    (if index (%svref (function-to-function-vector fn) index))))
37
38(defun uncompile-function (fn)
39  (getf (%lfun-info fn) 'function-lambda-expression ))
40
41
42;;; Lambda-list utilities
43
44
45
46;;; Lambda-list verification:
47
48;;; these things MUST be compiled.
49(eval-when (:load-toplevel)
50
51(defvar *structured-lambda-list* nil)
52
53
54
55
56(defun parse-body (body env &optional (doc-string-allowed t) &aux
57   decls
58   doc
59   (tail body)
60   form)
61  (declare (ignore env))
62  (loop
63   (if (endp tail) (return))  ; otherwise, it has a %car and a %cdr
64   (if (and (stringp (setq form (%car tail))) (%cdr tail))
65    (if doc-string-allowed
66     (setq doc form)
67     (return))
68    (if (not (and (consp form) (symbolp (%car form)))) 
69     (return)
70     (if (eq (%car form) 'declare)
71      (push form decls)
72      (return))))
73   (setq tail (%cdr tail)))
74  (return-from parse-body (values tail (nreverse decls) doc)))
75
76) ; end of eval-when (load)
77
78;;; End of verify-lambda-list.lisp
Note: See TracBrowser for help on using the repository browser.