35 |
|
|
36 |
|
|
37 |
(defvar *compiler-in-use* nil) |
(defvar *compiler-in-use* nil) |
38 |
|
(defvar *compiler-compile* nil) |
39 |
(defvar *compiler-input*) |
(defvar *compiler-input*) |
40 |
(defvar *compiler-output1*) |
(defvar *compiler-output1*) |
41 |
(defvar *compiler-output2*) |
(defvar *compiler-output2*) |
427 |
(wt-data1 form) ;; this binds all the print stuff |
(wt-data1 form) ;; this binds all the print stuff |
428 |
)) |
)) |
429 |
|
|
|
|
|
430 |
(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #".")) |
(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #".")) |
431 |
|
|
432 |
(cond ((not(symbolp name)) (error "Must be a name")) |
(cond ((not(symbolp name)) (error "Must be a name")) |
441 |
(setf (symbol-function 'cmp-anon) tem) |
(setf (symbol-function 'cmp-anon) tem) |
442 |
(compile 'cmp-anon) |
(compile 'cmp-anon) |
443 |
(setf (macro-function name) (macro-function name)) |
(setf (macro-function name) (macro-function name)) |
444 |
name) |
;; FIXME -- support warnings-p and failures-p. CM 20041119 |
445 |
|
(values name nil nil)) |
446 |
((and (setq tem (symbol-function name)) |
((and (setq tem (symbol-function name)) |
447 |
(consp tem)) |
(consp tem)) |
448 |
(let ((na (if (symbol-package name) name 'cmp-anon))) |
(let ((na (if (symbol-package name) name 'cmp-anon)) |
449 |
|
(tem (wrap-literals tem))) |
450 |
(unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon) (fmakunbound 'si::init-cmp-anon))) |
(unless (and (fboundp 'si::init-cmp-anon) (or (si::init-cmp-anon) (fmakunbound 'si::init-cmp-anon))) |
451 |
(with-open-file |
(with-open-file |
452 |
(st (setq gaz (gazonk-name)) :direction :output) |
(st (setq gaz (gazonk-name)) :direction :output) |
454 |
(lambda (cdr tem)) |
(lambda (cdr tem)) |
455 |
(lambda-block (cddr tem)) |
(lambda-block (cddr tem)) |
456 |
)) st)) |
)) st)) |
457 |
(let ((fi (compile-file gaz))) |
(let ((fi (let ((*compiler-compile* t)) |
458 |
|
(compile-file gaz)))) |
459 |
(load fi) |
(load fi) |
460 |
(delete-file fi)) |
(delete-file fi)) |
461 |
(unless *keep-gaz* (delete-file gaz))) |
(unless *keep-gaz* (delete-file gaz))) |
462 |
(or (eq na name) (setf (symbol-function name) (symbol-function na))) |
(or (eq na name) (setf (symbol-function name) (symbol-function na))) |
463 |
(symbol-function name) |
;; FIXME -- support warnings-p and failures-p. CM 20041119 |
464 |
|
(values (symbol-function name) nil nil) |
465 |
)) |
)) |
466 |
(t (error "can't compile ~a" name)))) |
(t (error "can't compile ~a" name)))) |
467 |
|
|