diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index 7cb8614..bf39800 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -5997,6 +5997,26 @@ of the symbol being parsed. The original list read:
\end{chunk}
\chapter{Compile Transformers}
+
+\defdollar{NoValueMode}
+\begin{chunk}{initvars}
+(defvar |$NoValueMode| '|NoValueMode|)
+
+\end{chunk}
+
+\defdollar{EmptyMode}
+\verb|$EmptyMode| is a contant whose value is \verb|$EmptyMode|.
+It is used by isPartialMode to
+decide if a modemap is partially constructed. If the \verb|$EmptyMode|
+constant occurs anywhere in the modemap structure at any depth
+then the modemap is still incomplete. To find this constant the
+isPartialMode function calls CONTAINED \verb|$EmptyMode| $Y$
+which will walk the structure $Y$ looking for this constant.
+\begin{chunk}{initvars}
+(defvar |$EmptyMode| '|EmptyMode|)
+
+\end{chunk}
+
\section{Routines for handling forms}
The functions in this section are called through the symbol-plist
of the symbol being parsed.
@@ -9497,25 +9517,6 @@ in the body of the add.
\end{chunk}
-\defplist{@}{compAtSign plist}
-\begin{chunk}{postvars}
-(eval-when (eval load)
- (setf (get '|@| 'special) 'compAtSign))
-
-\end{chunk}
-
-\defun{compAtSign}{compAtSign}
-\calls{compAtSign}{addDomain}
-\calls{compAtSign}{comp}
-\calls{compAtSign}{coerce}
-\begin{chunk}{defun compAtSign}
-(defun compAtSign (form mode env)
- (let ((newform (second form)) (mprime (third form)) tmp)
- (setq env (|addDomain| mprime env))
- (when (setq tmp (|comp| newform mprime env)) (|coerce| tmp mode))))
-
-\end{chunk}
-
\defplist{capsule}{compCapsule plist}
\begin{chunk}{postvars}
(eval-when (eval load)
@@ -9726,70 +9727,6 @@ An angry JHD - August 15th., 1984
\end{chunk}
-\defplist{::}{compCoerce plist}
-\begin{chunk}{postvars}
-(eval-when (eval load)
- (setf (get '|::| 'special) '|compCoerce|))
-
-\end{chunk}
-
-\defun{compCoerce}{compCoerce}
-\calls{compCoerce}{addDomain}
-\calls{compCoerce}{getmode}
-\calls{compCoerce}{compCoerce1}
-\calls{compCoerce}{coerce}
-\begin{chunk}{defun compCoerce}
-(defun |compCoerce| (form mode env)
- (let (newform newmode tmp1 tmp4 z td)
- (setq newform (second form))
- (setq newmode (third form))
- (setq env (|addDomain| newmode env))
- (setq tmp1 (|getmode| newmode env))
- (cond
- ((setq td (|compCoerce1| newform newmode env))
- (|coerce| td mode))
- ((and (pairp tmp1) (eq (qcar tmp1) '|Mapping|)
- (pairp (qcdr tmp1)) (eq (qcdr (qcdr tmp1)) nil)
- (pairp (qcar (qcdr tmp1)))
- (eq (qcar (qcar (qcdr tmp1))) '|UnionCategory|))
- (setq z (qcdr (qcar (qcdr tmp1))))
- (when
- (setq td
- (dolist (mode1 z tmp4)
- (setq tmp4 (or tmp4 (|compCoerce1| newform mode1 env)))))
- (|coerce| (list (car td) newmode (third td)) mode))))))
-
-\end{chunk}
-
-\defun{compCoerce1}{compCoerce1}
-\calls{compCoerce1}{comp}
-\calls{compCoerce1}{resolve}
-\calls{compCoerce1}{coerce}
-\calls{compCoerce1}{coerceByModemap}
-\calls{compCoerce1}{msubst}
-\calls{compCoerce1}{mkq}
-\begin{chunk}{defun compCoerce1}
-(defun |compCoerce1| (form mode env)
- (let (m1 td tp gg pred code)
- (declare (special |$String| |$EmptyMode|))
- (when (setq td (or (|comp| form mode env) (|comp| form |$EmptyMode| env)))
- (setq m1 (if (stringp (second td)) |$String| (second td)))
- (setq mode (|resolve| m1 mode))
- (setq td (list (car td) m1 (third td)))
- (cond
- ((setq tp (|coerce| td mode)) tp)
- ((setq tp (|coerceByModemap| td mode)) tp)
- ((setq pred (|isSubset| mode (second td) env))
- (setq gg (gensym))
- (setq pred (msubst gg '* pred))
- (setq code
- (list 'prog1
- (list 'let gg (first td))
- (cons '|check-subtype| (cons pred (list (mkq mode) gg)))))
- (list code mode (third td)))))))
-
-\end{chunk}
-
\defplist{:}{compColon plist}
\begin{chunk}{postvars}
(eval-when (eval load)
@@ -10459,195 +10396,6 @@ An angry JHD - August 15th., 1984
\end{chunk}
-\defun{coerce}{coerce}
-The function coerce is used by the old compiler for coercions.
-The function coerceInteractive is used by the interpreter.
-One should always call the correct function, since the representation
-of basic objects may not be the same.
-\calls{coerce}{keyedSystemError}
-\calls{coerce}{rplac}
-\calls{coerce}{msubst}
-\calls{coerce}{coerceEasy}
-\calls{coerce}{coerceSubset}
-\calls{coerce}{coerceHard}
-\calls{coerce}{isSomeDomainVariable}
-\calls{coerce}{stackMessage}
-\refsdollar{coerce}{InteractiveMode}
-\refsdollar{coerce}{Rep}
-\refsdollar{coerce}{fromCoerceable}
-\begin{chunk}{defun coerce}
-(defun |coerce| (tt mode)
- (labels (
- (fn (x m1 m2)
- (list '|Cannot coerce| '|%b| x '|%d| '|%l| '| of mode| '|%b| m1
- '|%d| '|%l| '| to mode| '|%b| m2 '|%d|)))
- (let (tp)
- (declare (special |$fromCoerceable$| |$Rep| |$InteractiveMode|))
- (if |$InteractiveMode|
- (|keyedSystemError| 'S2GE0016
- (list "coerce" "function coerce called from the interpreter."))
- (progn
- (|rplac| (cadr tt) (msubst '$ |$Rep| (cadr tt)))
- (cond
- ((setq tp (|coerceEasy| tt mode)) tp)
- ((setq tp (|coerceSubset| tt mode)) tp)
- ((setq tp (|coerceHard| tt mode)) tp)
- ((or (eq (car tt) '|$fromCoerceable$|) (|isSomeDomainVariable| mode)) nil)
- (t (|stackMessage| (fn (first tt) (second tt) mode)))))))))
-
-\end{chunk}
-
-\defun{coerceEasy}{coerceEasy}
-\calls{coerceEasy}{modeEqualSubst}
-\refsdollar{coerceEasy}{EmptyMode}
-\refsdollar{coerceEasy}{Exit}
-\refsdollar{coerceEasy}{NoValueMode}
-\refsdollar{coerceEasy}{Void}
-\begin{chunk}{defun coerceEasy}
-(defun |coerceEasy| (tt m)
- (declare (special |$EmptyMode| |$Exit| |$NoValueMode| |$Void|))
- (cond
- ((equal m |$EmptyMode|) tt)
- ((or (equal m |$NoValueMode|) (equal m |$Void|))
- (list (car tt) m (third tt)))
- ((equal (second tt) m) tt)
- ((equal (second tt) |$NoValueMode|) tt)
- ((equal (second tt) |$Exit|)
- (list
- (list 'progn (car tt) (list '|userError| "Did not really exit."))
- m (third tt)))
- ((or (equal (second tt) |$EmptyMode|)
- (|modeEqualSubst| (second tt) m (third tt)))
- (list (car tt) m (third tt)))))
-
-\end{chunk}
-
-\defun{coerceSubset}{coerceSubset}
-\calls{coerceSubset}{isSubset}
-\calls{coerceSubset}{lassoc}
-\calls{coerceSubset}{get}
-\calls{coerceSubset}{opOf}
-\calls{coerceSubset}{eval}
-\calls{coerceSubset}{msubst}
-\calls{coerceSubset}{isSubset}
-\calls{coerceSubset}{maxSuperType}
-\begin{chunk}{defun coerceSubset}
-(defun |coerceSubset| (arg1 mp)
- (let (x m env tmp1 pred)
- (setq x (first arg1))
- (setq m (second arg1))
- (setq env (third arg1))
- (cond
- ((or (|isSubset| m mp env) (and (eq m '|Rep|) (eq mp '$)))
- (list x mp env))
- ((and (pairp m) (eq (qcar m) '|SubDomain|)
- (pairp (qcdr m)) (equal (qcar (qcdr m)) mp))
- (list x mp env))
- ((and (setq pred (lassoc (|opOf| mp) (|get| (|opOf| m) '|SubDomain| env)))
- (integerp x) (|eval| (msubst x '|#1| pred)))
- (list x mp env))
- ((and (setq pred (|isSubset| mp (|maxSuperType| m env) env))
- (integerp x) (|eval| (msubst x '* pred)))
- (list x mp env))
- (t nil))))
-
-\end{chunk}
-
-\defun{coerceHard}{coerceHard}
-\calls{coerceHard}{modeEqual}
-\calls{coerceHard}{get}
-\calls{coerceHard}{getmode}
-\calls{coerceHard}{isCategoryForm}
-\calls{coerceHard}{extendsCategoryForm}
-\calls{coerceHard}{coerceExtraHard}
-\defsdollar{coerceHard}{e}
-\refsdollar{coerceHard}{e}
-\refsdollar{coerceHard}{String}
-\refsdollar{coerceHard}{bootStrapMode}
-\begin{chunk}{defun coerceHard}
-(defun |coerceHard| (tt m)
- (let (|$e| mp tmp1 mpp)
- (declare (special |$e| |$String| |$bootStrapMode|))
- (setq |$e| (third tt))
- (setq mp (second tt))
- (cond
- ((and (stringp mp) (|modeEqual| m |$String|))
- (list (car tt) m |$e|))
- ((or (|modeEqual| mp m)
- (and (or (progn
- (setq tmp1 (|get| mp '|value| |$e|))
- (and (pairp tmp1)
- (progn (setq mpp (qcar tmp1)) t)))
- (progn
- (setq tmp1 (|getmode| mp |$e|))
- (and (pairp tmp1)
- (eq (qcar tmp1) '|Mapping|)
- (and (pairp (qcdr tmp1))
- (eq (qcdr (qcdr tmp1)) nil)
- (progn (setq mpp (qcar (qcdr tmp1))) t)))))
- (|modeEqual| mpp m))
- (and (or (progn
- (setq tmp1 (|get| m '|value| |$e|))
- (and (pairp tmp1)
- (progn (setq mpp (qcar tmp1)) t)))
- (progn
- (setq tmp1 (|getmode| m |$e|))
- (and (pairp tmp1)
- (eq (qcar tmp1) '|Mapping|)
- (and (pairp (qcdr tmp1))
- (eq (qcdr (qcdr tmp1)) nil)
- (progn (setq mpp (qcar (qcdr tmp1))) t)))))
- (|modeEqual| mpp mp)))
- (list (car tt) m (third tt)))
- ((and (stringp (car tt)) (equal (car tt) m))
- (list (car tt) m |$e|))
- ((|isCategoryForm| m |$e|)
- (cond
- ((eq |$bootStrapMode| t)
- (list (car tt) m |$e|))
- ((|extendsCategoryForm| (car tt) (cadr tt) m)
- (list (car tt) m |$e|))
- (t (|coerceExtraHard| tt m))))
- (t (|coerceExtraHard| tt m)))))
-
-\end{chunk}
-
-\defun{coerceExtraHard}{coerceExtraHard}
-\calls{coerceExtraHard}{autoCoerceByModemap}
-\calls{coerceExtraHard}{isUnionMode}
-\calls{coerceExtraHard}{pairp}
-\calls{coerceExtraHard}{qcar}
-\calls{coerceExtraHard}{qcdr}
-\calls{coerceExtraHard}{hasType}
-\calls{coerceExtraHard}{member}
-\calls{coerceExtraHard}{autoCoerceByModemap}
-\calls{coerceExtraHard}{coerce}
-\refsdollar{coerceExtraHard}{Expression}
-\begin{chunk}{defun coerceExtraHard}
-(defun |coerceExtraHard| (tt m)
- (let (x mp e tmp1 z ta tp tpp)
- (declare (special |$Expression|))
- (setq x (first tt))
- (setq mp (second tt))
- (setq e (third tt))
- (cond
- ((setq tp (|autoCoerceByModemap| tt m)) tp)
- ((and (progn
- (setq tmp1 (|isUnionMode| mp e))
- (and (pairp tmp1) (eq (qcar tmp1) '|Union|)
- (progn
- (setq z (qcdr tmp1)) t)))
- (setq ta (|hasType| x e))
- (|member| ta z)
- (setq tp (|autoCoerceByModemap| tt ta))
- (setq tpp (|coerce| tp m)))
- tpp)
- ((and (pairp mp) (eq (qcar mp) '|Record|) (equal m |$Expression|))
- (list (list '|coerceRe2E| x (list 'elt (copy mp) 0)) m e))
- (t nil))))
-
-\end{chunk}
-
\defun{compFromIf}{compFromIf}
\calls{compFromIf}{comp}
\begin{chunk}{defun compFromIf}
@@ -11941,57 +11689,6 @@ of basic objects may not be the same.
\end{chunk}
-;(defun |outputComp| (x env)
-; (let (u tmp1 v argl tmp2)
-; (declare (special |$Expression|))
-; (cond
-; ((setq u (|comp| (list '|::| x |$Expression|) |$Expression| env))
-; u)
-; ((and (pairp x) (eq (qcar x) '|construct|))
-; (setq argl (qcdr x))
-; (list (cons 'list
-; (prog (result)
-; (return
-; (do ((tmp1 argl (cdr tmp1)) (x nil))
-; ((or (atom tmp1)) (nreverse0 result))
-; (setq x (car tmp1))
-; (setq result
-; (cons
-; (car
-; (progn
-; (setq tmp2 (|outputComp| x env))
-; (setq env (third tmp2))
-; tmp2))
-; result))))))
-; |$Expression| env))
-; ((and (setq v (|get| x '|value| env))
-; (pairp (cadr v)) (eq (qcar (cadr v)) '|Union|))
-; (list (list '|coerceUn2E| x (cadr v)) |$Expression| env))
-; (t (list x |$Expression| env)))))
-
-;(defun |outputComp| (x env)
-; (let (tmp1 v result)
-; (declare (special |$Expression|))
-; (cond
-; ((|comp| (list '|::| x |$Expression|) |$Expression| env))
-; ((and (pairp x) (eq (qcar x) '|construct|))
-; (list
-; (cons 'list
-; (dolist (y (rest x) (nreverse0 result))
-; (push (car (progn
-; (setq tmp1 (|outputComp| y env))
-; (setq env (third tmp1))
-; tmp1))
-; result))
-; |$Expression| env)))
-; ((and (setq v (|get| x '|value| env))
-; (pairp (second v)) (eq (qcar (second v)) '|Union|))
-; (list (list '|coerceUn2E| x (second v)) |$Expression| env))
-; (t
-; (list x |$Expression| env)))))
-
-\end{chunk}
-
\defun{maxSuperType}{maxSuperType}
\calls{maxSuperType}{get}
\calls{maxSuperType}{maxSuperType}
@@ -12285,6 +11982,545 @@ of basic objects may not be the same.
\end{chunk}
+\section{Functions for coercion}
+\defun{coerce}{coerce}
+The function coerce is used by the old compiler for coercions.
+The function coerceInteractive is used by the interpreter.
+One should always call the correct function, since the representation
+of basic objects may not be the same.
+\calls{coerce}{keyedSystemError}
+\calls{coerce}{rplac}
+\calls{coerce}{msubst}
+\calls{coerce}{coerceEasy}
+\calls{coerce}{coerceSubset}
+\calls{coerce}{coerceHard}
+\calls{coerce}{isSomeDomainVariable}
+\calls{coerce}{stackMessage}
+\refsdollar{coerce}{InteractiveMode}
+\refsdollar{coerce}{Rep}
+\refsdollar{coerce}{fromCoerceable}
+\begin{chunk}{defun coerce}
+(defun |coerce| (tt mode)
+ (labels (
+ (fn (x m1 m2)
+ (list '|Cannot coerce| '|%b| x '|%d| '|%l| '| of mode| '|%b| m1
+ '|%d| '|%l| '| to mode| '|%b| m2 '|%d|)))
+ (let (tp)
+ (declare (special |$fromCoerceable$| |$Rep| |$InteractiveMode|))
+ (if |$InteractiveMode|
+ (|keyedSystemError| 'S2GE0016
+ (list "coerce" "function coerce called from the interpreter."))
+ (progn
+ (|rplac| (cadr tt) (msubst '$ |$Rep| (cadr tt)))
+ (cond
+ ((setq tp (|coerceEasy| tt mode)) tp)
+ ((setq tp (|coerceSubset| tt mode)) tp)
+ ((setq tp (|coerceHard| tt mode)) tp)
+ ((or (eq (car tt) '|$fromCoerceable$|) (|isSomeDomainVariable| mode)) nil)
+ (t (|stackMessage| (fn (first tt) (second tt) mode)))))))))
+
+\end{chunk}
+
+\defun{coerceEasy}{coerceEasy}
+\calls{coerceEasy}{modeEqualSubst}
+\refsdollar{coerceEasy}{EmptyMode}
+\refsdollar{coerceEasy}{Exit}
+\refsdollar{coerceEasy}{NoValueMode}
+\refsdollar{coerceEasy}{Void}
+\begin{chunk}{defun coerceEasy}
+(defun |coerceEasy| (tt m)
+ (declare (special |$EmptyMode| |$Exit| |$NoValueMode| |$Void|))
+ (cond
+ ((equal m |$EmptyMode|) tt)
+ ((or (equal m |$NoValueMode|) (equal m |$Void|))
+ (list (car tt) m (third tt)))
+ ((equal (second tt) m) tt)
+ ((equal (second tt) |$NoValueMode|) tt)
+ ((equal (second tt) |$Exit|)
+ (list
+ (list 'progn (car tt) (list '|userError| "Did not really exit."))
+ m (third tt)))
+ ((or (equal (second tt) |$EmptyMode|)
+ (|modeEqualSubst| (second tt) m (third tt)))
+ (list (car tt) m (third tt)))))
+
+\end{chunk}
+
+\defun{coerceSubset}{coerceSubset}
+\calls{coerceSubset}{isSubset}
+\calls{coerceSubset}{lassoc}
+\calls{coerceSubset}{get}
+\calls{coerceSubset}{opOf}
+\calls{coerceSubset}{eval}
+\calls{coerceSubset}{msubst}
+\calls{coerceSubset}{isSubset}
+\calls{coerceSubset}{maxSuperType}
+\begin{chunk}{defun coerceSubset}
+(defun |coerceSubset| (arg1 mp)
+ (let (x m env pred)
+ (setq x (first arg1))
+ (setq m (second arg1))
+ (setq env (third arg1))
+ (cond
+ ((or (|isSubset| m mp env) (and (eq m '|Rep|) (eq mp '$)))
+ (list x mp env))
+ ((and (pairp m) (eq (qcar m) '|SubDomain|)
+ (pairp (qcdr m)) (equal (qcar (qcdr m)) mp))
+ (list x mp env))
+ ((and (setq pred (lassoc (|opOf| mp) (|get| (|opOf| m) '|SubDomain| env)))
+ (integerp x) (|eval| (msubst x '|#1| pred)))
+ (list x mp env))
+ ((and (setq pred (|isSubset| mp (|maxSuperType| m env) env))
+ (integerp x) (|eval| (msubst x '* pred)))
+ (list x mp env))
+ (t nil))))
+
+\end{chunk}
+
+\defun{coerceHard}{coerceHard}
+\calls{coerceHard}{modeEqual}
+\calls{coerceHard}{get}
+\calls{coerceHard}{getmode}
+\calls{coerceHard}{isCategoryForm}
+\calls{coerceHard}{extendsCategoryForm}
+\calls{coerceHard}{coerceExtraHard}
+\defsdollar{coerceHard}{e}
+\refsdollar{coerceHard}{e}
+\refsdollar{coerceHard}{String}
+\refsdollar{coerceHard}{bootStrapMode}
+\begin{chunk}{defun coerceHard}
+(defun |coerceHard| (tt m)
+ (let (|$e| mp tmp1 mpp)
+ (declare (special |$e| |$String| |$bootStrapMode|))
+ (setq |$e| (third tt))
+ (setq mp (second tt))
+ (cond
+ ((and (stringp mp) (|modeEqual| m |$String|))
+ (list (car tt) m |$e|))
+ ((or (|modeEqual| mp m)
+ (and (or (progn
+ (setq tmp1 (|get| mp '|value| |$e|))
+ (and (pairp tmp1)
+ (progn (setq mpp (qcar tmp1)) t)))
+ (progn
+ (setq tmp1 (|getmode| mp |$e|))
+ (and (pairp tmp1)
+ (eq (qcar tmp1) '|Mapping|)
+ (and (pairp (qcdr tmp1))
+ (eq (qcdr (qcdr tmp1)) nil)
+ (progn (setq mpp (qcar (qcdr tmp1))) t)))))
+ (|modeEqual| mpp m))
+ (and (or (progn
+ (setq tmp1 (|get| m '|value| |$e|))
+ (and (pairp tmp1)
+ (progn (setq mpp (qcar tmp1)) t)))
+ (progn
+ (setq tmp1 (|getmode| m |$e|))
+ (and (pairp tmp1)
+ (eq (qcar tmp1) '|Mapping|)
+ (and (pairp (qcdr tmp1))
+ (eq (qcdr (qcdr tmp1)) nil)
+ (progn (setq mpp (qcar (qcdr tmp1))) t)))))
+ (|modeEqual| mpp mp)))
+ (list (car tt) m (third tt)))
+ ((and (stringp (car tt)) (equal (car tt) m))
+ (list (car tt) m |$e|))
+ ((|isCategoryForm| m |$e|)
+ (cond
+ ((eq |$bootStrapMode| t)
+ (list (car tt) m |$e|))
+ ((|extendsCategoryForm| (car tt) (cadr tt) m)
+ (list (car tt) m |$e|))
+ (t (|coerceExtraHard| tt m))))
+ (t (|coerceExtraHard| tt m)))))
+
+\end{chunk}
+
+\defun{coerceExtraHard}{coerceExtraHard}
+\calls{coerceExtraHard}{autoCoerceByModemap}
+\calls{coerceExtraHard}{isUnionMode}
+\calls{coerceExtraHard}{pairp}
+\calls{coerceExtraHard}{qcar}
+\calls{coerceExtraHard}{qcdr}
+\calls{coerceExtraHard}{hasType}
+\calls{coerceExtraHard}{member}
+\calls{coerceExtraHard}{autoCoerceByModemap}
+\calls{coerceExtraHard}{coerce}
+\refsdollar{coerceExtraHard}{Expression}
+\begin{chunk}{defun coerceExtraHard}
+(defun |coerceExtraHard| (tt m)
+ (let (x mp e tmp1 z ta tp tpp)
+ (declare (special |$Expression|))
+ (setq x (first tt))
+ (setq mp (second tt))
+ (setq e (third tt))
+ (cond
+ ((setq tp (|autoCoerceByModemap| tt m)) tp)
+ ((and (progn
+ (setq tmp1 (|isUnionMode| mp e))
+ (and (pairp tmp1) (eq (qcar tmp1) '|Union|)
+ (progn
+ (setq z (qcdr tmp1)) t)))
+ (setq ta (|hasType| x e))
+ (|member| ta z)
+ (setq tp (|autoCoerceByModemap| tt ta))
+ (setq tpp (|coerce| tp m)))
+ tpp)
+ ((and (pairp mp) (eq (qcar mp) '|Record|) (equal m |$Expression|))
+ (list (list '|coerceRe2E| x (list 'elt (copy mp) 0)) m e))
+ (t nil))))
+
+\end{chunk}
+
+\defun{hasType}{hasType}
+\calls{hasType}{get}
+\begin{chunk}{defun hasType}
+(defun |hasType| (x e)
+ (labels (
+ (fn (x)
+ (cond
+ ((null x) nil)
+ ((and (pairp x) (pairp (qcar x)) (eq (qcar (qcar x)) '|case|)
+ (pairp (qcdr (qcar x))) (pairp (qcdr (qcdr (qcar x))))
+ (eq (qcdr (qcdr (qcdr (qcar x)))) nil))
+ (qcar (qcdr (qcdr (qcar x)))))
+ (t (fn (cdr x))))))
+ (fn (|get| x '|condition| e))))
+
+\end{chunk}
+
+\defun{coerceable}{coerceable}
+\calls{coerceable}{pmatch}
+\calls{coerceable}{sublis}
+\calls{coerceable}{coerce}
+\refsdollar{coerceable}{fromCoerceable}
+\begin{chunk}{defun coerceable}
+(defun |coerceable| (m mp env)
+ (let (sl)
+ (declare (special |$fromCoerceable$|))
+ (cond
+ ((equal m mp) m)
+ ((setq sl (|pmatch| mp m)) (sublis sl mp))
+ ((|coerce| (list '|$fromCoerceable$| m env) mp) mp)
+ (t nil))))
+
+\end{chunk}
+
+\defun{coerceExit}{coerceExit}
+\calls{coerceExit}{resolve}
+\calls{coerceExit}{replaceExitEsc}
+\calls{coerceExit}{coerce}
+\refsdollar{coerceExit}{exitMode}
+\begin{chunk}{defun coerceExit}
+(defun |coerceExit| (arg1 mp)
+ (let (x m e catchTag xp)
+ (declare (special |$exitMode|))
+ (setq x (first arg1))
+ (setq m (second arg1))
+ (setq e (third arg1))
+ (setq mp (|resolve| m mp))
+ (setq xp
+ (|replaceExitEtc| x
+ (setq catchTag (mkq (gensym))) '|TAGGEDexit| |$exitMode|))
+ (|coerce| (list (list 'catch catchTag xp) m e) mp)))
+
+\end{chunk}
+
+\defplist{@}{compAtSign plist}
+\begin{chunk}{postvars}
+(eval-when (eval load)
+ (setf (get '|@| 'special) 'compAtSign))
+
+\end{chunk}
+
+\defun{compAtSign}{compAtSign}
+\calls{compAtSign}{addDomain}
+\calls{compAtSign}{comp}
+\calls{compAtSign}{coerce}
+\begin{chunk}{defun compAtSign}
+(defun compAtSign (form mode env)
+ (let ((newform (second form)) (mprime (third form)) tmp)
+ (setq env (|addDomain| mprime env))
+ (when (setq tmp (|comp| newform mprime env)) (|coerce| tmp mode))))
+
+\end{chunk}
+
+\defplist{::}{compCoerce plist}
+\begin{chunk}{postvars}
+(eval-when (eval load)
+ (setf (get '|::| 'special) '|compCoerce|))
+
+\end{chunk}
+
+\defun{compCoerce}{compCoerce}
+\calls{compCoerce}{addDomain}
+\calls{compCoerce}{getmode}
+\calls{compCoerce}{compCoerce1}
+\calls{compCoerce}{coerce}
+\begin{chunk}{defun compCoerce}
+(defun |compCoerce| (form mode env)
+ (let (newform newmode tmp1 tmp4 z td)
+ (setq newform (second form))
+ (setq newmode (third form))
+ (setq env (|addDomain| newmode env))
+ (setq tmp1 (|getmode| newmode env))
+ (cond
+ ((setq td (|compCoerce1| newform newmode env))
+ (|coerce| td mode))
+ ((and (pairp tmp1) (eq (qcar tmp1) '|Mapping|)
+ (pairp (qcdr tmp1)) (eq (qcdr (qcdr tmp1)) nil)
+ (pairp (qcar (qcdr tmp1)))
+ (eq (qcar (qcar (qcdr tmp1))) '|UnionCategory|))
+ (setq z (qcdr (qcar (qcdr tmp1))))
+ (when
+ (setq td
+ (dolist (mode1 z tmp4)
+ (setq tmp4 (or tmp4 (|compCoerce1| newform mode1 env)))))
+ (|coerce| (list (car td) newmode (third td)) mode))))))
+
+\end{chunk}
+
+\defun{compCoerce1}{compCoerce1}
+\calls{compCoerce1}{comp}
+\calls{compCoerce1}{resolve}
+\calls{compCoerce1}{coerce}
+\calls{compCoerce1}{coerceByModemap}
+\calls{compCoerce1}{msubst}
+\calls{compCoerce1}{mkq}
+\begin{chunk}{defun compCoerce1}
+(defun |compCoerce1| (form mode env)
+ (let (m1 td tp gg pred code)
+ (declare (special |$String| |$EmptyMode|))
+ (when (setq td (or (|comp| form mode env) (|comp| form |$EmptyMode| env)))
+ (setq m1 (if (stringp (second td)) |$String| (second td)))
+ (setq mode (|resolve| m1 mode))
+ (setq td (list (car td) m1 (third td)))
+ (cond
+ ((setq tp (|coerce| td mode)) tp)
+ ((setq tp (|coerceByModemap| td mode)) tp)
+ ((setq pred (|isSubset| mode (second td) env))
+ (setq gg (gensym))
+ (setq pred (msubst gg '* pred))
+ (setq code
+ (list 'prog1
+ (list 'let gg (first td))
+ (cons '|check-subtype| (cons pred (list (mkq mode) gg)))))
+ (list code mode (third td)))))))
+
+\end{chunk}
+
+\defun{coerceByModemap}{coerceByModemap}
+\calls{coerceByModemap}{pairp}
+\calls{coerceByModemap}{qcar}
+\calls{coerceByModemap}{qcdr}
+\calls{coerceByModemap}{modeEqual}
+\calls{coerceByModemap}{isSubset}
+\calls{coerceByModemap}{genDeltaEntry}
+\begin{chunk}{defun coerceByModemap}
+(defun |coerceByModemap| (arg1 mp)
+ (let (x m env map cexpr u mm fn)
+ (setq x (first arg1))
+ (setq m (second arg1))
+ (setq env (third arg1))
+ (setq u
+ (loop for modemap in (|getModemapList| '|coerce| 1 env)
+ do
+ (setq map (first modemap))
+ (setq cexpr (second modemap))
+ when
+ (and (pairp map) (pairp (qcdr map))
+ (pairp (qcdr (qcdr map)))
+ (eq (qcdr (qcdr (qcdr map))) nil)
+ (or (|modeEqual| (second map) mp) (|isSubset| (second map) mp env))
+ (or (|modeEqual| (third map) m) (|isSubset| m (third map) env)))
+ collect modemap))
+ (when u
+ (setq mm (first u))
+ (setq fn (|genDeltaEntry| (cons '|coerce| mm)))
+ (list (list '|call| fn x) mp env))))
+
+\end{chunk}
+
+\defun{autoCoerceByModemap}{autoCoerceByModemap}
+\calls{autoCoerceByModemap}{pairp}
+\calls{autoCoerceByModemap}{qcar}
+\calls{autoCoerceByModemap}{qcdr}
+\calls{autoCoerceByModemap}{getModemapList}
+\calls{autoCoerceByModemap}{modeEqual}
+\calls{autoCoerceByModemap}{member}
+\calls{autoCoerceByModemap}{get}
+\calls{autoCoerceByModemap}{stackMessage}
+\refsdollar{autoCoerceByModemap}{fromCoerceable}
+\begin{chunk}{defun autoCoerceByModemap}
+(defun |autoCoerceByModemap| (arg1 target)
+ (let (x source e map cexpr u fn y)
+ (declare (special |$fromCoerceable$|))
+ (setq x (first arg1))
+ (setq source (second arg1))
+ (setq e (third arg1))
+ (setq u
+ (loop for modemap in (|getModemapList| '|autoCoerce| 1 e)
+ do
+ (setq map (first modemap))
+ (setq cexpr (second modemap))
+ when
+ (and (pairp map) (pairp (qcdr map)) (pairp (qcdr (qcdr map)))
+ (eq (qcdr (qcdr (qcdr map))) nil)
+ (|modeEqual| (second map) target)
+ (|modeEqual| (third map) source))
+ collect cexpr))
+ (when u
+ (setq fn
+ (let (result)
+ (loop for item in u
+ do
+ (when (first item) (setq result (or result (second item)))))
+ result))
+ (when fn
+ (cond
+ ((and (pairp source) (eq (qcar source) '|Union|)
+ (|member| target (qcdr source)))
+ (cond
+ ((and (setq y (|get| x '|condition| e))
+ (let (result)
+ (loop for u in y do
+ (setq result
+ (or result
+ (and (pairp u) (eq (qcar u) '|case|) (pairp (qcdr u))
+ (pairp (qcdr (qcdr u)))
+ (eq (qcdr (qcdr (qcdr u))) nil)
+ (equal (qcar (qcdr (qcdr u))) target)))))
+ result))
+ (list (list '|call| fn x) target e))
+ ((eq x '|$fromCoerceable$|) nil)
+ (t
+ (|stackMessage|
+ (list '|cannot coerce: | x '|%l| '| of mode: | source
+ '|%l| '| to: | target '| without a case statement|)))))
+ (t
+ (list (list '|call| fn x) target e)))))))
+
+\end{chunk}
+
+\defun{resolve}{resolve}
+\calls{resolve}{nequal}
+\calls{resolve}{modeEqual}
+\calls{resolve}{mkUnion}
+\refsdollar{resolve}{String}
+\refsdollar{resolve}{EmptyMode}
+\refsdollar{resolve}{NoValueMode}
+\begin{chunk}{defun resolve}
+(defun |resolve| (din dout)
+ (declare (special |$String| |$EmptyMode| |$NoValueMode|))
+ (cond
+ ((or (equal din |$NoValueMode|) (equal dout |$NoValueMode|)) |$NoValueMode|)
+ ((equal dout |$EmptyMode|) din)
+ ((and (nequal din dout) (or (stringp din) (stringp dout)))
+ (cond
+ ((|modeEqual| dout |$String|) dout)
+ ((|modeEqual| din |$String|) nil)
+ (t (|mkUnion| din dout))))
+ (t dout)))
+
+\end{chunk}
+
+\defun{mkUnion}{mkUnion}
+\calls{mkUnion}{pairp}
+\calls{mkUnion}{qcar}
+\calls{mkUnion}{qcdr}
+\calls{mkUnion}{union}
+\refsdollar{mkUnion}{Rep}
+\begin{chunk}{defun mkUnion}
+(defun |mkUnion| (a b)
+ (declare (special |$Rep|))
+ (cond
+ ((and (eq b '$) (pairp |$Rep|) (eq (qcar |$Rep|) '|Union|))
+ (qcdr |$Rep|))
+ ((and (pairp a) (eq (qcar a) '|Union|))
+ (cond
+ ((and (pairp b) (eq (qcar b) '|Union|))
+ (cons '|Union| (|union| (qcdr a) (qcdr b))))
+ (t (cons '|Union| (|union| (list b) (qcdr a))))))
+ ((and (pairp b) (eq (qcar b) '|Union|))
+ (cons '|Union| (|union| (list a) (qcdr b))))
+ (t (list '|Union| a b))))
+
+\end{chunk}
+
+\defun{modeEqual}{This orders Unions}
+This orders Unions
+\begin{chunk}{defun modeEqual}
+(defun |modeEqual| (x y)
+ (let (xl yl)
+ (cond
+ ((or (atom x) (atom y)) (equal x y))
+ ((nequal (|#| x) (|#| y)) nil)
+ ((and (pairp x) (eq (qcar x) '|Union|) (pairp y) (eq (qcar y) '|Union|))
+ (setq xl (qcdr x))
+ (setq yl (qcdr y))
+ (loop for a in xl do
+ (loop for b in yl do
+ (when (|modeEqual| a b)
+ (setq xl (|delete| a xl))
+ (setq yl (|delete| b yl))
+ (return nil))))
+ (unless (or xl yl) t))
+ (t
+ (let ((result t))
+ (loop for u in x for v in y
+ do (setq result (and result (|modeEqual| u v))))
+ result)))))
+
+\end{chunk}
+
+\defun{modeEqualSubst}{modeEqualSubst}
+\calls{modeEqualSubst}{modeEqual}
+\calls{modeEqualSubst}{modeEqualSubst}
+\calls{modeEqualSubst}{length}
+\begin{chunk}{defun modeEqualSubst}
+(defun |modeEqualSubst| (m1 m env)
+ (let (mp op z1 z2)
+ (cond
+ ((|modeEqual| m1 m) t)
+ ((atom m1)
+ (when (setq mp (car (|get| m1 '|value| env)))
+ (|modeEqual| mp m)))
+ ((and (pairp m1) (pairp m) (equal (qcar m) (qcar m1))
+ (equal (|#| (qcdr m1)) (|#| (qcdr m))))
+ (setq op (qcar m1))
+ (setq z1 (qcdr m1))
+ (setq z2 (qcdr m))
+ (let ((result t))
+ (loop for xm1 in z1 for xm2 in z2
+ do (setq result (and result (|modeEqualSubst| xm1 xm2 env))))
+ result))
+ (t nil))))
+
+\end{chunk}
+
+\subsection{compilerDoitWithScreenedLisplib}{compilerDoitWithScreenedLisplib}
+\calls{compilerDoitWithScreenedLisplib}{embed}
+\calls{compilerDoitWithScreenedLisplib}{rwrite}
+\calls{compilerDoitWithScreenedLisplib}{compilerDoit}
+\calls{compilerDoitWithScreenedLisplib}{unembed}
+\refsdollar{compilerDoitWithScreenedLisplib}{saveableItems}
+\refsdollar{compilerDoitWithScreenedLisplib}{libFile}
+\begin{chunk}{defun compilerDoitWithScreenedLisplib}
+(defun |compilerDoitWithScreenedLisplib| (constructor fun)
+ (declare (special |$saveableItems| |$libFile|))
+ (embed 'rwrite
+ '(lambda (key value stream)
+ (cond
+ ((and (eq stream |$libFile|)
+ (not (member key |$saveableItems|)))
+ value)
+ ((not nil) (rwrite key value stream)))))
+ (unwind-protect
+ (|compilerDoit| constructor fun)
+ (unembed 'rwrite)))
+
+\end{chunk}
+
\chapter{Post Transformers}
\section{Direct called postparse routines}
\defun{postTransform}{postTransform}
@@ -13678,7 +13914,7 @@ of the symbol being parsed. The original list read:
(list 'in (setq g (genvar)) (|aplTran1| y))
(list (list f g ) ))))
(t
- (list '|map| f (|aplTran1| y) ))))
+ (list 'map f (|aplTran1| y) ))))
(t x)))
((progn
(setq tmp1 (|hasAplExtension| argl))
@@ -16981,7 +17217,6 @@ Again we find a lot of redundant work. We finally end up calling
\calls{compileSpad2Cmd}{object2String}
\calls{compileSpad2Cmd}{browserAutoloadOnceTrigger}
\calls{compileSpad2Cmd}{spad2AsTranslatorAutoloadOnceTrigger}
-\calls{compileSpad2Cmd}{convertSpadToAsFile}
\calls{compileSpad2Cmd}{compilerDoitWithScreenedLisplib}
\calls{compileSpad2Cmd}{compilerDoit}
\calls{compileSpad2Cmd}{extendLocalLibdb}
@@ -17627,14 +17862,13 @@ And the {\bf s-process} function which returns a parsed version of the input.
(|$noSubsumption| |$noSubsumption|) in-stream out-stream)
(declare (special echo-meta /editfile *comp370-apply* *eof* curoutstream
file-closed |$noSubsumption| |$InteractiveFrame|
- |$InteractiveMode| |$InitialDomainsInScope| optionlist
+ |$InteractiveMode| optionlist
boot-line-stack *fileactq-apply* $spad $boot))
;; only rebind |$InteractiveFrame| if compiling
(progv (if (not |$InteractiveMode|) '(|$InteractiveFrame|))
(if (not |$InteractiveMode|)
(list (|addBinding| '|$DomainsInScope|
- `((fluid . |true|)
- (special . ,(copy-tree |$InitialDomainsInScope|)))
+ `((fluid . |true|))
(|addBinding| '|$Information| nil
(|makeInitialModemapFrame|)))))
(init-boot/spad-reader)
@@ -19616,6 +19850,7 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun augModemapsFromCategoryRep}
\getchunk{defun augModemapsFromDomain}
\getchunk{defun augModemapsFromDomain1}
+\getchunk{defun autoCoerceByModemap}
\getchunk{defun blankp}
\getchunk{defun bumperrorcount}
@@ -19625,7 +19860,10 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun char-ne}
\getchunk{defun checkWarning}
\getchunk{defun coerce}
+\getchunk{defun coerceable}
+\getchunk{defun coerceByModemap}
\getchunk{defun coerceEasy}
+\getchunk{defun coerceExit}
\getchunk{defun coerceExtraHard}
\getchunk{defun coerceHard}
\getchunk{defun coerceSubset}
@@ -19682,6 +19920,7 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun compiler}
\getchunk{defun compileDocumentation}
\getchunk{defun compilerDoit}
+\getchunk{defun compilerDoitWithScreenedLisplib}
\getchunk{defun compileSpad2Cmd}
\getchunk{defun compileSpadLispCmd}
\getchunk{defun compImport}
@@ -19790,6 +20029,7 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun hasAplExtension}
\getchunk{defun hasFormalMapVariable}
\getchunk{defun hasFullSignature}
+\getchunk{defun hasType}
\getchunk{defun indent-pos}
\getchunk{defun infixtok}
@@ -19847,7 +20087,10 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun mkEvalableCategoryForm}
\getchunk{defun mkNewModemapList}
\getchunk{defun mkOpVec}
+\getchunk{defun mkUnion}
\getchunk{defun modifyModeStack}
+\getchunk{defun modeEqual}
+\getchunk{defun modeEqualSubst}
\getchunk{defun modemapPattern}
\getchunk{defun moveORsOutside}
@@ -20062,10 +20305,11 @@ if \verb|$InteractiveMode| then use a null outputstream
\getchunk{defun read-a-line}
\getchunk{defun recompile-lib-file-if-necessary}
\getchunk{defun replaceExitEtc}
-\getchunk{defun /rf-1}
\getchunk{defun removeSuperfluousMapping}
\getchunk{defun replaceVars}
+\getchunk{defun resolve}
\getchunk{defun reportOnFunctorCompilation}
+\getchunk{defun /rf-1}
\getchunk{defun /RQ,LIB}
\getchunk{defun rwriteLispForm}
diff --git a/changelog b/changelog
index a67189b..47ec494 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,10 @@
+20110818 tpd src/axiom-website/patches.html 20110818.01.tpd.patch
+20110818 tpd src/lib/cfuns-c.c treeshake compiler
+20110818 tpd src/interp/vmlisp.lisp treeshake compiler
+20110818 tpd src/interp/apply.lisp pick up function from compiler.lisp
+20110818 tpd src/interp/Makefile remove compiler.lisp
+20110818 tpd src/interp/compiler.lisp removed
+20110818 tpd books/bookvol9 treeshake compiler
20110814 tpd src/axiom-website/patches.html 20110814.01.tpd.patch
20110814 tpd src/interp/compiler.lisp treeshake compiler
20110814 tpd books/bookvol9 treeshake compiler
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index 33401e5..9d74ca0 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3588,5 +3588,7 @@ books/bookvol9 treeshake compiler
src/input/Makefile respect the BUILD=fast variable value
20110814.01.tpd.patch
books/bookvol9 treeshake compiler
+20110818.01.tpd.patch
+books/bookvol9 treeshake compiler, remove compiler.lisp