src/code/early-full-eval.lisp

   1 ;;;; An interpreting EVAL
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!EVAL")
  13
  14 (sb!int:!defparameter *eval-level* -1)
  15 (sb!int:!defparameter *eval-verbose* nil)
  16
  17 ;; !defstruct-with-alternate-metaclass is unslammable and the
  18 ;; RECOMPILE restart doesn't work on it.  This is the main reason why
  19 ;; this stuff is split out into its own file.  Also, it lets the
  20 ;; INTERPRETED-FUNCTION type be declared before it is used in
  21 ;; compiler/main and code/deftypes-for-target.
  22 (sb!kernel::!defstruct-with-alternate-metaclass
  23  interpreted-function
  24  ;; DEBUG-NAME and DEBUG-LAMBDA-LIST are initially a copies of the proper
  25  ;; ones, but is analogous to SIMPLE-FUN-NAME and ARGLIST in the sense that it
  26  ;; is they are there only for debugging, and do not affect behaviour of the
  27  ;; function -- so DEFMACRO can set them to more informative values.
  28  :slot-names (name debug-name lambda-list debug-lambda-list env
  29                    declarations documentation body source-location)
  30  :boa-constructor %make-interpreted-function
  31  :superclass-name function
  32  :metaclass-name static-classoid
  33  :metaclass-constructor make-static-classoid
  34  :dd-type funcallable-structure
  35  :runtime-type-checks-p nil)
  36
  37 ;; INTERPRETED-FUNCTION can not subclassed at runtime.
  38 ;; For one, DEFSTRUCT-WITH-ALTERNATE-METACLASS does not exist in the target,
  39 ;; and DEFSTRUCT would have to allow SB-KERNEL:FUNCALLABLE-STRUCTURE as
  40 ;; the :TYPE option to avoid mismatch, which it does not; nor is there any
  41 ;; way to allow it with DEFCLASS.  But, KLUDGE - loading the cross-compiler
  42 ;; seals the class before the run of the cross-compiler gets to doing the declaim
  43 ;; because 'target-misc' is cross-compiled before 'early-full-eval' is.
  44 (declaim (freeze-type interpreted-function))
  45
  46 (defun make-interpreted-function
  47       (&key name lambda-list env declarations documentation body source-location
  48             (debug-lambda-list lambda-list))
  49     (let ((function (%make-interpreted-function
  50                      name name lambda-list debug-lambda-list env
  51                      declarations documentation body source-location)))
  52       (setf (funcallable-instance-fun function)
  53             #'(lambda (&rest args)
  54                 (interpreted-apply function args)))
  55       function))
  56
  57 (defun interpreted-function-p (function)
  58   (typep function 'interpreted-function))
  59
  60 (defmethod print-object ((obj interpreted-function) stream)
  61   (print-unreadable-object (obj stream
  62                             :identity (not (interpreted-function-name obj)))
  63     (format stream "~A ~A" '#:interpreted-function
  64             (interpreted-function-name obj))))