sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

boole: move compiler macro to cmpnum

Browse source
This commit is contained in:
Daniel Kochmański 2017-01-28 17:39:08 +01:00 • committed by Daniel Kochmanski
parent 6ffa84af14
commit 851dc899eb
2 changed files with 26 additions and 39 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
src/cmp/cmpfun.lsp
View file

@ -46,42 +46,3 @@
(c1apply (list* (second fun) arguments)))
(t
(default-apply fun arguments))))))
;;----------------------------------------------------------------------
;; We transform BOOLE into the individual operations, which have
;; inliners
;;
(define-compiler-macro boole (&whole form op-code op1 op2)
(or (and (constantp op-code *cmp-env*)
(case (ext:constant-form-value op-code *cmp-env*)
(#. boole-clr `(progn ,op1 ,op2 0))
(#. boole-set `(progn ,op1 ,op2 -1))
(#. boole-1 `(prog1 ,op1 ,op2))
(#. boole-2 `(progn ,op1 ,op2))
(#. boole-c1 `(prog1 (lognot ,op1) ,op2))
(#. boole-c2 `(progn ,op1 (lognot ,op2)))
(#. boole-and `(logand ,op1 ,op2))
(#. boole-ior `(logior ,op1 ,op2))
(#. boole-xor `(logxor ,op1 ,op2))
(#. boole-eqv `(logeqv ,op1 ,op2))
(#. boole-nand `(lognand ,op1 ,op2))
(#. boole-nor `(lognor ,op1 ,op2))
(#. boole-andc1 `(logandc1 ,op1 ,op2))
(#. boole-andc2 `(logandc2 ,op1 ,op2))
(#. boole-orc1 `(logorc1 ,op1 ,op2))
(#. boole-orc2 `(logorc2 ,op1 ,op2))))
form))
;----------------------------------------------------------------------
;; Return the most particular type we can EASILY obtain from x.
(defun result-type (x)
(cond ((symbolp x)
(c1form-primary-type (c1expr x)))
((constantp x)
(type-of x))
((and (consp x) (eq (car x) 'the))
(second x))
(t t)))

26
src/cmp/cmpnum.lsp
View file

@ -15,6 +15,32 @@
(in-package "COMPILER")
;;----------------------------------------------------------------------
;; We transform BOOLE into the individual operations, which have
;; inliners
;;
(define-compiler-macro boole (&whole form op-code op1 op2)
(or (and (constantp op-code *cmp-env*)
(case (ext:constant-form-value op-code *cmp-env*)
(#. boole-clr `(progn ,op1 ,op2 0))
(#. boole-set `(progn ,op1 ,op2 -1))
(#. boole-1 `(prog1 ,op1 ,op2))
(#. boole-2 `(progn ,op1 ,op2))
(#. boole-c1 `(prog1 (lognot ,op1) ,op2))
(#. boole-c2 `(progn ,op1 (lognot ,op2)))
(#. boole-and `(logand ,op1 ,op2))
(#. boole-ior `(logior ,op1 ,op2))
(#. boole-xor `(logxor ,op1 ,op2))
(#. boole-eqv `(logeqv ,op1 ,op2))
(#. boole-nand `(lognand ,op1 ,op2))
(#. boole-nor `(lognor ,op1 ,op2))
(#. boole-andc1 `(logandc1 ,op1 ,op2))
(#. boole-andc2 `(logandc2 ,op1 ,op2))
(#. boole-orc1 `(logorc1 ,op1 ,op2))
(#. boole-orc2 `(logorc2 ,op1 ,op2))))
form))
(defun simplify-arithmetic (operator args whole)
(if (every #'numberp args)
(apply operator args)