/[gcl]/gcl/lsp/gcl_autocmp.lsp
ViewVC logotype

Diff of /gcl/lsp/gcl_autocmp.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by camm, Sun Sep 14 02:30:35 2003 UTC revision 1.2 by camm, Sun Sep 14 02:43:04 2003 UTC
# Line 0  Line 1 
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    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26