movitz-cvs March 2007

movitz-cvs@common-lisp.net

1 participants
63 discussions

[movitz-cvs] CVS movitz
by ffjeld 11 Mar '07

11 Mar '07

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv24981 Modified Files: eval.lisp Log Message: Enable eval of make-hash-table. --- /project/movitz/cvsroot/movitz/eval.lisp 2006/04/28 23:20:47 1.11 +++ /project/movitz/cvsroot/movitz/eval.lisp 2007/03/11 21:18:40 1.12 @@ -9,7 +9,7 @@ ;;;; Created at: Thu Nov 2 17:45:05 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: eval.lisp,v 1.11 2006/04/28 23:20:47 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.12 2007/03/11 21:18:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -149,9 +149,10 @@ (mapcar (lambda (sub-form) (movitz-eval sub-form env nil)) (cdr form)))) - ((member operator '(muerte.cl:coerce)) - (apply #'coerce - (mapcar (lambda (arg) (translate-program (movitz-eval arg env nil) :muerte.cl :cl)) + ((member operator '(muerte.cl:coerce muerte.cl:make-hash-table)) + (apply (translate-program operator :muerte.cl :cl) + (mapcar (lambda (arg) + (translate-program (movitz-eval arg env nil) :muerte.cl :cl)) (cdr form)))) ((and compiler-macro-function (not (movitz-env-get (car form) 'notinline nil env))

1 0

[movitz-cvs] CVS movitz/ide
by ffjeld 07 Mar '07

07 Mar '07

Update of /project/movitz/cvsroot/movitz/ide In directory clnet:/tmp/cvs-serv20281 Modified Files: movitz-slime.el Log Message: Some more tweaks. Do movitz-auto-mode-setup by default. --- /project/movitz/cvsroot/movitz/ide/movitz-slime.el 2007/03/03 18:34:58 1.3 +++ /project/movitz/cvsroot/movitz/ide/movitz-slime.el 2007/03/07 20:53:12 1.4 @@ -72,6 +72,8 @@ (when (string-match ".*/movitz/losp/.*\\.lisp$" (buffer-file-name)) (movitz-mode 1))))) +(movitz-auto-mode-setup) + ;;;; Commands @@ -85,9 +87,11 @@ (when (and buffer (buffer-modified-p buffer)) (when (y-or-n-p (format "Save file %s? " filename)) (with-current-buffer buffer (save-buffer))))) - (message "Compiling..") - (slime-eval-async `(movitz.ide:compile-movitz-file ,filename) - (lambda (_) (message "Compilation finished.")))) + (lexical-let ((filename filename)) + (message "Movitz compiling '%s'.." filename) + (slime-eval-async `(movitz.ide:compile-movitz-file ,filename) + (lambda (_) + (message "Movitz compiling '%s'..done." filename))))) (defun movitz-compile-defun () "Compile the defun at point as Movitz code." @@ -205,6 +209,7 @@ (message "Dumping '%s'..done, starting quemu." filename) (call-process "c:/progra~1/qemu/qemu" nil 0 nil + "-s" "-L" "c:/progra~1/qemu" "-fda" filename "-boot" "a")))))

1 0

[movitz-cvs] CVS movitz/ide
by ffjeld 03 Mar '07

03 Mar '07

Update of /project/movitz/cvsroot/movitz/ide In directory clnet:/tmp/cvs-serv313 Modified Files: movitz-slime.el Log Message: More complete ide: movitz-arglist, macroexpand, etc. --- /project/movitz/cvsroot/movitz/ide/movitz-slime.el 2007/03/01 17:52:59 1.2 +++ /project/movitz/cvsroot/movitz/ide/movitz-slime.el 2007/03/03 18:34:58 1.3 @@ -49,12 +49,17 @@ (define-key movitz-mode-commands-map (car spec) (cadr spec))) (define-key movitz-mode-map movitz-command-prefix movitz-mode-commands-map) - (define-key movitz-mode-map "\C-c\C-d" 'movitz-dump-image) + (define-key movitz-mode-map "\C-cd" 'movitz-dump-image) (define-key movitz-mode-map "\C-c\C-v" 'movitz-disassemble-defun) (define-key movitz-mode-map "\C-c\C-b" 'movitz-compile-file) (define-key movitz-mode-map "\C-\M-x" 'movitz-compile-defun) (define-key movitz-mode-map "\C-cm" 'movitz-macroexpand) - (define-key movitz-mode-map "\C-ca" 'movitz-arglist)) + (define-key movitz-mode-map "\C-ca" 'movitz-arglist) + (define-key movitz-mode-map "\C-cd" 'movitz-dump-image-and-qemu) + (define-key movitz-mode-map "\M-." 'find-tag) + (define-key movitz-mode-map "\M-," 'tags-loop-continue) + (define-key movitz-mode-map "\r" 'newline-and-indent) + (define-key movitz-mode-map " " 'self-insert-command)) (movitz-init-command-keymap) @@ -64,7 +69,7 @@ does." (add-hook 'find-file-hooks (defun movitz-auto-enable () - (when (string-match "/movitz/losp/.*\\.lisp$" (buffer-file-name)) + (when (string-match ".*/movitz/losp/.*\\.lisp$" (buffer-file-name)) (movitz-mode 1))))) @@ -96,6 +101,25 @@ (slime-eval-async `(movitz.ide:compile-defun ,(slime-defun-at-point) ,package-name) (lambda (_) (message "Movitz compilation of %s '%s' finished." defun-type defun-name)))))) +(defun movitz-macroexpand () + "Macroexpand the form at point." + (interactive) + (lexical-let ((form (slime-sexp-at-point-or-error)) + (package-name (slime-current-package))) + (slime-eval-async `(movitz.ide:movitz-macroexpand ,form ,package-name) + (lambda (expansion) + (if (and (not (find 10 expansion)) + (< (length expansion) 80)) + (message "Movitz: \"%s\"" expansion) + (let ((buffer (get-buffer-create "*Movitz Macroexpand*"))) + (with-current-buffer buffer + (delete-region 1 (point-max)) + (common-lisp-mode) + (insert expansion) + (newline 2) + (pop-to-buffer buffer)))))))) + + (defun movitz-disassemble-fdefinition (symbol-name package-name) "Show disassembly of the (non-generic) function at point." (interactive (list (slime-read-symbol-name "Symbol: ") @@ -139,6 +163,15 @@ ;; (message "Movitz disassembling %s %s...done." defun-type defun-name)) (t (message "Don't know how to Movitz disassemble %s '%s'." defun-type defun-name)))))) +(defun movitz-arglist (string) + (interactive (list (slime-read-symbol-name "Movitz arglist of: "))) + (when (and string (plusp (length string))) + (lexical-let ((string string)) + (slime-eval-async `(movitz.ide:movitz-arglist ,string ,(slime-current-package)) + (lambda (result) + (message "Movitz args for %s: %s." string result)))))) + + (defvar movitz-default-image-file nil "The default filename to dump images to. This is set by `movitz-dump-image' and can also be preinitialized in @@ -157,17 +190,24 @@ (lambda (_) (message "Finished.")))) -(defun movitz-dump-image-and-qemu () +(defun movitz-dump-image-and-qemu (filename) "Dump the current image to FILENAME." - (let ((filename (list (if (and (null current-prefix-arg) - movitz-default-image-file) - movitz-default-image-file - (let ((filename (read-file-name "Image file: "))) - (setq movitz-default-image-file filename) - filename))) - (message "Dumping..") - (slime-eval-async `(movitz.ide:dump-image ,filename) - (lambda (_) (message "Finished.")))) + (interactive (list (if (and (null current-prefix-arg) + movitz-default-image-file) + movitz-default-image-file + (let ((filename (read-file-name "Image file: "))) + (setq movitz-default-image-file filename) + filename)))) + (lexical-let ((filename filename)) + (message "Dumping '%s'.." filename) + (slime-eval-async `(movitz.ide:dump-image ,filename) + (lambda (_) + (message "Dumping '%s'..done, starting quemu." filename) + (call-process "c:/progra~1/qemu/qemu" + nil 0 nil + "-L" "c:/progra~1/qemu" + "-fda" filename + "-boot" "a"))))) @@ -214,3 +254,12 @@ definition-type lambda-list nil))))) + +;;; Indentation of Movit syntax + +(let ((l '((with-inline-assembly . tagbody)))) + (dolist (el l) + (put (car el) 'common-lisp-indent-function + (if (symbolp (cdr el)) + (get (cdr el) 'common-lisp-indent-function) + (car (cdr el)))))) \ No newline at end of file

1 0

[movitz-cvs] CVS movitz/ide
by ffjeld 03 Mar '07

03 Mar '07

Update of /project/movitz/cvsroot/movitz/ide In directory clnet:/tmp/cvs-serv32752 Modified Files: ide.lisp Log Message: More complete ide: movitz-arglist, macroexpand, etc. --- /project/movitz/cvsroot/movitz/ide/ide.lisp 2007/03/01 17:52:57 1.4 +++ /project/movitz/cvsroot/movitz/ide/ide.lisp 2007/03/03 18:34:53 1.5 @@ -9,8 +9,13 @@ (defpackage #:movitz.ide (:use #:cl) - (:export #:compile-movitz-file #:compile-defun #:dump-image - #:movitz-disassemble #:movitz-disassemble-method)) + (:export #:compile-movitz-file + #:compile-defun + #:dump-image + #:movitz-disassemble + #:movitz-disassemble-method + #:movitz-arglist + #:movitz-macroexpand)) (in-package #:movitz.ide) @@ -42,6 +47,21 @@ (get-sexpr lambda-list package) (mapcar #'read-from-string qualifiers))))) +(defun movitz-arglist (name package-name) + (let* ((package (get-package package-name)) + (funobj (movitz::movitz-env-named-function (get-sexpr name package)))) + (if (not funobj) + "not defined" + (let ((*package* package)) + (princ-to-string (movitz::movitz-print (movitz::movitz-funobj-lambda-list funobj))))))) + +(defun movitz-macroexpand (string package-name) + (let* ((*package* (get-package package-name)) + (form (get-sexpr string *package*)) + (expansion (movitz::movitz-macroexpand-1 form))) + (princ-to-string (movitz::movitz-print expansion)))) + + ;;;; Utilities.

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 02 Mar '07

02 Mar '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv11968 Modified Files: setf.lisp Log Message: Use property muerte:setf-expander rather than :setf-expander, here too. --- /project/movitz/cvsroot/movitz/losp/muerte/setf.lisp 2006/04/07 21:49:47 1.4 +++ /project/movitz/cvsroot/movitz/losp/muerte/setf.lisp 2007/03/02 22:01:33 1.5 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Feb 8 20:43:20 2001 ;;;; -;;;; $Id: setf.lisp,v 1.4 2006/04/07 21:49:47 ffjeld Exp $ +;;;; $Id: setf.lisp,v 1.5 2007/03/02 22:01:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -30,7 +30,7 @@ (defun get-setf-expansion (place &optional environment) (let* ((name (and (consp place) (movitz::translate-program (car place) :cl :muerte.cl))) - (expander (and name (movitz::movitz-env-get name :setf-expander nil environment)))) + (expander (and name (movitz::movitz-env-get name 'setf-expander nil environment)))) (if expander (funcall expander place environment) (multiple-value-bind (expansion expanded-p)

1 0

[movitz-cvs] CVS movitz
by ffjeld 01 Mar '07

01 Mar '07

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv12919 Modified Files: environment.lisp Log Message: Fix overly eager code-deletion in previous check-in. --- /project/movitz/cvsroot/movitz/environment.lisp 2007/03/01 17:48:11 1.20 +++ /project/movitz/cvsroot/movitz/environment.lisp 2007/03/01 23:16:10 1.21 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 3 11:40:15 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: environment.lisp,v 1.20 2007/03/01 17:48:11 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.21 2007/03/01 23:16:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -517,7 +517,7 @@ (assert (null env)) (or #0=(gethash name (movitz-environment-setf-function-names *movitz-global-environment*)) (let ((setf-symbol (make-symbol - (symbol-name name) + (symbol-name name)))) (setf (symbol-plist setf-symbol) (list :setf-placeholder name) #0# setf-symbol)))) @@ -591,8 +591,3 @@ (defun movitz-special-operator-compiler (symbol) (movitz-special-operator-compiler-function (gethash symbol (movitz-environment-function-cells *persistent-movitz-environment*)))) - - -;;; - -

1 0

[movitz-cvs] CVS movitz
by ffjeld 01 Mar '07

01 Mar '07

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv21413 Modified Files: compiler.lisp Log Message: Have optimize-code do layout-program even when *compiler-do-optimize* is false. --- /project/movitz/cvsroot/movitz/compiler.lisp 2007/03/01 17:50:52 1.180 +++ /project/movitz/cvsroot/movitz/compiler.lisp 2007/03/01 21:27:39 1.181 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.180 2007/03/01 17:50:52 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.181 2007/03/01 21:27:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1370,11 +1370,11 @@ (defun optimize-code (unoptimized-code &rest args) #+ignore (print-code 'to-optimize unoptimized-code) (if (not *compiler-do-optimize*) - unoptimized-code - (apply #'optimize-code-internal - (optimize-code-dirties - (layout-program (optimize-code-unfold-branches unoptimized-code))) - 0 args))) + (layout-program (optimize-code-unfold-branches unoptimized-code)) + (apply #'optimize-code-internal + (optimize-code-dirties + (layout-program (optimize-code-unfold-branches unoptimized-code))) + 0 args))) (defun optimize-code-unfold-branches (unoptimized-code) "This particular optimization should be done before code layout: @@ -1472,7 +1472,7 @@ (defun optimize-code-internal (unoptimized-code recursive-count &rest key-args &key keep-labels stack-frame-size) - "Peephole optimizer. Based on a lot of rather random techniques." + "Peephole optimizer. Based on a lot of rather random heuristics." (declare (ignore stack-frame-size)) (when (<= 20 recursive-count) (error "Peephole-optimizer recursive count reached ~D.

1 0

[movitz-cvs] CVS movitz/ide
by ffjeld 01 Mar '07

01 Mar '07

Update of /project/movitz/cvsroot/movitz/ide In directory clnet:/tmp/cvs-serv21835 Modified Files: movitz-slime.el Log Message: Update the slime-based IDE somewhat. At least the basics work now, such as compile-defun (M-C-x) and disassemble-defun (C-c C-v). --- /project/movitz/cvsroot/movitz/ide/movitz-slime.el 2004/07/21 10:54:42 1.1 +++ /project/movitz/cvsroot/movitz/ide/movitz-slime.el 2007/03/01 17:52:59 1.2 @@ -14,6 +14,7 @@ ;;; core Movitz sources. (require 'slime) +(require 'cl) ;;;; Minor-mode @@ -46,7 +47,14 @@ (setq movitz-mode-commands-map (make-sparse-keymap)) (dolist (spec movitz-command-keys) (define-key movitz-mode-commands-map (car spec) (cadr spec))) - (define-key movitz-mode-map movitz-command-prefix movitz-mode-commands-map)) + (define-key movitz-mode-map movitz-command-prefix movitz-mode-commands-map) + + (define-key movitz-mode-map "\C-c\C-d" 'movitz-dump-image) + (define-key movitz-mode-map "\C-c\C-v" 'movitz-disassemble-defun) + (define-key movitz-mode-map "\C-c\C-b" 'movitz-compile-file) + (define-key movitz-mode-map "\C-\M-x" 'movitz-compile-defun) + (define-key movitz-mode-map "\C-cm" 'movitz-macroexpand) + (define-key movitz-mode-map "\C-ca" 'movitz-arglist)) (movitz-init-command-keymap) @@ -79,9 +87,14 @@ (defun movitz-compile-defun () "Compile the defun at point as Movitz code." (interactive) - (message "Compiling..") - (slime-eval-async `(movitz.ide:compile-defun ,(slime-defun-at-point)) - (lambda (_) (message "Compilation finished.")))) + (multiple-value-bind (defun-name defun-type) + (movitz-defun-name-and-type) + (lexical-let ((defun-name defun-name) + (defun-type defun-type) + (package-name (slime-current-package))) + (message "Compiling %s '%s'.." defun-type defun-name) + (slime-eval-async `(movitz.ide:compile-defun ,(slime-defun-at-point) ,package-name) + (lambda (_) (message "Movitz compilation of %s '%s' finished." defun-type defun-name)))))) (defun movitz-disassemble-fdefinition (symbol-name package-name) "Show disassembly of the (non-generic) function at point." @@ -92,6 +105,40 @@ (lambda (result) (slime-show-description result package))))) +(defun movitz-disassemble-defun (not-recursive-p) + (interactive "P") + (multiple-value-bind (defun-name defun-type lambda-list options) + (movitz-defun-name-and-type) + (lexical-let ((defun-name defun-name) + (defun-type defun-type) + (package-name (slime-current-package)) + (lambda-list lambda-list) + (options options)) + (cond + ((string= "function" defun-type) + (message "Movitz disassembling %s %s..." defun-type defun-name) + (slime-eval-async `(movitz.ide:movitz-disassemble ,defun-name ,package-name) + (lambda (result) + (slime-show-description result package-name) + (message "Movitz disassembling %s %s...done." defun-type defun-name)))) + ((string= "method" defun-type) + (message "Movitz disassembling %s '%s %s'..." defun-type defun-name lambda-list) + (slime-eval-async `(movitz.ide:movitz-disassemble-method ,defun-name ,lambda-list ',options ,package-name) + (lambda (result) + (slime-show-description result package-name) + (message "Movitz disassembling %s '%s %s'...done." defun-type defun-name lambda-list)))) + ;; ((string= "primitive-function" defun-type) + ;; (message "Movitz disassembling %s %s..." defun-type defun-name) + ;; (fi:eval-in-lisp + ;; "(cl:let ((defun-name (cl:let ((cl:*package* (cl:find-package :%s))) + ;; (cl:read-from-string \"%s\"))) + ;; (cl:*print-base* 16)) + ;; (movitz::movitz-disassemble-primitive defun-name))" + ;; fi:package defun-name) + ;; (switch-to-buffer "*common-lisp*") + ;; (message "Movitz disassembling %s %s...done." defun-type defun-name)) + (t (message "Don't know how to Movitz disassemble %s '%s'." defun-type defun-name)))))) + (defvar movitz-default-image-file nil "The default filename to dump images to. This is set by `movitz-dump-image' and can also be preinitialized in @@ -109,3 +156,61 @@ (slime-eval-async `(movitz.ide:dump-image ,filename) (lambda (_) (message "Finished.")))) + +(defun movitz-dump-image-and-qemu () + "Dump the current image to FILENAME." + (let ((filename (list (if (and (null current-prefix-arg) + movitz-default-image-file) + movitz-default-image-file + (let ((filename (read-file-name "Image file: "))) + (setq movitz-default-image-file filename) + filename))) + (message "Dumping..") + (slime-eval-async `(movitz.ide:dump-image ,filename) + (lambda (_) (message "Finished.")))) + + + +(defun movitz-defun-name-and-type () + (interactive) + (save-excursion + (let ((definition-type + (let ((x (buffer-substring-no-properties (progn (beginning-of-defun) + (forward-char) + (point)) + (progn (forward-symbol 1) + (point))))) + (cond + ((string-equal "defun" x) + "function") + ((string-match "^define-" x) + (substring x 7)) + ((string-match "^def" x) + (substring x 3)) + (t x)))) + (definition-name + (buffer-substring-no-properties (progn (forward-char) + (point)) + (progn (forward-sexp 1) + (point)))) + (lambda-list + (buffer-substring-no-properties (progn (forward-char) + (point)) + (progn (forward-sexp 1) + (point))))) + (if (and (equalp "method" definition-type) + (char-equal 58 (string-to-char lambda-list))) + (let ((qualifier lambda-list) + ;; XXX we only deal with one (potential) qualifier.. + (lambda-list (buffer-substring-no-properties (progn (forward-char) + (point)) + (progn (forward-sexp 1) + (point))))) + (values definition-name + definition-type + lambda-list + (list qualifier))) + (values definition-name + definition-type + lambda-list + nil)))))

1 0

[movitz-cvs] CVS movitz/ide
by ffjeld 01 Mar '07

01 Mar '07

Update of /project/movitz/cvsroot/movitz/ide In directory clnet:/tmp/cvs-serv21819 Modified Files: ide.lisp Log Message: Update the slime-based IDE somewhat. At least the basics work now, such as compile-defun (M-C-x) and disassemble-defun (C-c C-v). --- /project/movitz/cvsroot/movitz/ide/ide.lisp 2007/02/26 21:32:55 1.3 +++ /project/movitz/cvsroot/movitz/ide/ide.lisp 2007/03/01 17:52:57 1.4 @@ -10,7 +10,7 @@ (defpackage #:movitz.ide (:use #:cl) (:export #:compile-movitz-file #:compile-defun #:dump-image - #:disassemble-fdefinition #:movitz-disassemble)) + #:movitz-disassemble #:movitz-disassemble-method)) (in-package #:movitz.ide) @@ -18,25 +18,29 @@ "Compile FILENAME as Movitz source." (movitz:movitz-compile-file filename)) -(defun compile-defun (source) +(defun compile-defun (source package-printname) "Compile the string SOURCE as Movitz source." (with-input-from-string (stream source) - (movitz:movitz-compile-stream stream :path "movitz-ide-toplevel"))) + (movitz:movitz-compile-stream stream :path "movitz-ide-toplevel" + :package (get-package package-printname)))) (defun dump-image (filename) "Dump the current image into FILENAME." (movitz:dump-image :path filename)) ;;; slime-friendly entry point. -(defun movitz-disassemble (symbol-printname package-printname) +(defun movitz-disassemble (printname package-printname) "Return the disassembly of SYMBOL-NAME's function as a string." - (disassemble-fdefinition (get-symbol symbol-printname - (get-package package-printname)))) - -(defun disassemble-fdefinition (symbol) - "Return the disassembly SYMBOL's fdefinition as a string." (with-output-to-string (*standard-output*) - (movitz:movitz-disassemble symbol))) + (movitz:movitz-disassemble (get-sexpr printname + (get-package package-printname))))) + +(defun movitz-disassemble-method (gf-name lambda-list qualifiers package-name) + (let ((package (get-package package-name))) + (with-output-to-string (*standard-output*) + (movitz:movitz-disassemble-method (get-sexpr gf-name package) + (get-sexpr lambda-list package) + (mapcar #'read-from-string qualifiers))))) ;;;; Utilities. @@ -50,6 +54,10 @@ (or (find-symbol (readname printname) package) (error "Can't find \"~A\" as a symbol in ~S" printname package))) +(defun get-sexpr (printname &optional (package *package*)) + (let ((*package* package)) + (read-from-string printname))) + (defun get-package (printname) "Return the package with PRINTNAME. Signal an error if there is no such package."

1 0

[movitz-cvs] CVS movitz
by ffjeld 01 Mar '07

01 Mar '07

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv21731 Modified Files: compiler.lisp Log Message: Minor tweak to movitz-compile-stream. --- /project/movitz/cvsroot/movitz/compiler.lisp 2007/02/26 21:18:37 1.179 +++ /project/movitz/cvsroot/movitz/compiler.lisp 2007/03/01 17:50:52 1.180 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.179 2007/02/26 21:18:37 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.180 2007/03/01 17:50:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1252,13 +1252,15 @@ (with-simple-restart (continue "Skip Movitz compilation of ~S." path) (with-retries-until-true (retry "Restart Movitz compilation of ~S." path) (with-open-file (stream path :direction :input) - (movitz-compile-stream-internal stream :path path))))) + (let ((*package* (find-package :muerte))) + (movitz-compile-stream-internal stream :path path)))))) -(defun movitz-compile-stream (stream &key (path "unknown-toplevel.lisp")) +(defun movitz-compile-stream (stream &key (path "unknown-toplevel.lisp") (package :muerte)) (handler-bind (#+sbcl (sb-ext:defconstant-uneql #'continue)) (unwind-protect - (let ((*movitz-host-features* *features*) + (let ((*package* (find-package package)) + (*movitz-host-features* *features*) (*features* (image-movitz-features *image*))) (multiple-value-prog1 (movitz-compile-stream-internal stream :path path) @@ -1268,7 +1270,6 @@ (defun movitz-compile-stream-internal (stream &key (path "unknown-toplevel.lisp")) (let* ((muerte.cl::*compile-file-pathname* path) - (*package* (find-package :muerte)) (funobj (make-instance 'movitz-funobj-pass1 :name (intern (format nil "~A" path) :muerte) :lambda-list (movitz-read nil))) @@ -1286,12 +1287,12 @@ (read stream nil '#0=#:eof)) until (eq form '#0#) appending - (with-simple-restart (skip-toplevel-form + (with-simple-restart (skip-toplevel-form "Skip the compilation of top-level form~@[ ~A~]." (cond ((symbolp form) form) ((symbolp (car form)) (car form)))) - (when *compiler-verbose-p* + (when *compiler-verbose-p* (format *query-io* "~&Movitz Compiling ~S..~%" (cond ((symbolp form) form)

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs March 2007