Changeset 11819


Ignore:
Timestamp:
Mar 17, 2009, 4:46:31 PM (10 years ago)
Author:
gz
Message:

Rename nx-the-typechecks to nx-declarations-typecheck, and compile typechecking code for setq and and initforms if true.

Location:
branches/working-0711/ccl
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r11701 r11819  
    223223(declaim (fixnum *x862-vstack* *x862-cstack*))
    224224
    225  
     225
    226226
    227227
     
    996996            (values n constant-alist))
    997997        (declare (list things)
    998                  (fixnum n regno))
     998                 (fixnum n #|regno|#))
    999999        (let* ((thing (car things)))
    10001000          (if (or (memq thing fcells)
     
    14611461
    14621462(defun x862-set-vstack (new)
    1463   (setq *x862-vstack* new))
     1463  (setq *x862-vstack* (or new 0)))
    14641464
    14651465
     
    59945994                               (tail parsed-ops))
    59955995                          (declare (dynamic-extent parsed-ops)
    5996                                    (cons parsed-ops tail))
     5996                                   (list parsed-ops tail))
    59975997                          (dolist (op op-vals (apply (cadr f) parsed-ops))
    59985998                            (setq tail (cdr (rplaca tail (parse-operand-form op t)))))))
     
    63076307            (x862-save-nvrs seg pregs)
    63086308            (dolist (pair reglocatives)
    6309               (declare (cons pair))
    6310               (let* ((constant (car pair))
     6309              (let* ((pair pair)
     6310                     (constant (car pair))
    63116311                     (reg (cdr pair)))
    6312                 (declare (cons constant))
     6312                (declare (cons pair constant))
    63136313                (rplacd constant reg)
    63146314                (! ref-constant reg (x86-immediate-label (car constant))))))
     
    63436343                  (arg-reg-num (pop arg-reg-numbers) (pop arg-reg-numbers)))
    63446344                 ((null vars))
    6345               (declare (list vars) (fixnum arg-reg-num))
     6345              (declare (list vars))
    63466346              (let* ((var (car vars)))
    63476347                (when var
  • branches/working-0711/ccl/compiler/nx-basic.lisp

    r11807 r11819  
    139139                   (let* ((safety (safety-optimize-quantity env)))
    140140                     (or (eq safety 3)
    141                          (> safety (speed-optimize-quantity env)))))          ;the-typechecks
     141                         (> safety (speed-optimize-quantity env)))))          ;declarations-typecheck
    142142               #'(lambda (env)
    143143                   (neq (debug-optimize-quantity env) 3))   ; inline-self-calls
     
    164164                                   (force-boundp-checks nil fb-p)
    165165                                   (allow-constant-substitution nil acs-p)
    166                                    (the-typechecks nil tt-p))
     166                                   (declarations-typecheck nil dt-p))
    167167    (let ((p (copy-uvector policy)))
    168168      (if atr-p (setf (policy.allow-tail-recursion-elimination p) allow-tail-recursion-elimination))
     
    175175      (if fb-p (setf (policy.force-boundp-checks p) force-boundp-checks))
    176176      (if acs-p (setf (policy.allow-constant-substitution p) allow-constant-substitution))
    177       (if tt-p (setf (policy.the-typechecks p) the-typechecks))
     177      (if dt-p (setf (policy.declarations-typecheck p) declarations-typecheck))
    178178      p))
    179179  (defun %default-compiler-policy () policy))
  • branches/working-0711/ccl/compiler/nx0.lisp

    r11807 r11819  
    320320  (nx-apply-env-hook policy.allow-constant-substitution symbol value env))
    321321
    322 (defun nx-the-typechecks (env)
    323   (nx-apply-env-hook policy.the-typechecks env))
     322#-BOOTSTRAPPED
     323(eval-when (compile)
     324  (unless (boundp 'policy.declarations-typecheck)
     325    (load "ccl:library;lispequ.lisp")))
     326
     327(defun nx-declarations-typecheck (env)
     328  (nx-apply-env-hook policy.declarations-typecheck env))
     329
    324330
    325331#-bccl
     
    394400(defun nx1-typed-var-initform (pending sym form &optional (env *nx-lexical-environment*))
    395401  (let* ((type t)
     402         (form-type (dolist (decl (pending-declarations-vdecls pending)  type)
     403                      (when (and (eq (car decl) sym) (eq (cadr decl) 'type))
     404                        (setq type (nx1-type-intersect sym (nx-target-type type) (cddr decl))))))
    396405         (*nx-form-type* (if (nx-trust-declarations env)
    397                            (dolist (decl (pending-declarations-vdecls pending)  type)
    398                             (when (and (eq (car decl) sym) (eq (cadr decl) 'type))
    399                               (setq type (nx1-type-intersect sym (nx-target-type type) (cddr decl)))))
     406                           form-type
    400407                           t)))
     408    (when (nx-declarations-typecheck env)
     409      (setq form `(the ,form-type ,form)))
    401410    (nx1-typed-form form env)))
    402411
     
    19061915      (if (eq type t)
    19071916        form
    1908         (list (%nx1-operator typed-form) type form)))))
     1917        (make-acode (%nx1-operator typed-form) type form)))))
    19091918
    19101919(defvar *format-arg-functions* '((format . 1) (format-to-string . 1) (error . 0) (warn . 0)
  • branches/working-0711/ccl/compiler/nx1.lisp

    r11701 r11819  
    4444     typespec
    4545     (nx1-transformed-form transformed env)
    46      (nx-the-typechecks env))))
     46     (nx-declarations-typecheck env))))
    4747
    4848(defnx1 nx1-struct-ref struct-ref (&whole whole structure offset)
     
    10301030                          (declared-type (nx-declared-type sym)))
    10311031                     (let ((*nx-form-type* declared-type))
     1032                       (when (nx-declarations-typecheck env)
     1033                         (setq val `(the ,declared-type ,val)))
    10321034                       (setq val (nx1-typed-form val env)))
    10331035                     (if (and info (neq info :special))
  • branches/working-0711/ccl/library/lispequ.lisp

    r11598 r11819  
    15591559  policy.open-code-inline
    15601560  policy.inhibit-safety-checking
    1561   policy.the-typechecks
     1561  policy.declarations-typecheck
    15621562  policy.inline-self-calls
    15631563  policy.allow-transforms
Note: See TracChangeset for help on using the changeset viewer.