A question for DEFUN

• To: clisp-list@ma2s2.mathematik.uni-karlsruhe.de (CLISP list forum)
• Subject: A question for DEFUN
• From: Chun-Yu Lee <d791013@ce.ntu.edu.tw>
• Date: Mon, 9 May 94 17:24:38 MDT
• Mailer: Elm [revision: 70.85]

```Hello everybody,

I wrote a simple equation solver in LISP (see below). If a function
that uses the macro "equation" is defined before the file "eqsolver.lsp"
is loaded, everything seems all right. For example,

> (fmakunbound 'equation)
EQUATION
> (makunbound 'a)
A
> (makunbound 'b)
B
> (defun foo (a b) (equation a = b))
FOO
T
> (setq a nil b 5)
5
> (foo a b)
5 ;
A
> (foo nil b)
5 ;
A
> (equation a = b)
5 ;
A

However, when the function is defined after, then the result becomes as
follow:

T
> (makunbound 'a)
A
> (makunbound 'b)
B
> (defun foo (a b) (equation a = b))

*** - EVAL: variable B has no value     <--- Why does "defun" need to evaluate
1. Break>                                    the arguments of a function.

> (setq a nil b nil)
NIL
> (defun foo (a b) (equation a = b))
FOO             <--- O.K. But,
> (setq b 5)
5
> (foo a b)
NIL ;           <--- the output value is wrong.
A
> a
NIL
> b
5
> (equation a = b)
5 ;             <--- It's correct.
A

What's wrong with it?

Chun Yu Lee
e-mail: d791013@ce.ntu.edu.tw

=================File: EQSOLVER.LSP =============================

;;;
;;;  A Simple Equation Solver (SES)
;;;
;;; created: 18 April 1994
;;; updated: 29 April 1994
;;; author: Chun Yu Lee

; The following functions and macros serve to
; solve an equation that has less then one unknown and with three parts of
; expressions, the LHS, relationship, and RHS. No more than one unknown
; (variable) can be appeared in the LHS or RHS of the equation.
; A symbol name which is unbound or nil in the equation is an unknown.
; The operators or predicates used in expressions must be complyed with
; those specified in the exchanging rules depicted in global variable
; *X-operators*. However, any valid LISP forms other than specified in
; *X-operators* can be used in the expression which is on the opposite
; side to the one the unknown is stayed.
;
; The macro "symbol-equation" returns three values: the solved expression
; in symbolic form, the unknown variable, and the operater. But there is
; only one value will be returned, when the unknown cannot be found, to be
; true (T) or false (NIL) according to the evaluation of the equation.
;
; The macro "equation" returns two values: the evaluated result of solved
; equation and the unknown found. While the macro "nequation" is a
; destructive version of "equation" and returns only the evaluated result.
; The side effect of "nequation" is that the unbound (or nilled) variable
; will be bound to the result.
;
; SES can solve equations like followings:
;
;         a * b = c + 4  -- (1),
; or      b*x^2 + c = d  -- (2).
;
; Eqn. (1) can be called as:
;
;
; > (setq a 3 b 4)
; 4
; > (symbol-equation (* a b) = (+ c 4))
; (- (* A B) 4) ;
; C ;
; =
; > (equation (* a b) = (+ c 4))
; 8 ;
; C
; > (boundp 'c)
; NIL
; > (nequation (* a b) = (+ c 4))
; 8
; > c
; 8
;
; In the similar way, eqn. (2) can be called as:
;
; > (setq x nil b 3 c 4 d 5)
; 5
; > (symbol-equation (+ (* b (expt x 2)) c) = d)
; (EXPT (/ (- D C) B) (/ 1 2)) ;
; X ;
; =
; >
;

;;; Begining of the equation solver.
(defvar *X-operators*
'((+ . -) (* . /) (expt . expt) (exp . log)
(sin . asin) (cos . acos) (tan . atan)
(sinh . asinh) (cosh . acosh) (tanh . atanh)
) )

(defmacro equation (&body eqn)
(multiple-value-bind (value var) (eval (cons 'symbol-equation eqn))
`(values ,(eval value) ',var)
) )

(defmacro nequation (&body eqn)  ;destructive version
(multiple-value-bind (value var) (eval (cons 'symbol-equation eqn))
(if var `(setq ,var ,(eval value)) value)
) )

(defmacro symbol-equation (lhs op rhs)
(let* ((args (explode-list (list lhs rhs)))
(var
(nth
(or (position-if-not
#'(lambda (x)
(or (numberp x) (boundp x) (fboundp x)))
args)
(position nil
(mapcar
#'(lambda (x)
(if (or (numberp x) (fboundp x)) x (eval x)))
args)
)
(return-from symbol-equation `(,op ,lhs ,rhs))
)
args)))
`(values ',(solve-linear-eqn lhs rhs var) ',var ',op)
) )

(defun solve-linear-eqn (lhs rhs var)
(if (or (and (atom rhs) (equal rhs var))
(and (consp rhs) (member var (explode-list rhs))))
(solve-linear-eqn-r rhs lhs var)
(solve-linear-eqn-r lhs rhs var)
) )

(defun solve-linear-eqn-r (lhs rhs var)
(if (atom lhs) (if (equal lhs var) rhs nil)
(let ((op (pop lhs)) (result nil) lhs1)
(push (or (cdr (assoc op *X-operators*))
(car (rassoc op *X-operators*))) result)
(push rhs result)
(dolist (ivar lhs)
(if (or (and (atom ivar) (equal ivar var))
(and (consp ivar) (member var (explode-list ivar))))
(setq lhs1 ivar)
(push ivar result))
)
(solve-linear-eqn-r lhs1 (reverse result) var)
) ) )

(defun explode-list (lst)
(if (null lst) nil
(if (atom lst) (list lst)
(append (explode-list (car lst)) (explode-list (cdr lst)))
) ) )

;;; End of equation solver.
```