92 lines
3.0 KiB
Plaintext
92 lines
3.0 KiB
Plaintext
;; Function To Be Tested: compile
|
|
;;
|
|
;; Source: Guy L Steele's CLTL Chapter 25: Miscellaneous Features
|
|
;; Section: 25.1 The Compiler
|
|
;; Page: 439
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Aug 25,1986
|
|
;;
|
|
;; Last Update:
|
|
;; Changed by Pavel on January 29, 1987 to change the uses of DEFUN into
|
|
;; (SETF (SYMBOL-FUNCTION 'FOO) '(LAMBDA ...)) so as to avoid having
|
|
;; the interpreter create spurious interpreted closures. The compiler
|
|
;; cannot yet break one of these down.
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>25-1-compile.test
|
|
;;
|
|
;;
|
|
;; Syntax: (compile name &optional definition)
|
|
;;
|
|
;; Function Description: If definition is supplied, it should be a lambda-expression,
|
|
;; the interpreted function to be compiled. If it is not supplied, then should be
|
|
;; a symbol with a definition that is a lambda-expression; that definition is
|
|
;; compiled and the resulting compiled code is put back into the symbol as its
|
|
;; function definition. The definition is compiled and a compiled-function object
|
|
;; is produced. If name is a non-nil symbol, then the compiled-function object is
|
|
;; installed as the global function definition of the symbol and the symbol is
|
|
;; returned. If the name is nil, then the compiled-function object is returned.
|
|
;;
|
|
;; Argument(s): name: symbol with a definition or nil
|
|
;; definition (option): lambda-expression
|
|
;;
|
|
;; Returns: compiled-function object
|
|
;;
|
|
;; Constraints/Limitations: none
|
|
|
|
|
|
(do-test "compile-test-general"
|
|
(and (setf (symbol-function 'palindromep)
|
|
'(lambda (string &optional
|
|
(start 0)
|
|
(end (length string)))
|
|
(dotimes (k (floor (- end start) 2) t)
|
|
(unless (char-equal (char string (+ start k))
|
|
(char string (- end k 1)))
|
|
(return nil)))))
|
|
(eq 'palindromep (compile 'palindromep))
|
|
(compiled-function-p #'palindromep)
|
|
(eq (compile 'abs1 '(lambda (x) (if (minusp x) (- x) x))) 'abs1)
|
|
(compiled-function-p #'abs1)
|
|
(compiled-function-p
|
|
(compile nil '(lambda (a b c)
|
|
(- (* b b) (* 4 a c)))))
|
|
(fmakunbound 'palindromep)
|
|
)
|
|
)
|
|
|
|
;; Test to determine if the compiled version runs faster than the interpreted one.
|
|
(do-test "compile-test-time"
|
|
(and (setf (symbol-function 'comp-palindromep)
|
|
'(lambda (string &optional
|
|
(start 0)
|
|
(end (length string)))
|
|
(dotimes (k (floor (- end start) 2) t)
|
|
(unless (char-equal (char string (+ start k))
|
|
(char string (- end k 1)))
|
|
(return nil)))))
|
|
(setf (symbol-function 'inter-palindromep)
|
|
(symbol-function 'comp-palindromep))
|
|
(compile 'comp-palindromep)
|
|
(setq i-time1 (get-internal-run-time))
|
|
(dotimes (k 50 t)
|
|
(inter-palindromep "Able was I ere I saw Elba"))
|
|
(setq i-time2 (get-internal-run-time))
|
|
(setq c-time1 (get-internal-run-time))
|
|
(dotimes (k 50 t)
|
|
(comp-palindromep "Able was I ere I saw Elba"))
|
|
(setq c-time2 (get-internal-run-time))
|
|
(< (abs(- c-time2 c-time1)) (abs (- i-time2 i-time1)))
|
|
(fmakunbound 'inter-palindromep)
|
|
(fmakunbound 'comp-palindromep)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|
|
|