LISP的表达式求值

表达式一般来说有三种：前缀表达式、中缀表达式、后缀表达式，其中后缀表达式又叫做逆波兰表达式。中缀表达式是最符合人们思维方式的一种表达式，顾名思义，就是操作符在操作数的中间。而前缀表达式和后缀表达式中操作符分别在操作数的前面和操作数的后面。在写表达式，我们一般用中缀表达式，譬如 1+2*3-4/5。并且按照操作符的优先级进行计算。
然而LISP语言是一种前缀表达式，为了把表达式转为LISP函数或者求值，需要进行翻译，添加大量的括号和修改函数的顺序。
这个程序的目的就是使得这一工作变简单。
当然，CAD里面本身也有几种种方式能完成这个，但它们的优缺点容我后面讨论。
程序借鉴了飞诗的一些代码，在此深表感谢。
程序的核心代码如下：

;;;=============================================================
;;; 函数目的: 字符表达式转为函数，主要用于多次调用时提升速度
;;; 输入: expr--字符表达式,sFunc--函数名,sArg--参数符号列表
;;; 输出: 定义函数，并返回其名
;;; 例子: (CAL:Expr2Func "sin(x)+20*y" 'test '(x y))
;;; 结果: 定义了一个名为test的函数，参数符号为x y
;;; 注意: 除法区分整数和浮点数，譬如"2/3"和"2/3.0"结果不同；
;;;       可用自定义函数，前提是首先要加载；
;;;       可用科学计算法，但应满足LISP中的语法。建议用括号；
;;;       表达式应满足语法要求，小数和乘号不能按省略写法。
;;;=============================================================
(defun CAL:Expr2Func (expr sFunc sArgs / lst)
  (setq lst (CAL:Separate expr))				;先按照括号空格和运算符分离字符
  (setq lst (CAL:Operators lst '((^ . expt)) ()))	        ;乘方（幂）最优先
  (setq lst (CAL:Operators lst '((* . *) (/ . /) (% . rem)) ()));其次乘除和求模运算
  (setq lst (CAL:Operators lst '((+ . +) (- . -)) ()))		;最后处理加减法运算
  (defun-q-list-set sFunc (cons sArgs lst))			;表达成函数
  sFunc
)
;;;=============================================================
;;; 函数目的: 字符表达式求值
;;; 输入: expr--字符表达式
;;; 输出: 计算表达式的结果
;;; 例子: (CAL:Expr2Value "sin(1)+20*2")
;;; 结果: 40.8415
;;;=============================================================
(defun CAL:Expr2Value (expr / lst)
  (setq lst (CAL:Separate expr))				;先按照括号空格和运算符分离字符
  (setq lst (CAL:Operators lst '((^ . expt)) ()))	        ;乘方（幂）最优先
  (setq lst (CAL:Operators lst '((* . *) (/ . /) (% . rem)) ()));其次乘除和求模运算
  (setq lst (CAL:Operators lst '((+ . +) (- . -)) ()))		;最后处理加减法运算
  (eval (car lst))						;求值
)
;;;=============================================================
;;; 函数目的: 先分离出函数和+-*/%^运算符，其余均视作变量或数值，
;;; 并简单检查括号匹配。
;;; 输入: expr--字符表达式
;;; 输出: 函数（包括运算符）和变量及数值的列表
;;;=============================================================
(defun CAL:Separate (expr / CHAR FUNS LASTCHAR LST Temp LBRACKET RBRACKET next)
  (setq expr (vl-string-translate "{[]}\t\n," "(())   " expr))  ;替换{[]}\t\n,字符
  (setq expr (strcase expr t))					;全部转为小写
  (setq funs '("+" "-" "*" "/" "^" "%" ))		        ;按照基本运算符分割字符
  (setq Temp "")
  (setq lst "(")
  (setq Lbracket 0)						;左括号计数器
  (setq Rbracket 0)						;右括号计数器
  (while (/= expr "")
    (setq char (substr expr 1 1))                               ;字符串的第一个字符
    (setq next (substr expr 2 1))				;字符串的第二个字符
    (if	(or (= char "(")
	    (= char ")")					;括号一定是分隔符
	    (and (= char " ") (/= next "(") (/= next " "))      ;如果不是连续的空格符
	    (and (member char funs)				;根据运算符进行分割
	         (not (CAL:isScientific temp lastchar char))    ;忽略科学计数法
	    )
	)
      (progn
	(if (CAL:IsFunction (Read temp))			;如果为普通函数
	  (setq	lst	 (strcat lst "(" Temp " " )		;则把括号移至函数符号前
		Lbracket (1+ Lbracket)				;左括号计数器加1
	  )
	  (progn
	    (and (= char "(") (setq Lbracket (1+ Lbracket)))    ;左括号计数器加1
	    (and (= char ")") (setq Rbracket (1+ Rbracket)))	;右括号计数器加1
	    (setq lst (strcat lst Temp " " char " "))
	  )
	)
	(setq Temp "")                                          ;如果是函数或者括号空格之类，则在此处重新开始
      )
      (setq Temp (strcat Temp char))                            ;否则连取这个字符
    )
    (setq expr (substr expr 2))					;字符串剩下的字符
    (setq lastchar char)
  )
  (if (/= Lbracket Rbracket)					;如果括号不平衡
    (alert "括号不匹配(Mismatched Brackets)!")			;警告信息
    (read (strcat lst Temp ")"))				;否则转为表
  )
)
;;;=============================================================
;;; 函数目的: 分析+-*/%^运算符，并组合到表中
;;; 输入: lst-已分割的表,funs-待分析的运算符,Recursive-是否递归
;;; 输出: 函数（包括运算符）和变量及数值的列表
;;;=============================================================
(defun CAL:Operators (lst funs Recursive / fun L n)
  (foreach a lst
    (if	(listp a)
      (setq a (CAL:Operators a funs T))				;如果元素为表，则递归进去
    )
    (if (= (type a) 'INT)
      (setq a (float a))
    )
    (if	(setq fun (cdr (assoc (car L) funs)))                   ;前一个符号为+-*/%^运算符
      (if (or (null (setq n (cadr L)))                          ;前前一个符号为空
	      (and (VL-SYMBOLP n) (CAL:IsFunction n))           ;或者是函数符号
	  )
	(setq L (cons (list fun a) (cdr L)))                    ;无须交换位置
	(setq L (cons (list fun n a) (cddr L)))	                ;交换运算符和操作数位置
      )
      (setq L (cons a L))                                       ;其他的不做改变
    )
  )
  (setq n (car L))
  (if (and Recursive (not (cadr L)) (or (listp n) (numberp n))) ;如果是递归的,而且只有一个元素，且这个元素为表或者数字
    n								;那么就只取这个元素，以防止多余括号出现
    (reverse L)							;cons运算后的反转表列
  )
)
;;;=============================================================
;;; 函数目的: 判断一个符号是不是普通函数（内部函数或自定义函数）
;;;=============================================================
(defun CAL:IsFunction (n / s)
  (setq s (type (eval n)))
  (and (or (= s 'SUBR) (= s 'USUBR)) (not (member n '(+ - * /))))
)
;;;=============================================================
;;; 函数目的: 检测一个字符串是否是科学计数法(是否有更好方法?)
;;;=============================================================
(defun CAL:isScientific (temp lastchar char)
  (and (= lastchar "e") (numberp (read (strcat temp char "0"))))
)
;;;=============================================================
;;; 函数目的: 检查函数表达式转函数的结果
;;; 输入: lst,用cal:expr2func求得的表
;;; 输出: 如果表达式里有非参数且未赋值的变量符号则返回nil, 否则T
;;; 例子: (CAL:CheckFunc (CAL:Expr2func "sin(a)+20*2" 'fx '(x)))
;;; 结果: nil
;;;=============================================================
(defun CAL:CheckFunc (lst / isOK CAL:TempSym Args)
  (setq IsOK T)
  (setq Args (car lst))
  (while (setq lst (cdr lst))
    (setq CAL:TempSym (car lst))                                ;对表中的每个元素
    (if	(listp CAL:TempSym)					;如果这个元素为表
      (if CAL:TempSym
	(setq IsOk (CAL:CheckFunc (cons Args CAL:TempSym)))	;且不为空则递归进去
	(setq IsOk nil)                                         ;否则检测结果为假
      )
      (if (and (vl-symbolp CAL:TempSym)                         ;如果是一个符号
	       (not (member CAL:TempSym Args))			;且不为参数表中的符号
	       (not (vl-symbol-value CAL:TempSym))              ;且未赋值
	  )
	(setq IsOk nil)						;则检测结果为假
      )
    )
    (if	(null IsOK)
      (setq lst nil)
    )
  )
  IsOK
)