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