movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

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

06 May '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14898 Modified Files: lists.lisp Log Message: Moved adjoin to cons.lisp. --- /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2006/05/06 19:36:50 1.17 +++ /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2006/05/06 20:30:54 1.18 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.17 2006/05/06 19:36:50 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.18 2006/05/06 20:30:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -442,10 +442,4 @@ (unless (member x list-2 :key key :test test) (return nil))))) -(defun adjoin (item list &key (key 'identity) (test 'eql) test-not) - "=> new-list" - (let ((test (if test-not (complement test-not) test))) - (if (member (funcall key item) list :test test) - list - (cons item list))))

1 0

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

06 May '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14881 Modified Files: cons.lisp Log Message: Moved adjoin to cons.lisp. --- /project/movitz/cvsroot/movitz/losp/muerte/cons.lisp 2006/05/02 20:01:01 1.15 +++ /project/movitz/cvsroot/movitz/losp/muerte/cons.lisp 2006/05/06 20:30:53 1.16 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 15:25:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: cons.lisp,v 1.15 2006/05/02 20:01:01 ffjeld Exp $ +;;;; $Id: cons.lisp,v 1.16 2006/05/06 20:30:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -375,3 +375,12 @@ (defun nsubst-if-not (new predicate tree &key key) (nsubst-if new (complement predicate) tree :key key)) + + +(defun adjoin (item list &key key (test 'eql) test-not) + "=> new-list + Tests whether item is the same as an existing element of list. If the item is not an existing element, adjoin adds it to +list (as if by cons) and returns the resulting list; otherwise, nothing is added and the original list is returned." + (if (member item list :key key :test test :test-not test-not) + list + (cons item list)))

1 0

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

06 May '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv13407 Modified Files: typep.lisp Log Message: Tweak etypecase-error. --- /project/movitz/cvsroot/movitz/losp/muerte/typep.lisp 2006/04/10 11:58:15 1.53 +++ /project/movitz/cvsroot/movitz/losp/muerte/typep.lisp 2006/05/06 20:29:10 1.54 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.53 2006/04/10 11:58:15 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.54 2006/05/06 20:29:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -38,11 +38,10 @@ else collect `((typep ,key-var ',type) ,@forms))))))) (defmacro etypecase (keyform &rest clauses) - `(typecase ,keyform ,@clauses - (t (error "~S fell through an etypecase where the legal types were ~S." - ,keyform - ',(loop for c in clauses - collect (car c)))))) + (let ((key-var (make-symbol "etypecase-key-var-"))) + `(let ((,key-var ,keyform)) + (typecase ,key-var ,@clauses + (t (etypecase-error ,key-var ',(loop for c in clauses collect (car c)))))))) (define-compile-time-variable *simple-typespecs* ;; map symbol typespecs to typep-functions.

1 0

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

06 May '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv13391 Modified Files: conditions.lisp Log Message: Tweak etypecase-error. --- /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2006/04/28 23:21:59 1.19 +++ /project/movitz/cvsroot/movitz/losp/muerte/conditions.lisp 2006/05/06 20:29:08 1.20 @@ -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.19 2006/04/28 23:21:59 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.20 2006/05/06 20:29:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -115,6 +115,18 @@ (type-error-datum c) (type-error-expected-type c))))) +(define-condition etypecase-error (type-error) + () + (:report (lambda (c s) + (format s "The object '~S' fell through an etypecase where the legal types were ~S." + (type-error-datum c) + (type-error-expected-type c))))) + +(defun etypecase-error (datum expecteds) + (error 'etypecase-error + :datum datum + :expected-type (cons 'or expecteds))) + (define-condition control-error (error) ()) (define-condition throw-error (control-error)

1 0

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

06 May '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv8161 Modified Files: lists.lisp Log Message: For member, apply key to item too. --- /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2006/05/05 21:39:02 1.16 +++ /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2006/05/06 19:36:50 1.17 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.16 2006/05/05 21:39:02 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.17 2006/05/06 19:36:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -125,7 +125,7 @@ (with-funcallable (test (or (and test-not (complement test-not)) test)) (do ((p list (cdr p))) ((endp p) nil) - (when (test item (key (car p))) + (when (test (key item) (key (car p))) (return p))))))))) (defun last (list &optional (n 1))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 05 May '06

05 May '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv4536 Modified Files: lists.lisp Log Message: Added test-not to member. --- /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2006/05/03 22:20:02 1.15 +++ /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2006/05/05 21:39:02 1.16 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.15 2006/05/03 22:20:02 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.16 2006/05/05 21:39:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -112,17 +112,17 @@ ;; That fact justifies this implementation.) (when (and (eq fast slow) (> n 0)) (return nil)))) -(defun member (item list &key key (test 'eql)) +(defun member (item list &key key (test 'eql) test-not) (numargs-case (2 (item list) (do ((p list (cdr p))) ((endp p) nil) (when (eql item (car p)) (return p)))) - (t (item list &key key (test 'eql)) + (t (item list &key key (test 'eql) test-not) (let ((key (or key 'identity))) (with-funcallable (key) - (with-funcallable (test) + (with-funcallable (test (or (and test-not (complement test-not)) test)) (do ((p list (cdr p))) ((endp p) nil) (when (test item (key (car p)))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 05 May '06

05 May '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv30338 Modified Files: more-macros.lisp Log Message: Fixed member compiler-macro: apply key to both list and item. --- /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp 2006/05/05 18:33:08 1.34 +++ /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp 2006/05/05 20:42:04 1.35 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.34 2006/05/05 18:33:08 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.35 2006/05/05 20:42:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -162,7 +162,7 @@ `(do ((item ,item) (p ,list (cdr p))) ((endp p) nil) - (when (,test (,key item) (car p)) + (when (,test (,key item) (,key (car p))) (return p)))) (t form))))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 05 May '06

05 May '06

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv16312 Modified Files: interrupt.lisp Log Message: Have int 102 signal missing keyword argument error. --- /project/movitz/cvsroot/movitz/losp/muerte/interrupt.lisp 2006/05/02 20:03:15 1.50 +++ /project/movitz/cvsroot/movitz/losp/muerte/interrupt.lisp 2006/05/05 18:39:52 1.51 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.50 2006/05/02 20:03:15 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.51 2006/05/05 18:39:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -395,6 +395,10 @@ (error 'program-error :format-control "Illegal keyword argument [eax: ~S]" :format-arguments (list (dereference $eax)))) + (102 + (error 'program-error + :format-control "Missing keyword argument for ~S." + :format-arguments (list (dereference (+ dit-frame (dit-frame-index :esi)))))) (108 (error 'throw-error :tag (dereference $eax))) (110

1 0

[movitz-cvs] CVS movitz
by ffjeld 05 May '06

05 May '06

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv16205 Modified Files: parse.lisp Log Message: For &key args parsing, check that we have an even number of keyword/value args. --- /project/movitz/cvsroot/movitz/parse.lisp 2004/12/09 14:09:58 1.5 +++ /project/movitz/cvsroot/movitz/parse.lisp 2006/05/05 18:37:37 1.6 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:49:17 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: parse.lisp,v 1.5 2004/12/09 14:09:58 ffjeld Exp $ +;;;; $Id: parse.lisp,v 1.6 2006/05/05 18:37:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -145,8 +145,8 @@ (key () '(fourth program)) (aux () '(fifth program)) (allow-other-keys () '(if host-symbols-p - '&allow-other-keys - 'muerte.cl::&allow-other-keys))) + '&allow-other-keys + 'muerte.cl::&allow-other-keys))) (loop for formal in lambda-list with program = (if host-symbols-p '(requireds &optional &rest &key &aux) @@ -177,19 +177,29 @@ (auxes (nreverse (getf results (aux))))) (when (> (length rests) 1) (error "There can only be one &REST formal parameter.")) - (return (values requireds - optionals - (first rests) - keys - auxes - allow-other-keys-p - (length requireds) ; minimum num. of arguments - (and (null rests) ; max num. of arguments, or nil. + (let ((maxargs (and (null rests) ; max num. of arguments, or nil. + (null keys) (not allow-other-keys-p) (+ (length requireds) - (length optionals) - (* 2 (length keys)))) - edx-var))))))) + (length optionals)))) + (minargs (length requireds))) + (return (values requireds + optionals + (first rests) + keys + auxes + allow-other-keys-p + minargs + maxargs + edx-var + (cond + ((or (eql maxargs minargs) + (eq :no-key (getf results (key) :no-key))) + nil) + ((assert (not maxargs))) + ((evenp (+ (length requireds) (length optionals))) + :even) + (t :odd)))))))))) (defun decode-optional-formal (formal) "3.4.1.2 Specifiers for optional parameters.

1 0

[movitz-cvs] CVS movitz
by ffjeld 05 May '06

05 May '06

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv16191 Modified Files: environment.lisp Log Message: For &key args parsing, check that we have an even number of keyword/value args. --- /project/movitz/cvsroot/movitz/environment.lisp 2005/10/31 20:30:32 1.15 +++ /project/movitz/cvsroot/movitz/environment.lisp 2006/05/05 18:37:34 1.16 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 3 11:40:15 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: environment.lisp,v 1.15 2005/10/31 20:30:32 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.16 2006/05/05 18:37:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -186,6 +186,9 @@ (max-args :initform nil :accessor max-args) + (oddeven-args + :initform nil + :accessor oddeven-args) (allow-other-keys-p :accessor allow-other-keys-p) (edx-var

1 0

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