shithub: mlisp

ref: e5cbdb2d92963fccf56980ea7a60ecc2b03204cf
dir: /lib.l/

(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
;;;

(defun countargs expr nargs
  nargs)

;;; compute greatest common divisor
(defun gcd (a b)
  (cond ((< a b) (gcd b a))
        ((eq b 0) a)
        (t (gcd b (- a b)))))


;;; differentiate expression exp w.r.t. x
(defun diff (exp x)
  (cond ((eq exp x) 1)
        ((atom exp) 0)
        ((eq (car exp) '+)
         (cons '+ (mapcar #'(lambda (j) (diff j x)) (cdr exp))))
        ((eq (car exp) '*)
         (cons '+
               (maplist
                 #'(lambda (J)
                     (cons '*
                           (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) '+) (simpsum (simplis (cdr exp))))
         ((eq (car exp) '*) (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 '+ const) nil))
    (return (cond ((null var) const)
                  ((eq const 0)
                   (cond ((null (cdr var)) (car var))
                         (t (cons '+ var))))
                  (t (cons '+ (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 '* const) nil))
    (return (cond ((null var) const)
                  ((eq const 0) 0)
                  ((eq const 1)
                   (cond ((null (cdr var)) (car var))
                         (t (cons '* var))))
                  (t (cons '* (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)))))