1 |
|
;;SAMPLE USAGE: |
2 |
|
;;(def-autocomp foo (a b) (+ a b)) |
3 |
|
;;(def-autocomp goo (a b) (- a b)) |
4 |
|
;; |
5 |
|
;;(foo 3 4) ==> 7 (after compiling foo and goo together..) |
6 |
|
;; |
7 |
|
;;Note: Might want to have a *use-count* which only compiles |
8 |
|
;;after *use-count* gets above say 10. Thus it would only compile |
9 |
|
;;the set of *new-definitions* when there were more than 10. |
10 |
|
;;Would need to change the following slightly. Instead of storing the defun |
11 |
|
;;store the lambda form, and have the autocomp do an apply of the lambda |
12 |
|
;;form while incrementing the *use-count*. This is probably much better, |
13 |
|
;;since the *use-count* much more accurately reflects the cost of not compiling |
14 |
|
;;This code is obsolete before being used!! But I have to go now.. |
15 |
|
|
16 |
|
(require "SLOOP") |
17 |
|
(use-package "SLOOP") |
18 |
|
|
19 |
|
|
20 |
|
(defvar *new-definitions* nil) |
21 |
|
|
22 |
|
(defun compile-new-definitions (name) |
23 |
|
(and name |
24 |
|
(or (member name *new-definitions*) |
25 |
|
(error "~a is not in *new-definitions*" name))) |
26 |
|
(let ((lisp-file "cmptemp.lisp")(o-file "cmptemp.o")) |
27 |
|
;;in case somehow order matters.. |
28 |
|
(setq *new-definitions* (nreverse *new-definitions*)) |
29 |
|
(with-open-file (st lisp-file :direction :output) |
30 |
|
(sloop for v in *new-definitions* |
31 |
|
do (princ (get v 'new-definition) st))) |
32 |
|
(compile-file lisp-file :output-file o-file) |
33 |
|
(load o-file) |
34 |
|
(setq *new-definitions* nil))) |
35 |
|
|
36 |
|
(defun autocomp (name args) |
37 |
|
(compile-new-definitions name) |
38 |
|
(apply name args)) |
39 |
|
|
40 |
|
(defmacro def-autocomp (fun args &rest body) |
41 |
|
(let ((defn (list* 'defun fun args body))) |
42 |
|
`(progn (push ',fun *new-definitions*) |
43 |
|
(setf (get ',fun 'new-definition) ',defn) |
44 |
|
(defun ,fun (&rest args) |
45 |
|
(autocomp ',fun args))))) |
46 |
|
|
47 |
|
|
48 |
|
|
49 |
|
|
50 |
|
|
51 |
|
|