Ignore:
Timestamp:
Apr 5, 2011, 5:28:25 PM (9 years ago)
Author:
gb
Message:

Still a work in progress, but ... in progress, again.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/acode-rewrite.lisp

    r14421 r14705  
    2727;;; Rewrite acode trees.
    2828
    29 ;(next-nx-defops)
    3029(defvar *acode-rewrite-functions* nil)
    3130(let* ((newsize (%i+ (next-nx-num-ops) 10))
     
    182181      (setf (car type-cons) intersection))))
    183182
     183
     184#||
     185(defun acode-set-immediate-type (type-cons acode-expr)
     186  (let* ((type
     187          (cond ((nx-null acode-expr) 'null)
     188                ((nx-t acode-expr) '(eql t))
     189                ((
     190||#
    184191         
    185192   
     
    291298
    292299                   
     300(def-acode-rewrite acode-rewrite-%gvector %gvector type-cons (arglist)
     301  (let* ((all-args (append (car arglist) (reverse (cadr arglist)))))
     302    (dolist (arg all-args)
     303      (rewrite-acode-form arg t))
     304    ;; Could try to map constant subtag to type here
     305    ))
     306
     307(def-acode-rewrite acode-rewrite-char-code (%char-code char-code) type-cons (&whole w c)
     308  (rewrite-acode-form c t)
     309  (let* ((char (acode-constant-p c)))
     310    (when char
     311      (let* ((code (char-code char)))
     312        (setf (car w) (%nx1-operator fixnum)
     313              (cadr w) code
     314              (cddr w) nil)))
     315    (acode-type-merge type-cons 'valid-char-code)))
     316
     317(def-acode-rewrite acode-rewrite-%ilogior2 %ilogior2 type-cons (&whole w x y)
     318  (acode-constant-fold-numeric-binop type-cons w x y 'logior)
     319  (acode-type-merge type-cons `(or ,(acode-form-type x *acode-rewrite-trust-declarations*) ,(acode-form-type y *acode-rewrite-trust-declarations*))))
     320
     321(def-acode-rewrite acode-rewrite-%ilogand2 %ilogand2 type-cons (&whole w x y)
     322  (acode-constant-fold-numeric-binop type-cons w x y 'logand)
     323  (acode-type-merge type-cons `(and ,(acode-form-type x *acode-rewrite-trust-declarations*) ,(acode-form-type y *acode-rewrite-trust-declarations*))))
     324
     325(def-acode-rewrite acode-rewrite-%ilogxor %ilogxor2 type-cons (&whole w x y)
     326  (acode-constant-fold-numeric-binop type-cons w x y 'logxor))
     327   
     328(def-acode-rewrite acode-rewrite-%ineg %ineg type-cons (&whole w x)
     329  (rewrite-acode-form x 'fixnum)
     330  (let* ((val (acode-fixnum-form-p x))
     331         (negated (if val (- val))))
     332    (if negated
     333      (setf (acode-operator w) (if (typep negated *nx-target-fixnum-type*)
     334                                 (%nx1-operator fixnum)
     335                                 (%nx1-operator immediate))
     336            (cadr w) negated
     337            (cddr w) nil))))
     338
     339           
     340     
     341   
     342   
    293343       
    294344       
Note: See TracChangeset for help on using the changeset viewer.