blob: 3e9395c137be8ab51e518e6138fddff1bd63ebe5 (
about) (
plain)
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
|
(in-package "LISP")
;;; The default version of this function has a bug with relative
;;; pathnames.
(defun pathname->string (p)
(let ((dirlist (pathname-directory p)))
(format nil "~A~{~A/~}~A~A~A"
(case (car dirlist)
(:absolute "/")
(:relative "./")
(:up "../")
(t ""))
(cdr dirlist)
(nil->empty-string (pathname-name p))
(if (null (pathname-type p)) "" ".")
(nil->empty-string (pathname-type p)))))
;;; The default version of this function defaults the C file to the
;;; wrong directory -- LOAD can't find it.
(defun my-comf (file &key
(output-file (merge-pathnames ".o" file))
(c-file (merge-pathnames ".c" output-file))
(verbose *compile-verbose*)
(print *compile-print*)
(config *config*)
(pic? *pic?*)
only-to-c?)
(old-comf file
:output-file output-file
:c-file c-file
:verbose verbose
:print print
:config config
:pic? pic?
:only-to-c? only-to-c?))
(when (not (fboundp 'old-comf))
(setf (symbol-function 'old-comf) #'comf)
(setf (symbol-function 'comf) #'my-comf))
;;; WCL's evaluator tries to macroexpand everything before executing
;;; anything. Unfortunately, this does the wrong thing with
;;; top-level PROGN's -- it tries to expand macros in subforms before
;;; executing earlier subforms that set up stuff required to do the
;;; the expansion properly.
(defun eval-1 (form venv fenv tenv benv)
(let ((new-form (macroexpand form *eval-macro-env*)))
(if (and (consp new-form)
(eq (car new-form) 'progn))
(do ((forms (cdr new-form) (cdr forms)))
((null (cdr forms)) (eval-1 (car forms) venv fenv tenv benv))
(eval-1 (car forms) venv fenv tenv benv))
(let ((expansion (expand new-form)))
(when (and (listp expansion)
(eq (car expansion) 'define-function))
(setf (get (second (second expansion))
:function-definition)
form))
(eval/5 expansion venv fenv tenv benv))
)))
|
