Changeset 14793


Ignore:
Timestamp:
May 11, 2011, 11:03:24 AM (8 years ago)
Author:
gb
Message:

Add a new "strict-structure-typechecking" hook to compiler-policy objects.
(To simplify bootstrapping, this was added to the "misc" slot, which is
now a plist.) The default value is a function which returns true if either
DEBUG or SAFETY is >= 2 or if either of these things is > SPEED.

Add an NX-STRICT-STRUCTURE-TYPECHECKING interface to it.

Add a new STRUCTURE-TYPECHECK macro, which uses the new policy hook to
decide whether or not to do more extensive structure typechecking,

Change DEFSTRUCT-REF-TRANSFORM to use STRUCTURE-TYPECHECK instead of
TYPECHECK; other uses of TYPECHECK - including the actual accessor
functions - are unchanged.

Location:
trunk/source
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx-basic.lisp

    r14703 r14793  
    185185                   (declare (ignore var val env))
    186186                   t)
    187                nil           ; extensions
     187               `(:strict-structure-typechecking
     188                 ,(lambda (env)
     189                   (let* ((debug (debug-optimize-quantity env))
     190                          (safety (safety-optimize-quantity env))
     191                          (speed (speed-optimize-quantity env)))
     192                     (declare (fixnum debug safety speed))
     193                     (or (>= debug 2)
     194                         (>= safety 2)
     195                         (> debug speed)
     196                         (> safety speed))))) ; extensions
    188197               )))
    189198  (defun new-compiler-policy (&key (allow-tail-recursion-elimination nil atr-p)
     
    196205                                   (force-boundp-checks nil fb-p)
    197206                                   (allow-constant-substitution nil acs-p)
    198                                    (declarations-typecheck nil dt-p))
     207                                   (declarations-typecheck nil dt-p)
     208                                   (strict-structure-typechecking nil sst-p))
    199209    (let ((p (copy-uvector policy)))
    200210      (if atr-p (setf (policy.allow-tail-recursion-elimination p) allow-tail-recursion-elimination))
     
    208218      (if acs-p (setf (policy.allow-constant-substitution p) allow-constant-substitution))
    209219      (if dt-p (setf (policy.declarations-typecheck p) declarations-typecheck))
     220      (if sst-p (setf (getf (policy.misc p) :strict-structure-typechecking) strict-structure-typechecking))
    210221      p))
    211222  (defun %default-compiler-policy () policy))
  • trunk/source/compiler/nx0.lisp

    r14703 r14793  
    333333  (nx-apply-env-hook policy.declarations-typecheck env))
    334334
     335(defun nx-strict-structure-typechecking (env)
     336  (let* ((hook (getf (policy.misc *nx-current-compiler-policy*) :strict-structure-typechecking)))
     337    (when hook
     338      (if (functionp hook)
     339        (funcall hook env)
     340        t))))
    335341
    336342#-bccl
  • trunk/source/lib/defstruct.lisp

    r14505 r14793  
    277277                   `(nth ,offset ,@args))
    278278                  ((eq ref $defstruct-struct)
    279                    `(struct-ref (typecheck ,@args ,(structref-info-struct structref-info)) ,offset))
     279                   `(struct-ref (structure-typecheck ,@args ,(structref-info-struct structref-info)) ,offset))
    280280                  ((eq ref target::subtag-simple-vector)
    281281                   `(svref ,@args ,offset))
  • trunk/source/lib/macros.lisp

    r14769 r14793  
    28342834         `(the ,typespec ,object))
    28352835        (t
    2836          `(require-type ,object ',(nx1-typespec-for-typep typespec env
     2836        `(require-type ,object ',(nx1-typespec-for-typep typespec env
    28372837                                                          :whine nil)))))
     2838
     2839(defmacro structure-typecheck (struct typespec &environment env)
     2840  (if (nx-strict-structure-typechecking env)
     2841    `(require-type ,struct ',(nx1-typespec-for-typep typespec env
     2842                                                          :whine nil))
     2843    `(the ,typespec ,struct)))
     2844     
    28382845
    28392846(defmacro with-hash-table-iterator ((mname hash-table) &body body)
Note: See TracChangeset for help on using the changeset viewer.