movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS movitz
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv27251 Modified Files: compiler.lisp Log Message: Don't break on constant EQL. --- /project/movitz/cvsroot/movitz/compiler.lisp 2008/04/17 19:09:28 1.203 +++ /project/movitz/cvsroot/movitz/compiler.lisp 2008/04/21 19:45:36 1.204 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.203 2008/04/17 19:09:28 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.204 2008/04/21 19:45:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -7248,7 +7248,7 @@ (:boolean-branch-on-false (when (not eql) `((:jmp ',(operands return-mode))))) - (t (break "Constant EQL: ~S ~S" (car x-singleton) (car y-singleton)))))) + (t (warn "Constant EQL: ~S ~S" (car x-singleton) (car y-singleton)))))) ((and x-singleton (eq :untagged-fixnum-ecx y-loc)) (let ((value (etypecase (car x-singleton)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv27017 Modified Files: variables.lisp Log Message: Add misc. standard variables. --- /project/movitz/cvsroot/movitz/losp/muerte/variables.lisp 2008/03/21 22:30:40 1.12 +++ /project/movitz/cvsroot/movitz/losp/muerte/variables.lisp 2008/04/21 19:44:13 1.13 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 5 21:53:34 2003 ;;;; -;;;; $Id: variables.lisp,v 1.12 2008/03/21 22:30:40 ffjeld Exp $ +;;;; $Id: variables.lisp,v 1.13 2008/04/21 19:44:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -35,6 +35,7 @@ (defvar +++ nil) (defvar *read-base* 10) +(defvar *read-eval* t) (defvar *package* nil) (defvar *macroexpand-hook* 'funcall) @@ -63,11 +64,38 @@ (defvar single-float-negative-epsilon -1/1000) (defvar double-float-negative-epsilon -1/1000) (defvar long-float-negative-epsilon -1/1000) +(defvar long-float-epsilon 1/10000) +(defconstant most-negative-short-float most-negative-fixnum) +(defconstant most-negative-single-float most-negative-fixnum) +(defconstant most-negative-long-float most-negative-fixnum) +(defconstant most-negative-double-float most-negative-fixnum) + +(defconstant least-positive-short-float 1/100000) +(defconstant least-positive-single-float 1/100000) +(defconstant least-positive-double-float 1/100000) +(defconstant least-positive-long-float 1/100000) + +(defconstant least-negative-short-float -1/100000) +(defconstant least-negative-single-float -1/100000) +(defconstant least-negative-double-float -1/100000) +(defconstant least-negative-long-float -1/100000) (defconstant call-arguments-limit 512) (defconstant lambda-parameters-limit 512) ; ? (defvar *print-pprint-dispatch* nil) -(declaim (special *build-number*)) +(defvar *build-number*) ; set at bootup + +(defvar *features* '(:movitz)) +(defvar *modules* nil) + +(defvar *compile-file-pathname* nil) +(defvar *compile-file-truename* nil) +(defvar *compile-print* nil) +(defvar *compile-verbose* nil) +(defvar *load-print* nil) +(defvar *load-verbose* nil) +(defvar *load-truename* nil) +(defvar *default-pathname-defaults* #p"")

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv26953 Modified Files: typep.lisp Log Message: Misc. types. --- /project/movitz/cvsroot/movitz/losp/muerte/typep.lisp 2008/04/09 18:02:47 1.58 +++ /project/movitz/cvsroot/movitz/losp/muerte/typep.lisp 2008/04/21 19:43:57 1.59 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.58 2008/04/09 18:02:47 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.59 2008/04/21 19:43:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -601,7 +601,9 @@ (or (eq xdim '*) (eql xdim adim))) dimension-spec (array-dimensions x))))))) - + +(defun arrayp (x) + (typep x 'array)) (define-simple-typep (atom atom) (x) (typep x 'atom)) @@ -706,6 +708,18 @@ (deftype float () 'real) +(deftype short-float () + 'real) + +(deftype long-float () + 'real) + +(deftype single-float () + 'real) + +(deftype double-float () + 'real) + (defun type-of (x) (class-name (class-of x)))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv26874 Modified Files: symbols.lisp Log Message: Check-type in gentemp. --- /project/movitz/cvsroot/movitz/losp/muerte/symbols.lisp 2008/04/09 18:02:31 1.30 +++ /project/movitz/cvsroot/movitz/losp/muerte/symbols.lisp 2008/04/21 19:43:47 1.31 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.30 2008/04/09 18:02:31 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.31 2008/04/21 19:43:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -247,6 +247,7 @@ (defvar *gentemp-counter* 0) (defun gentemp (&optional (prefix "T") (package *package*)) + (check-type prefix string) (intern (do ((name #0=(format nil "~A~D" prefix *gentemp-counter*) #0#)) ((not (find-symbol name package)) name) (incf *gentemp-counter*))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv26807 Modified Files: strings.lisp Log Message: Add deftype string-designator. --- /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp 2008/04/17 19:36:09 1.4 +++ /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp 2008/04/21 19:43:30 1.5 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 17:05:25 2001 ;;;; -;;;; $Id: strings.lisp,v 1.4 2008/04/17 19:36:09 ffjeld Exp $ +;;;; $Id: strings.lisp,v 1.5 2008/04/21 19:43:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -21,6 +21,9 @@ (in-package muerte) +(deftype string-designator () + '(or string symbol character)) + (defun string= (string1 string2 &key (start1 0) end1 (start2 0) end2) (setf string1 (string string1) end1 (or end1 (length string1)) @@ -56,7 +59,9 @@ (string name) (symbol (symbol-name name)) (character (make-string 1 :initial-element name)) - (t (error "Not a string designator: ~S" name)))) + (t (error 'type-error + :datum name + :expected-type 'string-designator)))) (defun make-string (size &key initial-element (element-type 'character)) (if (not initial-element)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv26713 Modified Files: streams.lisp Log Message: Various stream classes. --- /project/movitz/cvsroot/movitz/losp/muerte/streams.lisp 2006/04/10 11:57:24 1.5 +++ /project/movitz/cvsroot/movitz/losp/muerte/streams.lisp 2008/04/21 19:42:57 1.6 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Jun 30 14:33:15 2003 ;;;; -;;;; $Id: streams.lisp,v 1.5 2006/04/10 11:57:24 ffjeld Exp $ +;;;; $Id: streams.lisp,v 1.6 2008/04/21 19:42:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -129,3 +129,46 @@ (simple-stream (%finish-output stream))))) +(defclass string-stream (stream) ()) + +(defun make-string-input-stream (string &optional (start 0) (end nil)) + ) + +(defun make-string-output-stream ()) + + +(defclass broadcast-stream (stream) + ((streams + :reader concatenated-stream-streams + :initarg :streams))) + +(defclass concatenated-stream (stream) + ((streams + :reader concatenated-stream-streams + :initarg :streams))) + +(defclass echo-stream (stream) + ((input-stream + :reader echo-stream-input-stream + :initarg :input-stream) + (output-stream + :reader echo-stream-output-stream + :initarg :output-stream))) + +(defclass file-stream (stream) + ()) + +(defclass synonym-stream (stream) + ((symbol + :initarg :symbol + :reader synonym-stream-symbol))) + +(defclass two-way-stream (stream) + ((input + :initarg :input + :reader two-way-stream-input-stream) + (output + :initarg :output + :reader two-way-stream-output-stream))) + +

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv26648 Modified Files: ratios.lisp Log Message: Minor tweaks. --- /project/movitz/cvsroot/movitz/losp/muerte/ratios.lisp 2008/04/19 12:45:14 1.12 +++ /project/movitz/cvsroot/movitz/losp/muerte/ratios.lisp 2008/04/21 19:42:43 1.13 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 20 00:39:59 2004 ;;;; -;;;; $Id: ratios.lisp,v 1.12 2008/04/19 12:45:14 ffjeld Exp $ +;;;; $Id: ratios.lisp,v 1.13 2008/04/21 19:42:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -59,7 +59,8 @@ ((minusp denominator) (make-rational (- numerator) (- denominator))) ((= 0 denominator) - (error 'division-by-zero)) + (error 'division-by-zero + :operands (list numerator denominator))) (t (let ((gcd (gcd numerator denominator))) (if (= denominator gcd) (values (truncate numerator denominator)) @@ -78,22 +79,8 @@ ;;; "Floats" -(defconstant most-negative-short-float most-negative-fixnum) -(defconstant most-negative-single-float most-negative-fixnum) -(defconstant most-negative-long-float most-negative-fixnum) -(defconstant most-negative-double-float most-negative-fixnum) - -(defconstant least-positive-short-float 1/100000) -(defconstant least-positive-single-float 1/100000) -(defconstant least-positive-double-float 1/100000) -(defconstant least-positive-long-float 1/100000) - -;;; - (defconstant pi #xea7632a/4aa1a8b) -(defvar long-float-epsilon 1/10000) - (defun float (x &optional proto) (declare (ignore proto)) (check-type x float) @@ -137,7 +124,7 @@ (term 1 (/ (expt rad n2) denominator)) (sum 1 (+ sum (* sign term)))) - ((<= term long-float-epsilon) + ((<= term 1/100) sum))) (defun sin (x)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv26569 Modified Files: print.lisp Log Message: Printing of various quote syntaxes. --- /project/movitz/cvsroot/movitz/losp/muerte/print.lisp 2008/04/19 15:21:57 1.26 +++ /project/movitz/cvsroot/movitz/losp/muerte/print.lisp 2008/04/21 19:42:26 1.27 @@ -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.26 2008/04/19 15:21:57 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.27 2008/04/21 19:42:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -242,6 +242,19 @@ (not (cddr object))) (write-char #\' stream) (write (cadr object))) + ((and (eq 'backquote (car object)) + (not (cddr object))) + (write-char #\` stream) + (write (cadr object))) + ((and (eq 'backquote-comma (car object)) + (not (cddr object))) + (write-char #\, stream) + (write (cadr object))) + ((and (eq 'function (car object)) + (not (cddr object))) + (write-char #\# stream) + (write-char #\' stream) + (write (cadr object))) (t (labels ((write-cons (c stream length) (cond ((and length (= 0 length))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv26499 Modified Files: pathnames.lisp Log Message: Class pathname and logical-pathname. --- /project/movitz/cvsroot/movitz/losp/muerte/pathnames.lisp 2008/03/20 22:21:05 1.1 +++ /project/movitz/cvsroot/movitz/losp/muerte/pathnames.lisp 2008/04/21 19:42:06 1.2 @@ -6,16 +6,19 @@ ;;;; Author: Frode Vatvedt Fjeld ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: pathnames.lisp,v 1.1 2008/03/20 22:21:05 ffjeld Exp $ +;;;; $Id: pathnames.lisp,v 1.2 2008/04/21 19:42:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (require :muerte/basic-macros) -(require :muerte/defstruct) +(require :muerte/los-closette) (in-package muerte) (provide :muerte/pathnames) -(defstruct (pathname (:constructor make-pathname-object)) - name) +(defclass pathname () + ((name))) + +(defclass logical-pathname (pathname) + ())

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 21 Apr '08

21 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv26432 Modified Files: packages.lisp Log Message: Add make-package and delete-package. --- /project/movitz/cvsroot/movitz/losp/muerte/packages.lisp 2008/04/19 12:45:03 1.14 +++ /project/movitz/cvsroot/movitz/losp/muerte/packages.lisp 2008/04/21 19:41:52 1.15 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 30 15:19:43 2001 ;;;; -;;;; $Id: packages.lisp,v 1.14 2008/04/19 12:45:03 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.15 2008/04/21 19:41:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -25,14 +25,50 @@ (:constructor make-package-object) (:conc-name package-object-)) name - external-symbols - internal-symbols + (external-symbols (make-hash-table :test #'equal)) + (internal-symbols (make-hash-table :test #'equal)) shadowing-symbols-list use-list nicknames) (defvar *packages*) ; Set by dump-image. +(deftype package-designator () + '(or package string-designator)) + +(defun make-package (name &key nicknames use) + (let ((name* (string name)) + (nicknames* (mapcar #'string nicknames)) + (use* (mapcar #'find-package use))) + (when (some #'null use*) + (warn "Cannot use nonexisting package ~S." + (find-if-not #'find-package use)) + (setf use* (remove nil use*))) + (let ((existing-packages (remove-if-not #'find-package (cons name* nicknames*)))) + (when existing-packages + (cerror "Create the package anyway." + "There already exist package~P by the name~:P ~{~A~^ ~}." + (length existing-packages) + existing-packages))) + (let ((package (make-package-object :name name* + :use-list use* + :nicknames nicknames*))) + (dolist (nickname nicknames*) + (setf (gethash nickname *packages*) package)) + (setf (gethash name* *packages*) package)))) + +(defun delete-package (package) + (let ((package (find-package package))) + (when (and (package-name package) + (eq package (find-package (package-name package)))) + (dolist (nickname (package-nicknames package)) + (when (eq package (gethash nickname *packages*)) + (setf (gethash nickname *packages*) nil))) + (setf (gethash (package-name package) *packages*) + nil) + (setf (package-object-name package) nil) + t))) + (defun package-name (object) (package-object-name (find-package object))) @@ -45,9 +81,13 @@ (defun find-package (name) (typecase name (package name) - (null (find-package 'common-lisp)) ; This can be practical.. - ((or symbol string) (find-package-string (string name))) - (t (error "Not a package name: ~S" name)))) + (null + (find-package 'common-lisp)) ; This can be practical.. + (string-designator + (find-package-string (string name))) + (t (error 'type-error + :datum name + :expected-type 'package-designator)))) (defun find-package-string (name &optional (start 0) (end (length name)) (key 'identity)) (values (gethash-string name start end *packages* nil key)))

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
260
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs