ref: 3e8336c0ea2e6f70eb0b277f3d0927b114d0709c
dir: /lib.l/
;;; taken from MACLISP
(defprop defun
(lambda (l)
(cond ((and (caddr l)
(atom (caddr l)))
(list 'defprop (cadr l)
(cons 'lambda (cons (cadddr l) (cddddr l)))
(caddr l)))
(t (list 'defprop (cadr l)
(cons 'lambda (cons (caddr l) (cdddr l)))
'expr))))
macro)
;; LET
(defun let-vars (l) (maplist #'(lambda (x) (caar x)) (cadr l)))
(defun let-vals (l) (maplist #'(lambda (x) (cadar x)) (cadr l)))
(defun let macro (l)
(cons (cons 'lambda (cons (let-vars l) (cddr l)))
(let-vals l)))
;;;
;;; examples
;;;
;;; compute greatest common divisor
(defun gcd (a b)
(cond ((lessp a b) (gcd b a))
((eq b 0) a)
(t (gcd b (difference a b)))))
;;; differentiate expression exp w.r.t. x
(defun diff (exp x)
(cond ((eq exp x) 1)
((atom exp) 0)
((eq (car exp) 'plus)
(cons 'plus (mapcar #'(lambda (j) (diff j x)) (cdr exp))))
((eq (car exp) 'times)
(cons 'plus
(maplist
#'(lambda (J)
(cons 'times
(maplist
#'(lambda (K)
(cond ((equal J K) (diff (car K) x))
(t (car K))))
(cdr exp))))
(cdr exp))))
(t 'invalid)))
;;; simplify mathematical expression
(defun simplify (exp)
(cond ((atom exp) exp)
((eq (car exp) 'plus) (simpsum (simplis (cdr exp))))
((eq (car exp) 'times) (simpprod (simplis (cdr exp))))
(t exp)))
;;; simplify a list of expressions
(defun simplis (lst)
(mapcar #'(lambda (l) (simplify l)) lst))
;;; simplify the terms of a sum
(defun simpsum (terms)
(prog (sep const var)
(setq sep (separate terms nil nil))
(setq const (car sep))
(setq var (cadr sep))
(setq const (eval (cons 'plus const) nil))
(return (cond ((null var) const)
((eq const 0)
(cond ((null (cdr var)) (car var))
(t (cons 'plus var))))
(t (cons 'plus (cons const var)))))))
;;; simplify the terms of a product
(defun simpprod (terms)
(prog (sep const var)
(setq sep (separate terms nil nil))
(setq const (car sep))
(setq var (cadr sep))
(setq const (eval (cons 'times const) nil))
(return (cond ((null var) const)
((eq const 0) 0)
((eq const 1)
(cond ((null (cdr var)) (car var))
(t (cons 'times var))))
(t (cons 'times (cons const var)))))))
;;; separate constants from variables in a list
(defun separate (lst const var)
(cond ((null lst)
(list const var))
((numberp (car lst))
(separate (cdr lst) (cons (car lst) const) var))
(t (separate (cdr lst) const (cons (car lst) var)))))