share/misc/foptim.lisp

   1 ;;; -*- LISP -*-
   2 ;;; Auxiliary routines for OPTIMIZE'ing
   3 ;;;
   4 ;;; Created by KMP 8:23pm  Friday, 23 February 1979
   5
   6 ;;; Syntax is:
   7 ;;;
   8 ;;;  FOPTIMIZE(A,B,[C,D],[Q]...);
   9 ;;;
  10 ;;; Elements of the arg list with different forms do different things:
  11 ;;;
  12 ;;; [1] If an arg is an ATOM, then its function will be redefined with the
  13 ;;;     optimized form.
  14 ;;;
  15 ;;; [2] If the arg is a 1-length List, then the function named in the list
  16 ;;;     will be optimized, and the optimized LAMBDA will be returned.
  17 ;;;
  18 ;;; [3] If the arg is a 2-length list, then the function named by its
  19 ;;;     first arg will be optimized and given the name of the second
  20 ;;;     element of the list.
  21 ;;;
  22
  23 ;;; $FOPTIMIZE is the name of the driver that gets called from Macsyma
  24
  25 (DEFUN $FOPTIMIZE FEXPR (X) (CONS (NCONS 'MLIST) (MAPCAR 'FOPTIMIZE X)))
  26
  27 ;;; FOPTIMIZE is the function that does the work.
  28 ;;;  It does type checking but will only do interesting things with
  29 ;;;  ATOMS or MLIST's one or two long.
  30
  31 (DEFUN FOPTIMIZE (X)
  32        (COND ((SYMBOLP X)
  33               (*CATCH 'FOPTIMIZE-NO-MEXPR-DEFINITION
  34                       (PROGN (MPUTPROP X
  35                                        (FOPTIMIZE-AUX (MGET X 'MEXPR) X)
  36                                        'MEXPR)
  37                              X)))
  38              ((OR (ATOM X)
  39                   (< (LENGTH X) 2.)
  40                   (> (LENGTH X) 3.)
  41                   (NOT (EQ (CAAR X) 'MLIST))
  42                   (NOT (SYMBOLP (CADR X)))
  43                   (NOT (SYMBOLP (CADDR X))))
  44               (fresh-line)
  45               (PRINC '|;FOPTIMIZE called on an illegal form.| TYO)
  46               (ERR))
  47              (T
  48               (LET (((IN OUT) (CDR X)) (DEF ()))
  49                    (*CATCH 'FOPTIMIZE-NO-MEXPR-DEFINITION
  50                            (PROGN
  51                             (SETQ DEF (FOPTIMIZE-AUX (MGET IN 'MEXPR) IN))
  52                             (COND (OUT (MPUTPROP OUT DEF 'MEXPR) OUT)
  53                                   (T   DEF))))))))
  54
  55 ;;; FOPTIMIZE-AUX
  56 ;;;  This function is where the LAMBDA is actually optimized.
  57
  58 (DEFUN FOPTIMIZE-AUX (DEF NAME)
  59        (COND ((NOT DEF)
  60               (fresh-line)
  61               (PRINC '|;No function definition for | TYO)
  62               (PRINC (STRIPDOLLAR NAME) TYO)
  63               (PRINC '|. It will be ignored.| TYO)
  64               (*THROW 'FOPTIMIZE-NO-MEXPR-DEFINITION '$FAILED)))
  65        (LIST (NCONS 'LAMBDA)
  66              (CADR DEF)
  67              ($OPTIMIZE (LIST* (NCONS 'MPROG)
  68                                (NCONS (NCONS 'MLIST))
  69                                (CDDR DEF)))))