remove pamphlets - part 3

1 files changed, 0 insertions, 247 deletions

diff --git a/src/interp/domain.lisp.pamphlet b/src/interp/domain.lisp.pamphlet
deleted file mode 100644
index 775f3526..00000000
--- a/src/interp/domain.lisp.pamphlet
+++ /dev/null
@@ -1,247 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp domain.lisp}
-\author{Timothy Daly}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<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.
-
-@
-<<*>>=
-<<license>>
-
-;; lisp support for creating domain stubs
-
-(in-package "BOOT")
-;;(SETQ |$optimizableConstructorNames| nil)
-
-(defstruct domain constructor args
-  (dollar (check-dollar-fields constructor args)))
-
-(defstruct (old-compiler-domain (:include domain) (:conc-name oldom-))
-  (devaluate (if dollar (|devaluate| dollar)
-	       (CONS constructor (MAPCAR #'|devaluate| args))))
-  (vector nil))  
-
-(defun check-dollar-fields (constructor arglist)
-  (if (some #'(lambda (x) (and (domain-p x) (domain-dollar x))) arglist)
-      (apply constructor (mapcar #'(lambda (x) (if (domain-p x)
-						   (or (domain-dollar x) x)
-						 x)) arglist))
-    nil))
-
-(defun |domain?| (x) (domain-p x))
-
-(defun |Mapping| (&rest args)
-  (make-old-compiler-domain :constructor '|Mapping| :args args
-			    :vector '|Mapping0|))
-
-(defun |Record| (&rest args)
-  (make-old-compiler-domain :constructor '|Record| :args args
-			    :vector '|Record0|))
-
-(defun |Union| (&rest args)
-  (make-old-compiler-domain :constructor '|Union| :args args
-			    :vector '|Union0|))
-
-(defun |devaluate| (x &aux tag dom)
-  (cond ((REFVECP x)
-	 (if (> (QVSIZE x) 5)
-	     (cond ((equal (qvelt x 3) '(|Category|))
-		    (qvelt x 0))
-;; next line will become obsolete
-		   ((|isFunctor| (qvelt x 0)) (qvelt x 0))
-		   ((domain-p (qvelt x 0)) (|devaluate| (qvelt x 0)))
-		   (t x))
-	     x))
-	((and (pairp x) (eq (car x) '|:|) (dcq (tag dom) (cdr x)))
-	 (list (car x) tag (|devaluate| dom)))
-; 20030527 note that domain-p does not exist
-	((not (domain-p x)) x)
-; 20030527 note that old-compiler-domain-p does not exist
-	((old-compiler-domain-p x) (oldom-devaluate x))
-	(t (error "devaluate of new compiler domain"))))
-
-(defun |domainEqual| (x y)
-  (cond ((old-compiler-domain-p x)
-	 (if (old-compiler-domain-p y)
-	     (equalp (oldom-devaluate x) (oldom-devaluate y))
-	     nil))
-	((old-compiler-domain-p y) nil)
-	(t (error "no new compiler domains yet"))))
-
-(defun |domainSelectDollar| (dom)
-  (or (domain-dollar dom) dom))
-
-(defun |domainSetDollar| (dom dollar)
-  (setf (domain-dollar dom) dollar)
-  (if (old-compiler-domain-p dom)
-      (setf (oldom-devaluate dom) (|devaluate| dollar))))
-
-(defun |domainSelectVector| (dom)
-  (let ((vec (oldom-vector dom)))
-    (cond ((vectorp vec) vec)
-	  ((null vec) nil)
-	  ((symbolp vec) ;; case for Records and Unions
-	   (setq vec (funcall vec (domain-args dom)))
-	   (setf (elt vec 0) dom)
-	   (setf (oldom-vector dom) vec))
-	  ((or (fboundp (car vec))
-	       (|loadLib| (cdr vec)) t)
-	   (instantiate (car vec) dom)))))
-
-;;(defun instantiate (innername dom) 
-;;  (let ((vec (apply innername (domain-args dom))))
-;;    (setelt vec 0 dom)
-;;    (setf (oldom-vector dom) vec)
-;;    vec))
-
-(defun instantiate (innername dom)
-  (let* ((infovec (get (domain-constructor dom) '|infovec|))
-	 (|$dollarVec| (getrefv (size (car infovec )))))
-    (declare (special |$dollarVec|))
-    (setf (elt |$dollarVec| 0) dom)
-    (setf (elt |$dollarVec| 1)
-	  (list (symbol-function (|getLookupFun| infovec))
-		|$dollarVec|
-		(elt infovec 1)))
-    (setf (elt |$dollarVec| 2) (elt infovec 2))
-    (setf (oldom-vector dom) |$dollarVec|)
-    (apply innername (domain-args dom))
-    |$dollarVec|))
-  
-(defun universal-domain-constructor (&rest args-env)
-  (let* ((args (fix-domain-args (butlast args-env)))
-	 (env (car (last args-env))))
-    (check-constructor-cache env args)))
-
-(defun fix-domain-args (args)
-  (mapcar #'(lambda (x) (if (and (vectorp x) (domain-p (elt x 0)))
-			    (elt x 0) x)) args))
-
-(defun universal-nocache-domain-constructor (&rest args-env)
-  (let* ((args (butlast args-env))
-	 (env (car (last args-env))))
-    (make-old-compiler-domain :constructor (car env)
-			      :args args
-			      :vector (cdr env))))
-
-(defun universal-category-defaults-constructor (&rest args-env)
-  (let* ((args (butlast args-env))
-	 (env (car (last args-env))))
-    (make-old-compiler-domain :constructor (car env)
-			      :args args
-			      :dollar (car args)
-			      :vector (cdr env))))
-
-(defun cached-constructor (cname)
-  (if (or (|isCategoryPackageName| cname)
-	  (and (boundp '|$mutableDomains|)
-	       (memq cname |$mutableDomains|)))
-      nil
-    t))
-
-(defun |makeDomainStub| (con) 
-  (|systemDependentMkAutoload| (|constructor?| con) con))
-
-(defun |mkAutoLoad| (fn cname)
-  (cond ((or (memq cname |$CategoryNames|)
-	  (eq (GETDATABSE cname 'CONSTRUCTORKIND) '|category|))
-	 (function (lambda (&rest args)
-		     (|autoLoad| fn cname)
-		     (apply cname args))))
-	(t (|systemDependentMkAutoload| fn cname)
-	   (symbol-function cname))))
-
-(defun |systemDependentMkAutoload| (fn cname)
-  (let* ((cnameInner (intern (strconc cname ";")))
-	 (env (list* cname cnameInner fn))
-	 (spadfun
-	  (cond ((|isCategoryPackageName| cname)
-		 (cons #'universal-category-defaults-constructor env))
-		((and (boundp '|$mutableDomains|)
-		      (memq cname |$mutableDomains|))
-		 (cons #'universal-nocache-domain-constructor env))
-		(t (cons #'universal-domain-constructor env)))))
-    (setf (symbol-function cname) (mkConstructor spadfun))
-    (set cname spadfun)))
-
-(defun mkConstructor (spadfun)
-   (function (lambda (&rest args)
-	       (apply (car spadfun) (append args (list (cdr spadfun)))))))
-
-(defun |makeAddDomain| (add-domain dollar)
-  (cond ((old-compiler-domain-p add-domain)
-	 (make-old-compiler-domain :constructor (domain-constructor add-domain)
-			    :args (domain-args add-domain)
-			    :dollar dollar
-			    :vector (cddr (eval (domain-constructor add-domain)))))
-	(t (error "no new compiler adds supported yet"))))
-
-(defun check-constructor-cache (env arglist)
-  (let ((dollar (check-dollar-fields (car env) arglist)))
-    (if dollar (make-old-compiler-domain :constructor (car env)
-					 :args arglist
-					 :dollar dollar
-					 :vector (cdr env))
-      (let* ((constructor (car env))
-	     (devargs (mapcar #'|devaluate| arglist))
-	     (cacheddom
-	      (|lassocShiftWithFunction| devargs
-	       (HGET |$ConstructorCache| constructor)
-	       #'|domainEqualList|)))
-	(if cacheddom (|CDRwithIncrement| cacheddom)
-	  (cdr (|haddProp| |$ConstructorCache| constructor devargs
-		(cons 1 (make-old-compiler-domain :constructor constructor
-						  :args arglist
-						  :devaluate
-						  (cons constructor devargs)
-						  :vector (cdr env))))))))))
-
-
-
-
-	  
-	 
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}