cmpnum.lsp 1.55 KB
Newer Older
jgarcia's avatar
jgarcia committed
1
2
;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
;;;; CMPNUM -- Optimizer for numerical expressions.

;;;;  Copyright (c) 2005, Juan Jose Garcia Ripoll
;;;;
;;;;    ECoLisp is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU Library General Public
;;;;    License as published by the Free Software Foundation; either
;;;;    version 2 of the License, or (at your option) any later version.
;;;;
;;;;    See file '../Copyright' for full details.

(in-package "COMPILER")

(defun simplify-arithmetic (operator args whole)
  (let ((l (length args)))
    (cond ((every #'numberp args)
	   (apply operator args))
          ((> l 2)
	   (simplify-arithmetic
	    operator
	    (list* (simplify-arithmetic operator (list (first args) (second args)) nil)
		   (cddr args))
	    nil))
	  ((= l 2)
	   (or whole (list* operator args)))
	  ((= l 1)
	   (if (or (eq operator '*) (eq operator '+))
	       (first args)
	       (or whole (list* operator args))))
	  ((eq operator '*)
	   1)
	  ((eq operator '+)
	   0)
	  (t
	   (error 'simple-program-error :format-error "Wrong number of arguments for operator ~a in ~a"
38
		  :format-arguments (list operators (or whole (list* operator args))))))))
39
40
41
42
43
44
45
46
47
48
49
50
51

(define-compiler-macro * (&whole all &rest args)
  (simplify-arithmetic '* args all))

(define-compiler-macro + (&whole all &rest args)
  (simplify-arithmetic '+ args all))

(define-compiler-macro / (&whole all &rest args)
  (simplify-arithmetic '/ args all))

(define-compiler-macro - (&whole all &rest args)
  (simplify-arithmetic '- args all))