diff --git a/changelog b/changelog index a6ab366..fea51da 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +20090805 tpd src/axiom-website/patches.html 20090805.01.tpd.patch +20090805 tpd src/interp/debugsys.lisp remove hash.lisp reference +20090805 tpd src/interp/Makefile remove hash.lisp +20090805 tpd src/interp/vmlisp.lisp merge hash.lisp +20090805 tpd src/interp/hash.lisp removed, merged with vmlisp.lisp 20090804 tpd src/axiom-website/patches.html 20090804.01.tpd.patch 20090804 tpd src/interp/Makefile remove ggreater.lisp 20090804 tpd src/interp/debugsys.lisp remove ggreater.lisp reference diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index cd4b87a..ad85d55 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1740,6 +1740,8 @@ src/interp/vmlisp.lisp rewrite to remove chunks
Makefile make parallel make the default (bug 7202)
20090804.01.tpd.patch vmlisp.lisp and ggreater.lisp merged
+20090805.01.tpd.patch +vmlisp.lisp and hash.lisp merged
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 2ff69b5..12d6fc1 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -128,7 +128,7 @@ expanded in later compiles. All macros are assumed to be in this list of files. <>= DEP= ${MID}/vmlisp.lisp \ - ${MID}/hash.lisp ${MID}/bootfuns.lisp \ + ${MID}/bootfuns.lisp \ ${MID}/union.lisp ${MID}/nlib.lisp \ ${MID}/macros.lisp ${MID}/comp.lisp \ ${MID}/spaderror.lisp ${MID}/debug.lisp \ diff --git a/src/interp/debugsys.lisp.pamphlet b/src/interp/debugsys.lisp.pamphlet index cb75b4f..8d1eb0f 100644 --- a/src/interp/debugsys.lisp.pamphlet +++ b/src/interp/debugsys.lisp.pamphlet @@ -85,7 +85,6 @@ loaded by hand we need to establish a value. (append (list (thesymb "/int/interp/vmlisp.lisp") - (thesymb "/int/interp/hash.lisp") (thesymb "/int/interp/bootfuns.lisp") (thesymb "/int/interp/macros.lisp") (thesymb "/int/interp/unlisp.lisp") diff --git a/src/interp/hash.lisp.pamphlet b/src/interp/hash.lisp.pamphlet deleted file mode 100644 index a47f26c..0000000 --- a/src/interp/hash.lisp.pamphlet +++ /dev/null @@ -1,151 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp hash.lisp} -\author{Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= -;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -;; All rights reserved. -;; -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions are -;; met: -;; -;; - Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; -;; - Redistributions in binary form must reproduce the above copyright -;; notice, this list of conditions and the following disclaimer in -;; the documentation and/or other materials provided with the -;; distribution. -;; -;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the -;; names of its contributors may be used to endorse or promote products -;; derived from this software without specific prior written permission. -;; -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -(in-package "VMLISP") - -(export '(MAKE-HASHTABLE HGET HKEYS HCOUNT HPUT HPUT* HREM HCLEAR HREMPROP - HASHEQ HASHUEQUAL HASHCVEC HASHID HASHTABLEP CVEC UEQUAL ID HPUTPROP - HASHTABLE-CLASS)) - -;17.0 Operations on Hashtables -;17.1 Creation - -(defun MAKE-HASHTABLE (id1 &optional (id2 nil)) - (declare (ignore id2)) - (let ((test (case id1 - ((EQ ID) #'eq) - (CVEC #'equal) - (EQL #'eql) - #+Lucid ((UEQUAL EQUALP) #'EQUALP) - #-Lucid ((UEQUAL EQUAL) #'equal) - (otherwise (error "bad arg to make-hashtable"))))) - (make-hash-table :test test))) - -;17.2 Accessing - -(defmacro HGET (table key &rest default) - `(gethash ,key ,table ,@default)) - -(defun HKEYS (table) - (let (keys) - (maphash - #'(lambda (key val) (declare (ignore val)) (push key keys)) table) - keys)) - -#+Lucid -(define-function 'HASHTABLE-CLASS #'system::hash-table-test) - -@ -The static declaration causes a problem as of GCL-2.6.8pre. -Camm issued a fix. This used to read: -\begin{verbatim} -#+AKCL -(clines "static int mem_value(x ,i)object x;int i; { return ((short *)x)[i];}") -\end{verbatim} -<<*>>= -#+AKCL -(clines "int mem_value(x ,i)object x;int i; { return ((short *)x)[i];}") - -#+AKCL -(defentry memory-value-short(object int) (int "mem_value")) - -;(memory-value-short (make-hash-table :test 'equal) 12) is 0,1,or 2 -;depending on whether the test is eq,eql or equal. -#+AKCL -(defun HASHTABLE-CLASS (table) - (case (memory-value-short table 12) - (0 'EQ) - (1 'EQL) - (2 'EQUAL) - (t "error unknown hash table class"))) - -#+:CCL -(defun HASHTABLE-CLASS (table) - (case (hashtable-flavour table) - (0 'EQ) - (1 'EQL) - (2 'EQUAL) - (t (format nil "error unknown hash table class ~a" (hashtable-flavour table))))) - -(define-function 'HCOUNT #'hash-table-count) - -;17.4 Searching and Updating - -(defun HPUT (table key value) (setf (gethash key table) value)) - -(defun HPUT* (table alist) - (mapc #'(lambda (pair) (hput table (car pair) (cdr pair))) alist)) - -(defmacro HREM (table key) `(remhash ,key ,table)) - -(defun HREMPROP (table key property) - (let ((plist (gethash key table))) - (if plist (setf (gethash key table) - (delete property plist :test #'equal :key #'car))))) - -;17.5 Updating - -(define-function 'HCLEAR #'clrhash) - -;17.6 Miscellaneous - -(define-function 'HASHTABLEP #'hash-table-p) - -(define-function 'HASHEQ #'sxhash) - -(define-function 'HASHUEQUAL #'sxhash) - -(define-function 'HASHCVEC #'sxhash) - -(define-function 'HASHID #'sxhash) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 5d2e28d..70d05c0 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -27,6 +27,10 @@ (in-package "VMLISP") +(export '(MAKE-HASHTABLE HGET HKEYS HCOUNT HPUT HPUT* HREM HCLEAR HREMPROP + HASHEQ HASHUEQUAL HASHCVEC HASHID HASHTABLEP CVEC UEQUAL ID HPUTPROP + HASHTABLE-CLASS)) + #-:common-lisp (setq *features* (adjoin :common-lisp *features*)) @@ -2051,6 +2055,97 @@ and works properly. (defvar SORTGREATERP #'GGREATERP "default sorting predicate") +;17.0 Operations on Hashtables +;17.1 Creation + +(defun MAKE-HASHTABLE (id1 &optional (id2 nil)) + (declare (ignore id2)) + (let ((test (case id1 + ((EQ ID) #'eq) + (CVEC #'equal) + (EQL #'eql) + #+Lucid ((UEQUAL EQUALP) #'EQUALP) + #-Lucid ((UEQUAL EQUAL) #'equal) + (otherwise (error "bad arg to make-hashtable"))))) + (make-hash-table :test test))) + +;17.2 Accessing + +(defmacro HGET (table key &rest default) + `(gethash ,key ,table ,@default)) + +(defun HKEYS (table) + (let (keys) + (maphash + #'(lambda (key val) (declare (ignore val)) (push key keys)) table) + keys)) + +#+Lucid +(define-function 'HASHTABLE-CLASS #'system::hash-table-test) + +@ +The static declaration causes a problem as of GCL-2.6.8pre. +Camm issued a fix. This used to read: +\begin{verbatim} +#+AKCL +(clines "static int mem_value(x ,i)object x;int i; { return ((short *)x)[i];}") +\end{verbatim} +<<*>>= +#+AKCL +(clines "int mem_value(x ,i)object x;int i; { return ((short *)x)[i];}") + +#+AKCL +(defentry memory-value-short(object int) (int "mem_value")) + +;(memory-value-short (make-hash-table :test 'equal) 12) is 0,1,or 2 +;depending on whether the test is eq,eql or equal. +#+AKCL +(defun HASHTABLE-CLASS (table) + (case (memory-value-short table 12) + (0 'EQ) + (1 'EQL) + (2 'EQUAL) + (t "error unknown hash table class"))) + +#+:CCL +(defun HASHTABLE-CLASS (table) + (case (hashtable-flavour table) + (0 'EQ) + (1 'EQL) + (2 'EQUAL) + (t (format nil "error unknown hash table class ~a" (hashtable-flavour table))))) + +(define-function 'HCOUNT #'hash-table-count) + +;17.4 Searching and Updating + +(defun HPUT (table key value) (setf (gethash key table) value)) + +(defun HPUT* (table alist) + (mapc #'(lambda (pair) (hput table (car pair) (cdr pair))) alist)) + +(defmacro HREM (table key) `(remhash ,key ,table)) + +(defun HREMPROP (table key property) + (let ((plist (gethash key table))) + (if plist (setf (gethash key table) + (delete property plist :test #'equal :key #'car))))) + +;17.5 Updating + +(define-function 'HCLEAR #'clrhash) + +;17.6 Miscellaneous + +(define-function 'HASHTABLEP #'hash-table-p) + +(define-function 'HASHEQ #'sxhash) + +(define-function 'HASHUEQUAL #'sxhash) + +(define-function 'HASHCVEC #'sxhash) + +(define-function 'HASHID #'sxhash) (in-package 'boot)