;;;; A partially-compiling interpreted EVAL

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

(in-package "SB!INTERPRETER")

;; +NONE+ is not accidentally acceptable - as would be NIL -
;; to functions accepting a SEQUENCE type.
(defconstant +none+ 0)
(deftype value-vector () `(or (eql ,+none+) simple-vector))

(defstruct (decl-scope (:conc-name)
                       (:constructor make-decl-scope (declarations %policy))
                       (:copier nil))
  (declarations (missing-arg) :type list :read-only t) ; in their original form
  ;; lexically disabled package locks (list of symbols).
  ;: Genesis doesn't know how to create shadowing symbols,
  ;; and LEXENV names its slot DISABLED-PACKAGE-LOCKS.
  (%disabled-package-locks :uncomputed)
  ;; lexical policy. Don't read directly. Use ENV-POLICY instead.
  (%policy nil :type sb!c::policy :read-only t)

  ;; A vector parallel to the bound symbols in a LET or LAMBDA frame.
  (binding-typechecks +none+ :type value-vector)
  ;; A vector of checks performed for lexical variables in containing scopes
  ;; on entry to this scope. Each check takes 2 cells to represent: a frame-ptr
  ;; and a CTYPE. The frame-ptr must refer to a strictly enclosing scope.
  ;; Only lexicals of enclosing scopes are checked - never specials
  ;; because those could signal an "unbound" error.
  ;; [Perhaps we could check a special var's type only when BOUNDP?]
  (extra-typechecks +none+ :type value-vector)

  ;; (VARIABLE . CTYPE) where VARIABLE is the binding cell - a cons - from
  ;; the contour which established the binding. Name ambiguities are thereby
  ;; resolved, since no direct reference is made to the symbol.
  ;; Restrictions are stored even when current policy precludes type checking,
  ;; so that a nested scope in a safer policy works as it should.
  (bound-var-type-restrictions nil :type list)
  ;; (SYMBOL . CTYPE) for free type restrictions.
  ;; Mostly unused, but sometimes used for symbol-macros,
  ;; if only to get some existing regression tests to pass.
  ;; Why this isn't an alist from binding cell to ctype is that declarations
  ;; can be made on things which have no binding cell, such as FTYPEs
  ;; and symbols which aren't even lexically declared free specials.
  (free-var-type-restrictions nil :type list))

;; Some limits of the number of levels of lexical nesting and number
;; of things that can be bound at one level.
;; For 32-bit machines, could replace these with a cons of two fixnums
;; if the limits prove to be inadequate.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant +frame-depth-bits+ 8)  ; 2^8 levels of lexical scope nesting
  (defconstant +frame-size-bits+ 21)) ; 2^21 {vars,funs,tags} per scope

;; Environment structure.
;; The interpreter never stack-allocates any ENV, for two reasons:
;; 1. it does not analyze which would environments could be dx
;; 2. heap allocation is better for being tail-recursive
;; But the code-walker using these structures *does* allocate its ENVs,
;; on the stack, so it needs an inlineable constructor.
(declaim (inline make-basic-env))
;; This is 6 words including the header. It could be shrunk to 4 words
;; with the compact-instance patch because the 'symbols' slot is strictly
;; a lexical (static) aspect that can be moved into the 'decl-scope' object.
(defstruct (basic-env ; 6 words incl. header word.
             (:conc-name env-)
             (:include sb!c::abstract-lexenv)
             (:constructor make-basic-env (parent payload symbols contour))
             ;(:predicate nil)
             (:copier nil))
  (parent nil :type (or null basic-env))
  (payload nil :read-only t) ; whatever the particular ENV subtype wants to put here
  ;; #(name1 ... nameN) or (#(name1 ... nameN) . fill-pointer)
  ;; All ENV subtypes except tagbody and block may have symbols,
  ;; either to create free specials or lexical bindings or both.
  ;; FIXME: NIL should be +NONE+ so that we don't have to distinguish it from CONS,
  ;; and then MUTABLE-P would be LISTP instead of CONSP for a faster test.
  (symbols nil :type (or null simple-vector
                               (cons (unsigned-byte #.+frame-size-bits+)
                                     simple-vector)))
  ;; The CONTOUR is the static aspect of the dynamic contour,
  ;; all the "compile-time-ish" stuff such as parsed bindings, canonical policy.
  ;; It's analogous to a LEXENV, but naming it LEXENV would be confusing
  ;; as heck, since ENV-LEXENV could be reasonably construed as the function
  ;; that returns a compiler LEXENV corresponding to this BASIC-ENV.
  (contour nil :type decl-scope :read-only t))
