Ignore:
Timestamp:
Aug 10, 2010, 8:28:43 PM (9 years ago)
Author:
gz
Message:

better decomp methods for builtin-call, typed-form, type-asserted-form, progn

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/qres/ccl/compiler/nx-basic.lisp

    r14164 r14165  
    832832                                   (< op num))
    833833                          (car (nth (- num op 1) *next-nx-operators*))))
    834                   (new (decomp-using-name (or name op) (cdr acode))))
     834                  (new (decomp-using-name (or name op) acode)))
    835835             (when *decomp-hook*
    836836               (funcall *decomp-hook* acode new))
     
    908908  (let ((op-var (car arglist))
    909909        (args-vars (cdr arglist))
    910         (op-decls nil)
    911         (args-var (gensym)))
     910        (acode-var (gensym))
     911        (op-decls nil))
     912    (when (eq op-var '&whole)
     913      (setq acode-var (pop args-vars))
     914      (setq op-var (pop args-vars)))
    912915    (multiple-value-bind (body decls) (parse-body body nil)
    913916    ;; Kludge but good enuff for here
     
    920923    `(progn
    921924       ,@(loop for name in (if (atom names) (list names) names)
    922            collect `(defmethod decomp-using-name ((,op-var (eql ',name)) ,args-var)
     925           collect `(defmethod decomp-using-name ((,op-var (eql ',name)) ,acode-var)
    923926                      (declare ,@op-decls)
    924                       (destructuring-bind ,args-vars ,args-var
     927                      (destructuring-bind ,args-vars (cdr ,acode-var)
    925928                        ,@decls
    926929                        ,@body)))))))
    927930
    928931;; Default method
    929 (defmethod decomp-using-name (op forms)
    930   `(,op ,@(decomp-formlist forms)))
     932(defmethod decomp-using-name (op acode)
     933  `(,op ,@(decomp-formlist (cdr acode))))
    931934
    932935;; not real op, kludge generated below for lambda-bind
     
    958961  `(,op ,(decomp-afunc afunc)))
    959962
    960 (defdecomp (progn prog1 multiple-value-prog1 or list %temp-list values) (op form-list)
     963(defun decomp-replace (from-form to-form)
     964  (let ((note (acode-note from-form)))
     965    (unless (and note (acode-note to-form))
     966      (when note
     967        (setf (acode-note to-form) note))
     968      t)))
     969           
     970(defdecomp progn (&whole form op form-list)
     971  (if (and *decomp-prettify*
     972           (null (cdr form-list))
     973           (decomp-replace form (car form-list)))
     974    (decomp-form (car form-list))
     975    `(,op ,@(decomp-formlist form-list))))
     976
     977(defdecomp (prog1 multiple-value-prog1 or list %temp-list values) (op form-list)
    961978  `(,op ,@(decomp-formlist form-list)))
    962979
     
    9841001    `(,op ,(decomp-form cc) ,@(decomp-formlist forms))))
    9851002
    986 (defdecomp (typed-form type-asserted-form) (op typespec form &optional check-p)
    987   `(,op ',typespec ,(decomp-form form) ,@(and check-p (list check-p))))
     1003(defdecomp (typed-form type-asserted-form) (&whole whole op typespec form &optional check-p)
     1004  (if (and *decomp-prettify*
     1005           (not check-p)
     1006           (decomp-replace whole form))
     1007    (decomp-form form)
     1008    `(,op ',typespec ,(decomp-form form) ,@(and check-p (list check-p)))))
    9881009
    9891010(defdecomp (%i+ %i-) (op form1 form2 &optional overflow-p)
     
    9931014  `(,op ,bits ,@(decomp-formlist forms)))
    9941015
    995 (defdecomp call (op fn arglist &optional spread-p)
     1016(defdecomp (builtin-call call) (op fn arglist &optional spread-p)
    9961017  (setq op (if spread-p 'apply 'funcall))
    9971018  `(,op ,(decomp-form fn) ,@(decomp-arglist arglist)))
Note: See TracChangeset for help on using the changeset viewer.