April 2006 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS movitz
by ffjeld 10 Apr '06

10 Apr '06

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv4685 Modified Files: storage-types.lisp Log Message: Added missing update-movitz-object method. --- /project/movitz/cvsroot/movitz/storage-types.lisp 2005/07/21 18:48:33 1.55 +++ /project/movitz/cvsroot/movitz/storage-types.lisp 2006/04/10 11:47:41 1.56 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.55 2005/07/21 18:48:33 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.56 2006/04/10 11:47:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1309,6 +1309,10 @@ (assert (= (movitz-ratio-value object) lisp-object)) object) +(defmethod update-movitz-object ((object movitz-ratio) (lisp-object float)) + (assert (= (movitz-ratio-value object) (rationalize lisp-object))) + object) + (defmethod print-object ((x movitz-ratio) stream) (print-unreadable-object (x stream :type t) (format stream "~D" (slot-value x 'value)))

1 0

[movitz-cvs] CVS movitz
by ffjeld 10 Apr '06

10 Apr '06

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv4635 Modified Files: special-operators.lisp Log Message: Just warn rather than error upon non-toplevel declaim. --- /project/movitz/cvsroot/movitz/special-operators.lisp 2005/08/28 21:03:53 1.54 +++ /project/movitz/cvsroot/movitz/special-operators.lisp 2006/04/10 11:47:14 1.55 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.54 2005/08/28 21:03:53 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.55 2006/04/10 11:47:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -598,7 +598,7 @@ (define-special-operator muerte::declaim-compile-time (&form form &top-level-p top-level-p) (unless top-level-p - (error "DECLAIM not at top-level.")) + (warn "DECLAIM not at top-level.")) (let ((declaration-specifiers (cdr form))) (movitz-env-load-declarations declaration-specifiers *movitz-global-environment* :declaim)) (compiler-values ()))

1 0

[movitz-cvs] CVS movitz
by ffjeld 10 Apr '06

10 Apr '06

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv4599 Modified Files: procfs-image.lisp Log Message: Invoke debugger with a string only. --- /project/movitz/cvsroot/movitz/procfs-image.lisp 2005/05/03 20:11:43 1.24 +++ /project/movitz/cvsroot/movitz/procfs-image.lisp 2006/04/10 11:46:25 1.25 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Aug 24 11:39:37 2001 ;;;; -;;;; $Id: procfs-image.lisp,v 1.24 2005/05/03 20:11:43 ffjeld Exp $ +;;;; $Id: procfs-image.lisp,v 1.25 2006/04/10 11:46:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -319,10 +319,11 @@ (let ((x (eval form))) (format t "~&~W" x) x) - (invoke-debugger "Established Bochs session [pid=~D]. ~S is ~S" - (image-pid image) - '*previous-image* - *previous-image*))))))) + (invoke-debugger + (format nil "Established Bochs session [pid=~D]. ~S is ~S" + (image-pid image) + '*previous-image* + *previous-image*)))))))) #+allegro (top-level:alias ("unbochs" 3) (&optional form)

1 0

[movitz-cvs] CVS movitz
by ffjeld 10 Apr '06

10 Apr '06

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv4553 Modified Files: movitz.lisp Log Message: Added support for #. reader syntax (i.e. translate muerte.cl to cl package). --- /project/movitz/cvsroot/movitz/movitz.lisp 2004/11/15 14:42:15 1.10 +++ /project/movitz/cvsroot/movitz/movitz.lisp 2006/04/10 11:45:36 1.11 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:52:58 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: movitz.lisp,v 1.10 2004/11/15 14:42:15 ffjeld Exp $ +;;;; $Id: movitz.lisp,v 1.11 2006/04/10 11:45:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -56,6 +56,12 @@ ,@body (write-char #\> ,stream-var))))) +(defun movitz-syntax-sharp-dot (stream subchar arg) + (declare (ignore arg subchar)) + (let ((form (read stream t nil t))) + (values (unless *read-suppress* + (eval (muerte::translate-program form :muerte.cl :cl)))))) + (defmacro with-movitz-syntax (options &body body) (declare (ignore options)) `(let ((*readtable* (copy-readtable))) @@ -71,6 +77,11 @@ (make-movitz-vector (length data) :element-type 'movitz-unboxed-integer-u8 :initial-contents data)))) + (set-dispatch-macro-character #\# #\. (lambda (stream subchar arg) + (declare (ignore arg subchar)) + (let ((form (read stream t nil t))) + (values (unless *read-suppress* + (eval (muerte::translate-program form :muerte.cl :cl))))))) (set-macro-character #\` (lambda (stream char) (declare (ignore char)) (let ((*bq-level* (1+ *bq-level*)))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 07 Apr '06

07 Apr '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv24514 Modified Files: print.lisp Log Message: Added write-to-string. --- /project/movitz/cvsroot/movitz/losp/muerte/print.lisp 2005/08/26 19:38:41 1.21 +++ /project/movitz/cvsroot/movitz/losp/muerte/print.lisp 2006/04/07 21:54:23 1.22 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Sep 3 11:48:19 2001 ;;;; -;;;; $Id: print.lisp,v 1.21 2005/08/26 19:38:41 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.22 2006/04/07 21:54:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -201,6 +201,12 @@ (print-unreadable-object (c *standard-output* :type t :identity t) (format t "(while printing ~Z)" object)))))))) +(defun write-to-string (object &rest args) + (declare (dynamic-extent args)) + (apply 'write object + :stream (make-array 24 :element-type 'character :fill-pointer 0 :adjustable t) + args)) + (defun internal-write (object) (let ((stream *standard-output*)) (cond

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 07 Apr '06

07 Apr '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv24476 Modified Files: environment.lisp Log Message: random-state and pathname types. --- /project/movitz/cvsroot/movitz/losp/muerte/environment.lisp 2005/08/31 22:31:35 1.14 +++ /project/movitz/cvsroot/movitz/losp/muerte/environment.lisp 2006/04/07 21:53:47 1.15 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Oct 20 00:41:57 2001 ;;;; -;;;; $Id: environment.lisp,v 1.14 2005/08/31 22:31:35 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.15 2006/04/07 21:53:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -167,3 +167,6 @@ (defun sleep (seconds) (declare (ignore seconds)) (error "There is no default implementation of sleep.")) + +(defstruct random-state state) +(defstruct pathname name)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 07 Apr '06

07 Apr '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv24435 Modified Files: loop.lisp Log Message: We need loop-copylist* at runtime. --- /project/movitz/cvsroot/movitz/losp/muerte/loop.lisp 2004/09/06 12:33:43 1.6 +++ /project/movitz/cvsroot/movitz/losp/muerte/loop.lisp 2006/04/07 21:53:02 1.7 @@ -70,6 +70,12 @@ ;;;This is the "current" loop context in use when we are expanding a ;;;loop. It gets bound on each invocation of LOOP. +#+movitz +(defmacro loop-copylist* (l) + #+Genera `(lisp:copy-list ,l nil t) ; arglist = (list &optional area force-dotted) + ;;@@@@Explorer?? + #-Genera `(copy-list ,l)) + (eval-when (:compile-toplevel) (defvar *loop-real-data-type* 'real) (defvar *loop-universe*)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 07 Apr '06

07 Apr '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv24399 Modified Files: hash-tables.lisp Log Message: Support equalp hashing. --- /project/movitz/cvsroot/movitz/losp/muerte/hash-tables.lisp 2005/08/26 19:38:50 1.11 +++ /project/movitz/cvsroot/movitz/losp/muerte/hash-tables.lisp 2006/04/07 21:52:36 1.12 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Feb 19 19:09:05 2001 ;;;; -;;;; $Id: hash-tables.lisp,v 1.11 2005/08/26 19:38:50 ffjeld Exp $ +;;;; $Id: hash-tables.lisp,v 1.12 2006/04/07 21:52:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -42,7 +42,8 @@ test) (eq (values #'eq #'sxhash-eq)) (eql (values #'eql #'sxhash-eql)) - (equal (values #'equal #'sxhash))) + (equal (values #'equal #'sxhash)) + (equalp (values #'equalp #'sxhash))) (make-hash-table-object :test test :bucket (make-array (* 2 size) :initial-element '--no-hash-key--)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 07 Apr '06

07 Apr '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv24361 Modified Files: functions.lisp Log Message: Smart up complement somewhat. --- /project/movitz/cvsroot/movitz/losp/muerte/functions.lisp 2005/04/20 06:53:28 1.29 +++ /project/movitz/cvsroot/movitz/losp/muerte/functions.lisp 2006/04/07 21:52:17 1.30 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 12 22:58:54 2002 ;;;; -;;;; $Id: functions.lisp,v 1.29 2005/04/20 06:53:28 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.30 2006/04/07 21:52:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -60,22 +60,15 @@ (declare (dynamic-extent args)) (not (apply 'function args))) -(define-compiler-macro complement (&whole form function-form) +(define-compiler-macro complement (&whole form function-form &environment env) (cond - ((movitz:movitz-constantp function-form) - (let ((function (movitz:movitz-eval function-form))) - `(make-prototyped-function (complement ,function) - complement-prototype - (function ,function)))) ((and (listp function-form) (eq 'function (first function-form)) - (symbolp (second function-form)) - (typep (movitz:movitz-eval (translate-program function-form :cl :muerte.cl)) + (typep (movitz:movitz-eval (translate-program function-form :cl :muerte.cl) env) 'movitz:movitz-funobj)) - `(make-prototyped-function (complement ,function-form) + `(make-prototyped-function `(complement ,(second function-form)) complement-prototype - (function ,(movitz:movitz-eval (translate-program function-form - :cl :muerte.cl))))) + ,(movitz:movitz-eval (translate-program function-form :cl :muerte.cl)))) (t form))) (defun complement (function)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 07 Apr '06

07 Apr '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv24315 Modified Files: conditions.lisp Log Message: Add style-warning condition. --- /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2005/08/11 21:34:26 1.17 +++ /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2006/04/07 21:51:53 1.18 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 20 15:47:04 2002 ;;;; -;;;; $Id: conditions.lisp,v 1.17 2005/08/11 21:34:26 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.18 2006/04/07 21:51:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -63,6 +63,7 @@ (define-condition serious-condition () ()) (define-condition error (serious-condition) ()) (define-condition warning () ()) +(define-condition style-warning () ()) (define-condition simple-error (simple-condition error) ()) (define-condition simple-warning (simple-condition warning) ()) @@ -282,7 +283,10 @@ ((not *debugger-function*) (let ((*never-use-print-object* t)) (backtrace :spartan t)) - (format t "~&No debugger in *debugger-function*. Trying to continue or abort.") + (format t "~&No debugger in *debugger-function*...") + (dotimes (i 100000) + (write-string "")) + (format t "Trying to continue or abort.") (invoke-restart (or (find-restart 'continue) (find-restart 'abort) (format t "~%Condition for debugger: ~Z" condition)

1 0