diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet
index efb4172..41c203c 100644
--- a/books/bookvol9.pamphlet
+++ b/books/bookvol9.pamphlet
@@ -2,6 +2,7 @@
\usepackage{hyperref}
\usepackage{axiom}
\usepackage{makeidx}
+\setlength{\textwidth}{400pt}
\makeindex
\usepackage{graphicx}
\begin{document}
@@ -4870,7 +4871,6 @@ of the symbol being parsed. The original list read:
$>= parseDollarGreaterEqual
$^= parseDollarNotEqual
eqv parseEquivalence
-;;xor parseExclusiveOr
exit parseExit
> parseGreaterThan
>= parseGreaterEqual
@@ -5415,20 +5415,20 @@ of the symbol being parsed. The original list read:
\calls{parseIf,ifTran}{parseTran}
\usesdollar{parseIf,ifTran}{InteractiveMode}
\begin{chunk}{defun parseIf,ifTran}
-(defun |parseIf,ifTran| (p a b)
+(defun |parseIf,ifTran| (pred a b)
(let (pp z ap bp tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 val s)
(declare (special |$InteractiveMode|))
(cond
- ((and (null |$InteractiveMode|) (eq p '|true|))
+ ((and (null |$InteractiveMode|) (eq pred '|true|))
a)
- ((and (null |$InteractiveMode|) (eq p '|false|))
+ ((and (null |$InteractiveMode|) (eq pred '|false|))
b)
- ((and (pairp p) (eq (qcar p) '|not|)
- (pairp (qcdr p)) (eq (qcdr (qcdr p)) nil))
- (|parseIf,ifTran| (second p) b a))
- ((and (pairp p) (eq (qcar p) 'if)
+ ((and (pairp pred) (eq (qcar pred) '|not|)
+ (pairp (qcdr pred)) (eq (qcdr (qcdr pred)) nil))
+ (|parseIf,ifTran| (second pred) b a))
+ ((and (pairp pred) (eq (qcar pred) 'if)
(progn
- (setq tmp1 (qcdr p))
+ (setq tmp1 (qcdr pred))
(and (pairp tmp1)
(progn
(setq pp (qcar tmp1))
@@ -5443,8 +5443,8 @@ of the symbol being parsed. The original list read:
(|parseIf,ifTran| pp
(|parseIf,ifTran| ap (copy a) (copy b))
(|parseIf,ifTran| bp a b)))
- ((and (pairp p) (eq (qcar p) 'seq)
- (pairp (qcdr p)) (progn (setq tmp2 (reverse (qcdr p))) t)
+ ((and (pairp pred) (eq (qcar pred) 'seq)
+ (pairp (qcdr pred)) (progn (setq tmp2 (reverse (qcdr pred))) t)
(and (pairp tmp2)
(pairp (qcar tmp2))
(eq (qcar (qcar tmp2)) '|exit|)
@@ -5466,18 +5466,18 @@ of the symbol being parsed. The original list read:
(|incExitLevel| a)
(|incExitLevel| b)))))))
((and (pairp a) (eq (qcar a) 'if) (pairp (qcdr a))
- (equal (qcar (qcdr a)) p) (pairp (qcdr (qcdr a)))
+ (equal (qcar (qcdr a)) pred) (pairp (qcdr (qcdr a)))
(pairp (qcdr (qcdr (qcdr a))))
(eq (qcdr (qcdr (qcdr (qcdr a)))) nil))
- (list 'if p (third a) b))
+ (list 'if pred (third a) b))
((and (pairp b) (eq (qcar b) 'if)
- (pairp (qcdr b)) (equal (qcar (qcdr b)) p)
+ (pairp (qcdr b)) (equal (qcar (qcdr b)) pred)
(pairp (qcdr (qcdr b)))
(pairp (qcdr (qcdr (qcdr b))))
(eq (qcdr (qcdr (qcdr (qcdr b)))) nil))
- (list 'if p a (fourth b)))
+ (list 'if pred a (fourth b)))
((progn
- (setq tmp1 (|makeSimplePredicateOrNil| p))
+ (setq tmp1 (|makeSimplePredicateOrNil| pred))
(and (pairp tmp1) (eq (qcar tmp1) 'seq)
(progn
(setq tmp2 (qcdr tmp1))
@@ -5501,7 +5501,7 @@ of the symbol being parsed. The original list read:
(append s
(list (list '|exit| 1 (|incExitLevel| (list 'if val a b))))))))
(t
- (list 'if p a b )))))
+ (list 'if pred a b )))))
\end{chunk}
@@ -5986,6 +5986,59 @@ of the symbol being parsed. The original list read:
\end{chunk}
\chapter{Compile Transformers}
+\section{Routines for handling forms}
+The functions in this section are called through the symbol-plist
+of the symbol being parsed.
+\begin{itemize}
+\item \verb|add| \refto{compAdd}(form mode env) $\rightarrow$ (form mode env)
+\item \verb|@| \refto{compAtSign}(form mode env) $\rightarrow$
+\item \verb|CAPSULE| \refto{compCapsule}(form mode env) $\rightarrow$
+\item \verb|case| \refto{compCase}(form mode env) $\rightarrow$
+\item \verb|Mapping| \refto{compCat}(form mode env) $\rightarrow$
+\item \verb|Record| \refto{compCat}(form mode env) $\rightarrow$
+\item \verb|Union| \refto{compCat}(form mode env) $\rightarrow$
+\item \verb|CATEGORY| \refto{compCategory}(form mode env) $\rightarrow$
+\item \verb|::| \refto{compCoerce}(form mode env) $\rightarrow$
+\item \verb|:| \refto{compColon}(form mode env) $\rightarrow$
+\item \verb|CONS| \refto{compCons}(form mode env) $\rightarrow$
+\item \verb|construct| \refto{compConstruct}(form mode env) $\rightarrow$
+\item \verb|ListCategory| \refto{compConstructorCategory}(form mode env)
+$\rightarrow$
+\item \verb|RecordCategory| \refto{compConstructorCategory}(form mode env)
+$\rightarrow$
+\item \verb|UnionCategory| \refto{compConstructorCategory}(form mode env)
+$\rightarrow$
+\item \verb|VectorCategory| \refto{compConstructorCategory}(form mode env)
+$\rightarrow$
+\item \verb|DEF| \refto{compDefine}(form mode env) $\rightarrow$
+\item \verb|elt| \refto{compElt}(form mode env) $\rightarrow$
+\item \verb|exit| \refto{compExit}(form mode env) $\rightarrow$
+\item \verb|has| \refto{compHas}(pred mode \verb|$e|) $\rightarrow$
+\item \verb|IF| \refto{compIf}(form mode env) $\rightarrow$
+\item \verb|import| \refto{compImport}(form mode env) $\rightarrow$
+\item \verb|is| \refto{compIs}(form mode env) $\rightarrow$
+\item \verb|Join| \refto{compJoin}(form mode env) $\rightarrow$
+\item \verb|+->| \refto{compLambda}(form mode env) $\rightarrow$
+\item \verb|leave| \refto{compLeave}(form mode env) $\rightarrow$
+\item \verb|MDEF| \refto{compMacro}(form mode env) $\rightarrow$
+\item \verb|pretend| \refto{compPretend} $\rightarrow$
+\item \verb|QUOTE| \refto{compQuote}(form mode env) $\rightarrow$
+\item \verb|REDUCE| \refto{compReduce}(form mode env) $\rightarrow$
+\item \verb|COLLECT| \refto{compRepeatOrCollect}(form mode env) $\rightarrow$
+\item \verb|REPEAT| \refto{compRepeatOrCollect}(form mode env) $\rightarrow$
+\item \verb|return| \refto{compReturn}(form mode env) $\rightarrow$
+\item \verb|SEQ| \refto{compSeq}(form mode env) $\rightarrow$
+\item \verb|LET| \refto{compSetq}(form mode env) $\rightarrow$
+\item \verb|SETQ| \refto{compSetq}(form mode env) $\rightarrow$
+\item \verb|String| \refto{compString}(form mode env) $\rightarrow$
+\item \verb|SubDomain| \refto{compSubDomain}(form mode env) $\rightarrow$
+\item \verb|SubsetCategory| \refto{compSubsetCategory}(form mode env)
+$\rightarrow$
+\item \verb?|? \refto{compSuchthat}(form mode env) $\rightarrow$
+\item \verb|VECTOR| \refto{compVector}(form mode env) $\rightarrow$
+\item \verb|where| \refto{compWhere}(form mode eInit) $\rightarrow$
+\end{itemize}
+
\section{Direct called comp routines}
\section{Indirect called comp routines}
In the {\bf compExpression} function there is the code:
@@ -5995,56 +6048,8 @@ In the {\bf compExpression} function there is the code:
(|compForm| x m e))))
\end{verbatim}
-The functions in this section are called through the symbol-plist
-of the symbol being parsed. The original list read:
-
-\begin{verbatim}
- (|add| |compAdd|)
-; (\@ |compAtSign|)
- (CAPSULE |compCapsule|)
- (|case| |compCase|)
- (|Mapping| |compCat|)
- (|Record| |compCat|)
- (|Union| |compCat|)
- (CATEGORY |compCategory|)
- (\:\: |compCoerce|)
- (COLLECTV |compCollectV|)
-; (\: |compColon|)
- (CONS |compCons|)
- (|ListCategory| |compConstructorCategory|)
- (|RecordCategory| |compConstructorCategory|)
- (|UnionCategory| |compConstructorCategory|)
- (|VectorCategory| |compConstructorCategory|)
- (|construct| |compConstruct|)
- (DEF |compDefine|)
- (|elt| |compElt|)
- (|exit| |compExit|)
- (|has| |compHas|)
- (IF |compIf|)
- (|import| |compImport|)
- (|is| |compIs|)
- (|Join| |compJoin|)
- (|+->| |compLambda|)
- (|leave| |compLeave|)
- (MDEF |compMacro|)
- (QUOTE |compQuote|)
- (|pretend| |compPretend|)
- (REDUCE |compReduce|)
- (COLLECT |compRepeatOrCollect|)
- (REPEAT |compRepeatOrCollect|)
- (|return| |compReturn|)
- (LET |compSetq|)
- (SETQ |compSetq|)
-; (SEQ |compSeq|)
- (|String| |compString|)
- (|SubDomain| |compSubDomain|)
- (|SubsetCategory| |compSubsetCategory|)
- (\| |compSuchthat|)
-; (VECTOR |compVector|)
-; (|where| |compWhere|)
-\end{verbatim}
-\defplist{@}{compAtSign}
+\defplist{@}{compAdd plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|add| 'special) '|compAdd|))
@@ -6052,6 +6057,25 @@ of the symbol being parsed. The original list read:
\end{chunk}
\defun{compAdd}{compAdd}
+The compAdd function expects three arguments:
+\begin{enumerate}
+\item the {\bf form} which is an |add| specifying the domain
+to extend and a set of functions to be added
+\item the {\bf mode} a |Join|, which is a set of categories and domains
+\item the {\bf env} which is a list of functions and their modemaps
+\end{enumerate}
+
+The bulk of the work is performed by a call to compOrCroak which
+compiles the functions in the add form capsule.
+
+The compAdd function returns a triple, the result of a call to compCapsule.
+\begin{enumerate}
+\item the {\bf compiled capsule} which is a progn form which returns
+the domain
+\item the {\bf mode} from the input argument
+\item the {\bf env} prepended with the signatures of the functions
+in the body of the add.
+\end{enumerate}
\calls{compAdd}{comp}
\calls{compAdd}{qcdr}
\calls{compAdd}{qcar}
@@ -6071,21 +6095,21 @@ of the symbol being parsed. The original list read:
\usesdollar{compAdd}{functorForm}
\usesdollar{compAdd}{bootStrapMode}
\begin{chunk}{defun compAdd}
-(defun |compAdd| (arg m e)
+(defun |compAdd| (form mode env)
(let (|$addForm| |$addFormLhs| code domainForm predicate tmp3 tmp4)
(declare (special |$addForm| |$addFormLhs| |$EmptyMode| |$NRTaddForm|
|$packagesUsed| |$functorForm| |$bootStrapMode| /editfile))
- (setq |$addForm| (second arg))
+ (setq |$addForm| (second form))
(cond
((eq |$bootStrapMode| t)
(cond
((and (pairp |$addForm|) (eq (qcar |$addForm|) '|@Tuple|))
(setq code nil))
(t
- (setq tmp3 (|comp| |$addForm| m e))
+ (setq tmp3 (|comp| |$addForm| mode env))
(setq code (first tmp3))
- (setq m (second tmp3))
- (setq e (third tmp3)) tmp3))
+ (setq mode (second tmp3))
+ (setq env (third tmp3)) tmp3))
(list
(list 'cond
(list '|$bootStrapMode| code)
@@ -6094,7 +6118,7 @@ of the symbol being parsed. The original list read:
(list 'list ''|%b| (mkq (car |$functorForm|)) ''|%d| "from"
''|%b| (mkq (|namestring| /editfile)) ''|%d|
"needs to be compiled"))))
- m e))
+ mode env))
(t
(setq |$addFormLhs| |$addForm|)
(cond
@@ -6108,9 +6132,9 @@ of the symbol being parsed. The original list read:
(|NRTgetLocalIndex| domainForm)
; need to generate slot for add form since all $ go-get
; slots will need to access it
- (setq tmp3 (|compSubDomain1| domainForm predicate m e))
+ (setq tmp3 (|compSubDomain1| domainForm predicate mode env))
(setq |$addForm| (first tmp3))
- (setq e (third tmp3)) tmp3)
+ (setq env (third tmp3)) tmp3)
(t
(setq |$packagesUsed|
(if (and (pairp |$addForm|) (eq (qcar |$addForm|) '|@Tuple|))
@@ -6124,17 +6148,17 @@ of the symbol being parsed. The original list read:
(cons '|@Tuple|
(dolist (x (cdr |$addForm|) (nreverse0 tmp4))
(push (|NRTgetLocalIndex| x) tmp4))))
- (|compOrCroak| (|compTuple2Record| |$addForm|) |$EmptyMode| e))
+ (|compOrCroak| (|compTuple2Record| |$addForm|) |$EmptyMode| env))
(t
- (|compOrCroak| |$addForm| |$EmptyMode| e))))
+ (|compOrCroak| |$addForm| |$EmptyMode| env))))
(setq |$addForm| (first tmp3))
- (setq e (third tmp3))
+ (setq env (third tmp3))
tmp3))
- (|compCapsule| (third arg) m e)))))
+ (|compCapsule| (third form) mode env)))))
\end{chunk}
-\defplist{@}{compAtSign}
+\defplist{@}{compAtSign plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|@| 'special) '|compAtSign|))
@@ -6146,14 +6170,14 @@ of the symbol being parsed. The original list read:
\calls{compAtSign}{comp}
\calls{compAtSign}{coerce}
\begin{chunk}{defun compAtSign}
-(defun |compAtSign| (arg1 m e)
- (let ((x (second arg1)) (mprime (third arg1)) tmp)
- (setq e (|addDomain| mprime e))
- (when (setq tmp (|comp| x mprime e)) (|coerce| tmp m))))
+(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}
+\defplist{capsule}{compCapsule plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'capsule 'special) '|compCapsule|))
@@ -6169,17 +6193,17 @@ of the symbol being parsed. The original list read:
\usesdollar{compCapsule}{functorForm}
\usesdollar{compCapsule}{bootStrapMode}
\begin{chunk}{defun compCapsule}
-(defun |compCapsule| (arg m e)
+(defun |compCapsule| (form mode env)
(let (|$insideExpressionIfTrue| itemList)
(declare (special |$insideExpressionIfTrue| |$functorForm| /editfile
|$bootStrapMode|))
- (setq itemList (cdr arg))
+ (setq itemList (cdr form))
(cond
((eq |$bootStrapMode| t)
- (list (|bootStrapError| |$functorForm| /editfile) m e))
+ (list (|bootStrapError| |$functorForm| /editfile) mode env))
(t
(setq |$insideExpressionIfTrue| nil)
- (|compCapsuleInner| itemList m (|addDomain| '$ e))))))
+ (|compCapsuleInner| itemList mode (|addDomain| '$ env))))))
\end{chunk}
@@ -6196,25 +6220,26 @@ of the symbol being parsed. The original list read:
\usesdollar{compCapsuleInner}{insideCategoryIfTrue}
\usesdollar{compCapsuleInner}{functorLocalParameters}
\begin{chunk}{defun compCapsuleInner}
-(defun |compCapsuleInner| (itemList m e)
+(defun |compCapsuleInner| (form mode env)
(let (localParList data code)
(declare (special |$getDomainCode| |$signature| |$form| |$addForm|
|$insideCategoryPackageIfTrue| |$insideCategoryIfTrue|
|$functorLocalParameters|))
- (setq e (|addInformation| m e))
- (setq data (cons 'progn itemList))
- (setq e (|compCapsuleItems| itemList nil e))
+ (setq env (|addInformation| mode env))
+ (setq data (cons 'progn form))
+ (setq env (|compCapsuleItems| form nil env))
(setq localParList |$functorLocalParameters|)
(when |$addForm| (setq data (list '|add| |$addForm| data)))
(setq code
(if (and |$insideCategoryIfTrue| (null |$insideCategoryPackageIfTrue|))
data
- (|processFunctorOrPackage| |$form| |$signature| data localParList m e)))
- (cons (mkpf (append |$getDomainCode| (list code)) 'progn) (list m e))))
+ (|processFunctorOrPackage|
+ |$form| |$signature| data localParList mode env)))
+ (cons (mkpf (append |$getDomainCode| (list code)) 'progn) (list mode env))))
\end{chunk}
-\defplist{case}{compCase}
+\defplist{case}{compCase plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|case| 'special) '|compCase|))
@@ -6235,11 +6260,11 @@ An angry JHD - August 15th., 1984
\calls{compCase}{compCase1}
\calls{compCase}{coerce}
\begin{chunk}{defun compCase}
-(defun |compCase| (arg m e)
+(defun |compCase| (form mode env)
(let (mp td)
- (setq mp (third arg))
- (setq e (|addDomain| mp e))
- (when (setq td (|compCase1| (second arg) mp e)) (|coerce| td m))))
+ (setq mp (third form))
+ (setq env (|addDomain| mp env))
+ (when (setq td (|compCase1| (second form) mp env)) (|coerce| td mode))))
\end{chunk}
@@ -6251,10 +6276,10 @@ An angry JHD - August 15th., 1984
\usesdollar{compCase1}{Boolean}
\usesdollar{compCase1}{EmptyMode}
\begin{chunk}{defun compCase1}
-(defun |compCase1| (x m e)
+(defun |compCase1| (form mode env)
(let (xp mp ep map tmp3 tmp5 tmp6 u fn)
(declare (special |$Boolean| |$EmptyMode|))
- (when (setq tmp3 (|comp| x |$EmptyMode| e))
+ (when (setq tmp3 (|comp| form |$EmptyMode| env))
(setq xp (first tmp3))
(setq mp (second tmp3))
(setq ep (third tmp3))
@@ -6266,7 +6291,7 @@ An angry JHD - August 15th., 1984
(and (pairp map) (pairp (qcdr map)) (pairp (qcdr (qcdr map)))
(pairp (qcdr (qcdr (qcdr map))))
(eq (qcdr (qcdr (qcdr (qcdr map)))) nil)
- (|modeEqual| (fourth map) m)
+ (|modeEqual| (fourth map) mode)
(|modeEqual| (third map) mp))
(push (second modemap) tmp5))))
(when
@@ -6277,21 +6302,21 @@ An angry JHD - August 15th., 1984
\end{chunk}
-\defplist{Record}{compCat}
+\defplist{Record}{compCat plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Record| 'special) '|compCat|))
\end{chunk}
-\defplist{Mapping}{compCat}
+\defplist{Mapping}{compCat plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Mapping| 'special) '|compCat|))
\end{chunk}
-\defplist{Union}{compCat}
+\defplist{Union}{compCat plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Union| 'special) '|compCat|))
@@ -6301,14 +6326,14 @@ An angry JHD - August 15th., 1984
\defun{compCat}{compCat}
\calls{compCat}{getl}
\begin{chunk}{defun compCat}
-(defun |compCat| (form m e)
- (declare (ignore m))
+(defun |compCat| (form mode env)
+ (declare (ignore mode))
(let (functorName fn tmp1 tmp2 funList op sig catForm)
(setq functorName (first form))
(when (setq fn (getl functorName '|makeFunctionList|))
- (setq tmp1 (funcall fn form form e))
+ (setq tmp1 (funcall fn form form env))
(setq funList (first tmp1))
- (setq e (second tmp1))
+ (setq env (second tmp1))
(setq catForm
(list '|Join| '(|SetCategory|)
(cons 'category
@@ -6317,11 +6342,11 @@ An angry JHD - August 15th., 1984
(setq op (first item))
(setq sig (second item))
(unless (eq op '=) (push (list 'signature op sig) tmp2)))))))
- (list form catForm e))))
+ (list form catForm env))))
\end{chunk}
-\defplist{category}{compCategory}
+\defplist{category}{compCategory plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'category 'special) '|compCategory|))
@@ -6336,18 +6361,19 @@ An angry JHD - August 15th., 1984
\calls{compCategory}{mkExplicitCategoryFunction}
\calls{compCategory}{systemErrorHere}
\begin{chunk}{defun compCategory}
-(defun |compCategory| (x m e)
+(defun |compCategory| (form mode env)
(let ($top_level |$sigList| |$atList| domainOrPackage z rep)
(declare (special $top_level |$sigList| |$atList|))
(setq $top_level t)
(cond
((and
- (equal (setq m (|resolve| m (list '|Category|))) (list '|Category|))
- (pairp x)
- (eq (qcar x) 'category)
- (pairp (qcdr x)))
- (setq domainOrPackage (second x))
- (setq z (qcdr (qcdr x)))
+ (equal (setq mode (|resolve| mode (list '|Category|)))
+ (list '|Category|))
+ (pairp form)
+ (eq (qcar form) 'category)
+ (pairp (qcdr form)))
+ (setq domainOrPackage (second form))
+ (setq z (qcdr (qcdr form)))
(setq |$sigList| nil)
(setq |$atList| nil)
(setq |$sigList| nil)
@@ -6355,13 +6381,13 @@ An angry JHD - August 15th., 1984
(dolist (x z) (|compCategoryItem| x nil))
(setq rep
(|mkExplicitCategoryFunction| domainOrPackage |$sigList| |$atList|))
- (list rep m e))
+ (list rep mode env))
(t
(|systemErrorHere| "compCategory")))))
\end{chunk}
-\defplist{::}{compCoerce}
+\defplist{::}{compCoerce plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|::| 'special) '|compCoerce|))
@@ -6374,15 +6400,15 @@ An angry JHD - August 15th., 1984
\calls{compCoerce}{compCoerce1}
\calls{compCoerce}{coerce}
\begin{chunk}{defun compCoerce}
-(defun |compCoerce| (arg m e)
- (let (x mp tmp1 tmp4 z td)
- (setq x (second arg))
- (setq mp (third arg))
- (setq e (|addDomain| mp e))
- (setq tmp1 (|getmode| mp e))
+(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| x mp e))
- (|coerce| td m))
+ ((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)))
@@ -6390,8 +6416,9 @@ An angry JHD - August 15th., 1984
(setq z (qcdr (qcar (qcdr tmp1))))
(when
(setq td
- (dolist (m1 z tmp4) (setq tmp4 (or tmp4 (|compCoerce1| x m1 e)))))
- (|coerce| (list (car td) mp (third td)) m))))))
+ (dolist (mode1 z tmp4)
+ (setq tmp4 (or tmp4 (|compCoerce1| newform mode1 env)))))
+ (|coerce| (list (car td) newmode (third td)) mode))))))
\end{chunk}
@@ -6403,28 +6430,28 @@ An angry JHD - August 15th., 1984
\calls{compCoerce1}{msubst}
\calls{compCoerce1}{mkq}
\begin{chunk}{defun compCoerce1}
-(defun |compCoerce1| (x mp e)
+(defun |compCoerce1| (form mode env)
(let (m1 td tp gg pred code)
(declare (special |$String| |$EmptyMode|))
- (when (setq td (or (|comp| x mp e) (|comp| x |$EmptyMode| e)))
+ (when (setq td (or (|comp| form mode env) (|comp| form |$EmptyMode| env)))
(setq m1 (if (stringp (second td)) |$String| (second td)))
- (setq mp (|resolve| m1 mp))
+ (setq mode (|resolve| m1 mode))
(setq td (list (car td) m1 (third td)))
(cond
- ((setq tp (|coerce| td mp)) tp)
- ((setq tp (|coerceByModemap| td mp)) tp)
- ((setq pred (|isSubset| mp (second td) e))
+ ((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 mp) gg)))))
- (list code mp (third td)))))))
+ (cons '|check-subtype| (cons pred (list (mkq mode) gg)))))
+ (list code mode (third td)))))))
\end{chunk}
-\defplist{:}{compColon}
+\defplist{:}{compColon plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|:| 'special) '|compColon|))
@@ -6490,28 +6517,28 @@ An angry JHD - August 15th., 1984
\usesdollar{compColon}{insideCategoryIfTrue}
\usesdollar{compColon}{insideExpressionIfTrue}
\begin{chunk}{defun compColon}
-(defun |compColon| (arg0 m e)
+(defun |compColon| (form mode env)
(let (|$lhsOfColon| argf argt tprime mprime r td op argl newTarget a
signature tmp2 catform tmp3 g2 g5)
(declare (special |$lhsOfColon| |$noEnv| |$insideFunctorIfTrue|
|$bootStrapMode| |$FormalMapVariableList|
|$insideCategoryIfTrue| |$insideExpressionIfTrue|))
- (setq argf (second arg0))
- (setq argt (third arg0))
+ (setq argf (second form))
+ (setq argt (third form))
(if |$insideExpressionIfTrue|
- (|compColonInside| argf m e argt)
+ (|compColonInside| argf mode env argt)
(progn
(setq |$lhsOfColon| argf)
(setq argt
(cond
((and (atom argt)
- (setq tprime (|assoc| argt (|getDomainsInScope| e))))
+ (setq tprime (|assoc| argt (|getDomainsInScope| env))))
tprime)
- ((and (|isDomainForm| argt e) (null |$insideCategoryIfTrue|))
- (unless (|member| argt (|getDomainsInScope| e))
- (setq e (|addDomain| argt e)))
+ ((and (|isDomainForm| argt env) (null |$insideCategoryIfTrue|))
+ (unless (|member| argt (|getDomainsInScope| env))
+ (setq env (|addDomain| argt env)))
argt)
- ((or (|isDomainForm| argt e) (|isCategoryForm| argt e))
+ ((or (|isDomainForm| argt env) (|isCategoryForm| argt env))
argt)
((and (pairp argt) (eq (qcar argt) '|Mapping|)
(progn
@@ -6528,10 +6555,10 @@ An angry JHD - August 15th., 1984
(cond
((eq (car argf) 'listof)
(dolist (x (cdr argf) td)
- (setq td (|compColon| (list '|:| x argt) m e))
- (setq e (third td))))
+ (setq td (|compColon| (list '|:| x argt) mode env))
+ (setq env (third td))))
(t
- (setq e
+ (setq env
(cond
((and (pairp argf)
(progn
@@ -6555,7 +6582,7 @@ An angry JHD - August 15th., 1984
(and (pairp tmp3)
(eq (qcdr tmp3) nil)
(progn
- (setq m (qcar tmp3))
+ (setq mode (qcar tmp3))
t))))))
a)
(t x))
@@ -6578,19 +6605,19 @@ An angry JHD - August 15th., 1984
(and (pairp tmp3)
(eq (qcdr tmp3) nil)
(progn
- (setq m (qcar tmp3))
+ (setq mode (qcar tmp3))
t))))))
- m)
+ mode)
(t
- (or (|getmode| x e)
+ (or (|getmode| x env)
(|systemErrorHere| "compColonOld"))))
g5))))))
- (|put| op '|mode| signature e))
- (t (|put| argf '|mode| argt e))))
+ (|put| op '|mode| signature env))
+ (t (|put| argf '|mode| argt env))))
(cond
((and (null |$bootStrapMode|) |$insideFunctorIfTrue|
(progn
- (setq tmp2 (|makeCategoryForm| argt e))
+ (setq tmp2 (|makeCategoryForm| argt env))
(and (pairp tmp2)
(progn
(setq catform (qcar tmp2))
@@ -6598,16 +6625,16 @@ An angry JHD - August 15th., 1984
(and (pairp tmp3)
(eq (qcdr tmp3) nil)
(progn
- (setq e (qcar tmp3))
+ (setq env (qcar tmp3))
t))))))
- (setq e
+ (setq env
(|put| argf '|value| (list (|genSomeVariable|) argt |$noEnv|)
- e))))
- (list '|/throwAway| (|getmode| argf e) e )))))))
+ env))))
+ (list '|/throwAway| (|getmode| argf env) env )))))))
\end{chunk}
-\defplist{cons}{compCons}
+\defplist{cons}{compCons plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'cons 'special) '|compCons|))
@@ -6618,8 +6645,8 @@ An angry JHD - August 15th., 1984
\calls{compCons}{compCons1}
\calls{compCons}{compForm}
\begin{chunk}{defun compCons}
-(defun |compCons| (form m e)
- (or (|compCons1| form m e) (|compForm| form m e)))
+(defun |compCons| (form mode env)
+ (or (|compCons1| form mode env) (|compForm| form mode env)))
\end{chunk}
@@ -6631,23 +6658,23 @@ An angry JHD - August 15th., 1984
\calls{compCons1}{qcdr}
\usesdollar{compCons1}{EmptyMode}
\begin{chunk}{defun compCons1}
-(defun |compCons1| (arg m e)
+(defun |compCons1| (arg mode env)
(let (mx y my yt mp mr ytp tmp1 x td)
(declare (special |$EmptyMode|))
(setq x (second arg))
(setq y (third arg))
- (when (setq tmp1 (|comp| x |$EmptyMode| e))
+ (when (setq tmp1 (|comp| x |$EmptyMode| env))
(setq x (first tmp1))
(setq mx (second tmp1))
- (setq e (third tmp1))
+ (setq env (third tmp1))
(cond
((null y)
- (|convert| (list (list 'list x) (list '|List| mx) e ) m))
+ (|convert| (list (list 'list x) (list '|List| mx) env ) mode))
(t
- (when (setq yt (|comp| y |$EmptyMode| e))
+ (when (setq yt (|comp| y |$EmptyMode| env))
(setq y (first yt))
(setq my (second yt))
- (setq e (third yt))
+ (setq env (third yt))
(setq td
(cond
((and (pairp my) (eq (qcar my) '|List|) (pairp (qcdr my)))
@@ -6656,40 +6683,82 @@ An angry JHD - August 15th., 1984
(when (setq ytp (|convert| yt mr))
(when (setq tmp1 (|convert| (list x mx (third ytp)) (second mr)))
(setq x (first tmp1))
- (setq e (third tmp1))
+ (setq env (third tmp1))
(cond
((and (pairp (car ytp)) (eq (qcar (car ytp)) 'list))
- (list (cons 'list (cons x (cdr (car ytp)))) mr e))
+ (list (cons 'list (cons x (cdr (car ytp)))) mr env))
(t
- (list (list 'cons x (car ytp)) mr e)))))))
+ (list (list 'cons x (car ytp)) mr env)))))))
(t
- (list (list 'cons x y) (list '|Pair| mx my) e ))))
- (|convert| td m)))))))
+ (list (list 'cons x y) (list '|Pair| mx my) env ))))
+ (|convert| td mode)))))))
\end{chunk}
-\defplist{ListCategory}{compConstructorCategory}
+\defplist{construct}{compConstruct plist}
+\begin{chunk}{postvars}
+(eval-when (eval load)
+ (setf (get '|construct| 'special) '|compConstruct|))
+
+\end{chunk}
+
+\defun{compConstruct}{compConstruct}
+\calls{compConstruct}{modeIsAggregateOf}
+\calls{compConstruct}{compList}
+\calls{compConstruct}{convert}
+\calls{compConstruct}{compForm}
+\calls{compConstruct}{compVector}
+\calls{compConstruct}{getDomainsInScope}
+\begin{chunk}{defun compConstruct}
+(defun |compConstruct| (form mode env)
+ (let (z y td tp)
+ (setq z (cdr form))
+ (cond
+ ((setq y (|modeIsAggregateOf| '|List| mode env))
+ (if (setq td (|compList| z (list '|List| (cadr y)) env))
+ (|convert| td mode)
+ (|compForm| form mode env)))
+ ((setq y (|modeIsAggregateOf| '|Vector| mode env))
+ (if (setq td (|compVector| z (list '|Vector| (cadr y)) env))
+ (|convert| td mode)
+ (|compForm| form mode env)))
+ ((setq td (|compForm| form mode env)) td)
+ (t
+ (dolist (d (|getDomainsInScope| env))
+ (cond
+ ((and (setq y (|modeIsAggregateOf| '|List| d env))
+ (setq td (|compList| z (list '|List| (cadr y)) env))
+ (setq tp (|convert| td mode)))
+ (return tp))
+ ((and (setq y (|modeIsAggregateOf| '|Vector| d env))
+ (setq td (|compVector| z (list '|Vector| (cadr y)) env))
+ (setq tp (|convert| td mode)))
+ (return tp))))))))
+
+\end{chunk}
+
+\defplist{ListCategory}{compConstructorCategory plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|ListCategory| 'special) '|compConstructorCategory|))
\end{chunk}
-\defplist{RecordCategory}{compConstructorCategory}
+\defplist{RecordCategory}{compConstructorCategory plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|RecordCategory| 'special) '|compConstructorCategory|))
\end{chunk}
-\defplist{UnionCategory}{compConstructorCategory}
+\defplist{UnionCategory}{compConstructorCategory plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|UnionCategory| 'special) '|compConstructorCategory|))
\end{chunk}
-\defplist{VectorCategory}{compConstructorCategory}
+\defplist{VectorCategory}{compConstructorCategory plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|VectorCategory| 'special) '|compConstructorCategory|))
@@ -6700,55 +6769,13 @@ An angry JHD - August 15th., 1984
\calls{compConstructorCategory}{resolve}
\usesdollar{compConstructorCategory}{Category}
\begin{chunk}{defun compConstructorCategory}
-(defun |compConstructorCategory| (x m e)
+(defun |compConstructorCategory| (form mode env)
(declare (special |$Category|))
- (list x (|resolve| |$Category| m) e))
-
-\end{chunk}
-
-\defplist{construct}{compConstruct}
-\begin{chunk}{postvars}
-(eval-when (eval load)
- (setf (get '|construct| 'special) '|compConstruct|))
-
-\end{chunk}
-
-\defun{compConstruct}{compConstruct}
-\calls{compConstruct}{modeIsAggregateOf}
-\calls{compConstruct}{compList}
-\calls{compConstruct}{convert}
-\calls{compConstruct}{compForm}
-\calls{compConstruct}{compVector}
-\calls{compConstruct}{getDomainsInScope}
-\begin{chunk}{defun compConstruct}
-(defun |compConstruct| (form m e)
- (let (z y td tp)
- (setq z (cdr form))
- (cond
- ((setq y (|modeIsAggregateOf| '|List| m e))
- (if (setq td (|compList| z (list '|List| (cadr y)) e))
- (|convert| td m)
- (|compForm| form m e)))
- ((setq y (|modeIsAggregateOf| '|Vector| m e))
- (if (setq td (|compVector| z (list '|Vector| (cadr y)) e))
- (|convert| td m)
- (|compForm| form m e)))
- ((setq td (|compForm| form m e)) td)
- (t
- (dolist (d (|getDomainsInScope| e))
- (cond
- ((and (setq y (|modeIsAggregateOf| '|List| D e))
- (setq td (|compList| z (list '|List| (cadr y)) e))
- (setq tp (|convert| td m)))
- (return tp))
- ((and (setq y (|modeIsAggregateOf| '|Vector| D e))
- (setq td (|compVector| z (list '|Vector| (cadr y)) e))
- (setq tp (|convert| td m)))
- (return tp))))))))
+ (list form (|resolve| |$Category| mode) env))
\end{chunk}
-\defplist{def}{compDefine}
+\defplist{def}{compDefine plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'def 'special) '|compDefine|))
@@ -6762,7 +6789,7 @@ An angry JHD - August 15th., 1984
\usesdollar{compDefine}{macroIfTrue}
\usesdollar{compDefine}{packagesUsed}
\begin{chunk}{defun compDefine}
-(defun |compDefine| (form m e)
+(defun |compDefine| (form mode env)
(let (|$tripleCache| |$tripleHits| |$macroIfTrue| |$packagesUsed|)
(declare (special |$tripleCache| |$tripleHits| |$macroIfTrue|
|$packagesUsed|))
@@ -6770,7 +6797,7 @@ An angry JHD - August 15th., 1984
(setq |$tripleHits| 0)
(setq |$macroIfTrue| nil)
(setq |$packagesUsed| nil)
- (|compDefine1| form m e)))
+ (|compDefine1| form mode env)))
\end{chunk}
@@ -6808,7 +6835,7 @@ An angry JHD - August 15th., 1984
\usesdollar{compDefine1}{insideWhereIfTrue}
\usesdollar{compDefine1}{insideExpressionIfTrue}
\begin{chunk}{defun compDefine1}
-(defun |compDefine1| (form m e)
+(defun |compDefine1| (form mode env)
(let (|$insideExpressionIfTrue| lhs specialCases sig signature rhs newPrefix
(tmp1 t))
(declare (special |$insideExpressionIfTrue| |$formalArgList| |$form|
@@ -6817,39 +6844,41 @@ An angry JHD - August 15th., 1984
|$ConstructorNames| |$NoValueMode| |$EmptyMode|
|$insideWhereIfTrue| |$insideExpressionIfTrue|))
(setq |$insideExpressionIfTrue| nil)
- (setq form (|macroExpand| form e))
+ (setq form (|macroExpand| form env))
(setq lhs (second form))
(setq signature (third form))
(setq specialCases (fourth form))
(setq rhs (fifth form))
(cond
((and |$insideWhereIfTrue|
- (|isMacro| form e)
- (or (equal m |$EmptyMode|) (equal m |$NoValueMode|)))
- (list lhs m (|put| (car lhs) '|macro| rhs e)))
+ (|isMacro| form env)
+ (or (equal mode |$EmptyMode|) (equal mode |$NoValueMode|)))
+ (list lhs mode (|put| (car lhs) '|macro| rhs env)))
((and (null (car signature)) (consp rhs)
(null (member (qcar rhs) |$ConstructorNames|))
- (setq sig (|getSignatureFromMode| lhs e)))
+ (setq sig (|getSignatureFromMode| lhs env)))
(|compDefine1|
- (list 'def lhs (cons (car sig) (cdr signature)) specialCases rhs) m e))
- (|$insideCapsuleFunctionIfTrue| (|compInternalFunction| form m e))
+ (list 'def lhs (cons (car sig) (cdr signature)) specialCases rhs)
+ mode env))
+ (|$insideCapsuleFunctionIfTrue| (|compInternalFunction| form mode env))
(t
(when (equal (car signature) |$Category|) (setq |$insideCategoryIfTrue| t))
- (setq e (|compDefineAddSignature| lhs signature e))
+ (setq env (|compDefineAddSignature| lhs signature env))
(cond
((null (dolist (x (rest signature) tmp1) (setq tmp1 (and tmp1 (null x)))))
- (|compDefWhereClause| form m e))
+ (|compDefWhereClause| form mode env))
((equal (car signature) |$Category|)
- (|compDefineCategory| form m e nil |$formalArgList|))
- ((and (|isDomainForm| rhs e) (null |$insideFunctorIfTrue|))
+ (|compDefineCategory| form mode env nil |$formalArgList|))
+ ((and (|isDomainForm| rhs env) (null |$insideFunctorIfTrue|))
(when (null (car signature))
(setq signature
(cons (|getTargetFromRhs| lhs rhs
- (|giveFormalParametersValues| (cdr lhs) e))
+ (|giveFormalParametersValues| (cdr lhs) env))
(cdr signature))))
(setq rhs (|addEmptyCapsuleIfNecessary| (car signature) rhs))
(|compDefineFunctor|
- (list 'def lhs signature specialCases rhs) m e NIL |$formalArgList|))
+ (list 'def lhs signature specialCases rhs)
+ mode env NIL |$formalArgList|))
((null |$form|)
(|stackAndThrow| (list "bad == form " form)))
(t
@@ -6857,11 +6886,12 @@ An angry JHD - August 15th., 1984
(if |$prefix|
(intern (strconc (|encodeItem| |$prefix|) "," (|encodeItem| |$op|)))
(|getAbbreviation| |$op| (|#| (cdr |$form|)))))
- (|compDefineCapsuleFunction| form m e newPrefix |$formalArgList|)))))))
+ (|compDefineCapsuleFunction|
+ form mode env newPrefix |$formalArgList|)))))))
\end{chunk}
-\defplist{elt}{compElt}
+\defplist{elt}{compElt plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|elt| 'special) '|compElt|))
@@ -6883,7 +6913,7 @@ An angry JHD - August 15th., 1984
\usesdollar{compElt}{One}
\usesdollar{compElt}{Zero}
\begin{chunk}{defun compElt}
-(defun |compElt| (form m e)
+(defun |compElt| (form mode env)
(let (aDomain anOp mmList n modemap sig pred val)
(declare (special |$One| |$Zero|))
(setq anOp (third form))
@@ -6892,16 +6922,16 @@ An angry JHD - August 15th., 1984
((null (and (pairp form) (eq (qcar form) '|elt|)
(pairp (qcdr form)) (pairp (qcdr (qcdr form)))
(eq (qcdr (qcdr (qcdr form))) nil)))
- (|compForm| form m e))
+ (|compForm| form mode env))
((eq aDomain '|Lisp|)
(list (cond
((equal anOp |$Zero|) 0)
((equal anOp |$One|) 1)
(t anOp))
- m e))
- ((|isDomainForm| aDomain e)
- (setq e (|addDomain| aDomain e))
- (setq mmList (|getModemapListFromDomain| anOp 0 aDomain e))
+ mode env))
+ ((|isDomainForm| aDomain env)
+ (setq env (|addDomain| aDomain env))
+ (setq mmList (|getModemapListFromDomain| anOp 0 aDomain env))
(setq modemap
(progn
(setq n (|#| mmList))
@@ -6924,13 +6954,13 @@ An angry JHD - August 15th., 1984
(unless (and (nequal (|#| sig) 2)
(null (and (pairp val) (eq (qcar val) '|elt|))))
(setq val (|genDeltaEntry| (cons (|opOf| anOp) modemap)))
- (|convert| (list (list '|call| val) (second sig) e) m))))
+ (|convert| (list (list '|call| val) (second sig) env) mode))))
(t
- (|compForm| form m e)))))
+ (|compForm| form mode env)))))
\end{chunk}
-\defplist{exit}{compExit}
+\defplist{exit}{compExit plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|exit| 'special) '|compExit|))
@@ -6943,28 +6973,28 @@ An angry JHD - August 15th., 1984
\calls{compExit}{stackMessageIfNone}
\usesdollar{compExit}{exitModeStack}
\begin{chunk}{defun compExit}
-(defun |compExit| (arg0 m e)
- (let (x index m1 u)
+(defun |compExit| (form mode env)
+ (let (exitForm index m1 u)
(declare (special |$exitModeStack|))
- (setq index (1- (second arg0)))
- (setq x (third arg0))
+ (setq index (1- (second form)))
+ (setq exitForm (third form))
(cond
((null |$exitModeStack|)
- (|comp| x m e))
+ (|comp| exitForm mode env))
(t
(setq m1 (elt |$exitModeStack| index))
- (setq u (|comp| x m1 e))
+ (setq u (|comp| exitForm m1 env))
(cond
(u
(|modifyModeStack| (second u) index)
- (list (list '|TAGGEDexit| index u) m e))
+ (list (list '|TAGGEDexit| index u) mode env))
(t
(|stackMessageIfNone|
- (list '|cannot compile exit expression| x '|in mode| m1))))))))
+ (list '|cannot compile exit expression| exitForm '|in mode| m1))))))))
\end{chunk}
-\defplist{has}{compHas}
+\defplist{has}{compHas plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|has| 'special) '|compHas|))
@@ -6977,18 +7007,18 @@ An angry JHD - August 15th., 1984
\calls{compHas}{coerce}
\usesdollar{compHas}{e}
\begin{chunk}{defun compHas}
-(defun |compHas| (pred m |$e|)
+(defun |compHas| (pred mode |$e|)
(declare (special |$e|))
(let (a b predCode)
(setq a (second pred))
(setq b (third pred))
(setq |$e| (|chaseInferences| pred |$e|))
(setq predCode (|compHasFormat| pred))
- (|coerce| (list predCode |$Boolean| |$e|) m)))
+ (|coerce| (list predCode |$Boolean| |$e|) mode)))
\end{chunk}
-\defplist{if}{compIf}
+\defplist{if}{compIf plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'if 'special) '|compIf|))
@@ -7005,40 +7035,40 @@ An angry JHD - August 15th., 1984
\calls{compIf}{quotify}
\usesdollar{compIf}{Boolean}
\begin{chunk}{defun compIf}
-(defun |compIf| (arg m e)
+(defun |compIf| (form mode env)
(labels (
- (env (bEnv cEnv b c e)
+ (environ (bEnv cEnv b c env)
(cond
((|canReturn| b 0 0 t)
(if (|canReturn| c 0 0 t) (|intersectionEnvironment| bEnv cEnv) bEnv))
((|canReturn| c 0 0 t) cEnv)
- (t e))))
+ (t env))))
(let (a b c tmp1 xa ma Ea Einv Tb xb mb Eb Tc xc mc Ec xbp x returnEnv)
(declare (special |$Boolean|))
- (setq a (second arg))
- (setq b (third arg))
- (setq c (fourth arg))
- (when (setq tmp1 (|compBoolean| a |$Boolean| e))
+ (setq a (second form))
+ (setq b (third form))
+ (setq c (fourth form))
+ (when (setq tmp1 (|compBoolean| a |$Boolean| env))
(setq xa (first tmp1))
(setq ma (second tmp1))
(setq Ea (third tmp1))
(setq Einv (fourth tmp1))
- (when (setq Tb (|compFromIf| b m Ea))
+ (when (setq Tb (|compFromIf| b mode Ea))
(setq xb (first Tb))
(setq mb (second Tb))
(setq Eb (third Tb))
- (when (setq Tc (|compFromIf| c (|resolve| mb m) Einv))
+ (when (setq Tc (|compFromIf| c (|resolve| mb mode) Einv))
(setq xc (first Tc))
(setq mc (second Tc))
(setq Ec (third Tc))
(when (setq xbp (|coerce| Tb mc))
(setq x (list 'if xa (|quotify| (first xbp)) (|quotify| xc)))
- (setq returnEnv (env (third xbp) Ec (first xbp) xc e))
+ (setq returnEnv (environ (third xbp) Ec (first xbp) xc env))
(list x mc returnEnv))))))))
\end{chunk}
-\defplist{import}{compImport}
+\defplist{import}{compImport plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|import| 'special) '|compImport|))
@@ -7049,15 +7079,15 @@ An angry JHD - August 15th., 1984
\calls{compImport}{addDomain}
\usesdollar{compImport}{NoValueMode}
\begin{chunk}{defun compImport}
-(defun |compImport| (arg m e)
- (declare (ignore m))
+(defun |compImport| (form mode env)
+ (declare (ignore mode))
(declare (special |$NoValueMode|))
- (dolist (dom (cdr arg)) (setq e (|addDomain| dom e)))
- (list '|/throwAway| |$NoValueMode| e))
+ (dolist (dom (cdr form)) (setq env (|addDomain| dom env)))
+ (list '|/throwAway| |$NoValueMode| env))
\end{chunk}
-\defplist{is}{compIs}
+\defplist{is}{compIs plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|is| 'special) '|compIs|))
@@ -7070,25 +7100,25 @@ An angry JHD - August 15th., 1984
\usesdollar{compIs}{Boolean}
\usesdollar{compIs}{EmptyMode}
\begin{chunk}{defun compIs}
-(defun |compIs| (arg m e)
+(defun |compIs| (form mode env)
(let (a b aval am tmp1 bval bm td)
(declare (special |$Boolean| |$EmptyMode|))
- (setq a (CADR arg))
- (setq b (CADDR arg))
- (when (setq tmp1 (|comp| a |$EmptyMode| e))
- (setq aval (CAR tmp1))
- (setq am (CADR tmp1))
- (setq e (CADDR tmp1))
- (when (setq tmp1 (|comp| b |$EmptyMode| e))
- (setq bval (CAR tmp1))
- (setq bm (CADR tmp1))
- (setq e (CADDR tmp1))
- (setq td (list (list '|domainEqual| aval bval) |$Boolean| e ))
- (|coerce| td m)))))
-
-\end{chunk}
-
-\defplist{Join}{compJoin}
+ (setq a (second form))
+ (setq b (third form))
+ (when (setq tmp1 (|comp| a |$EmptyMode| env))
+ (setq aval (first tmp1))
+ (setq am (second tmp1))
+ (setq env (third tmp1))
+ (when (setq tmp1 (|comp| b |$EmptyMode| env))
+ (setq bval (first tmp1))
+ (setq bm (second tmp1))
+ (setq env (third tmp1))
+ (setq td (list (list '|domainEqual| aval bval) |$Boolean| env ))
+ (|coerce| td mode)))))
+
+\end{chunk}
+
+\defplist{Join}{compJoin plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Join| 'special) '|compJoin|))
@@ -7110,22 +7140,22 @@ An angry JHD - August 15th., 1984
\calls{compJoin}{convert}
\usesdollar{compJoin}{Category}
\begin{chunk}{defun compJoin}
-(defun |compJoin| (arg m e)
+(defun |compJoin| (form mode env)
(labels (
- (getParms (y e)
+ (getParms (y env)
(cond
((atom y)
- (when (|isDomainForm| y e) (list y)))
+ (when (|isDomainForm| y env) (list y)))
((and (pairp y) (eq (qcar y) 'length)
(pairp (qcdr y)) (eq (qcdr (qcdr y)) nil))
(list y (second y)))
(t (list y)))) )
(let (argl catList pl tmp3 tmp4 tmp5 body parameters catListp td)
(declare (special |$Category|))
- (setq argl (cdr arg))
+ (setq argl (cdr form))
(setq catList
(dolist (x argl (nreverse0 tmp3))
- (push (car (or (|compForMode| x |$Category| e) (return '|failed|)))
+ (push (car (or (|compForMode| x |$Category| env) (return '|failed|)))
tmp3)))
(cond
((eq catList '|failed|)
@@ -7136,11 +7166,11 @@ An angry JHD - August 15th., 1984
(setq tmp4
(cons
(cond
- ((|isCategoryForm| x e)
+ ((|isCategoryForm| x env)
(setq parameters
(|union|
(dolist (y (cdr x) tmp5)
- (setq tmp5 (append tmp5 (getParms y e))))
+ (setq tmp5 (append tmp5 (getParms y env))))
parameters))
x)
((and (pairp x) (eq (qcar x) '|DomainSubstitutionMacro|)
@@ -7151,19 +7181,19 @@ An angry JHD - August 15th., 1984
(setq parameters (|union| pl parameters)) body)
((and (pairp x) (eq (qcar x) '|mkCategory|))
x)
- ((and (atom x) (equal (|getmode| x e) |$Category|))
+ ((and (atom x) (equal (|getmode| x env) |$Category|))
x)
(t
(|stackSemanticError| (list '|invalid argument to Join: | x) nil)
x))
tmp4))))
(setq td (list (|wrapDomainSub| parameters (cons '|Join| catListp))
- |$Category| e))
- (|convert| td m))))))
+ |$Category| env))
+ (|convert| td mode))))))
\end{chunk}
-\defplist{$+->$}{compLambda}
+\defplist{$+->$}{compLambda plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|+->| 'special) '|compLambda|))
@@ -7177,10 +7207,10 @@ An angry JHD - August 15th., 1984
\calls{compLambda}{compAtSign}
\calls{compLambda}{stackAndThrow}
\begin{chunk}{defun compLambda}
-(defun |compLambda| (x m e)
+(defun |compLambda| (form mode env)
(let (vl body tmp1 tmp2 tmp3 target args arg1 sig1 ress)
- (setq vl (second x))
- (setq body (third x))
+ (setq vl (second form))
+ (setq body (third form))
(cond
((and (pairp vl) (eq (qcar vl) '|:|)
(progn
@@ -7199,7 +7229,7 @@ An angry JHD - August 15th., 1984
(cond
((listp args)
(setq tmp3 (|argsToSig| args))
- (setq arg1 (CAR tmp3))
+ (setq arg1 (first tmp3))
(setq sig1 (second tmp3))
(cond
(sig1
@@ -7207,15 +7237,15 @@ An angry JHD - August 15th., 1984
(|compAtSign|
(list '@
(list '+-> arg1 body)
- (cons '|Mapping| (cons target sig1))) m e))
+ (cons '|Mapping| (cons target sig1))) mode env))
ress)
- (t (|stackAndThrow| (list '|compLambda| x )))))
- (t (|stackAndThrow| (list '|compLambda| x )))))
- (t (|stackAndThrow| (list '|compLambda| x ))))))
+ (t (|stackAndThrow| (list '|compLambda| form )))))
+ (t (|stackAndThrow| (list '|compLambda| form )))))
+ (t (|stackAndThrow| (list '|compLambda| form ))))))
\end{chunk}
-\defplist{leave}{compLeave}
+\defplist{leave}{compLeave plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|leave| 'special) '|compLeave|))
@@ -7228,20 +7258,20 @@ An angry JHD - August 15th., 1984
\usesdollar{compLeave}{exitModeStack}
\usesdollar{compLeave}{leaveLevelStack}
\begin{chunk}{defun compLeave}
-(defun |compLeave| (arg m e)
+(defun |compLeave| (form mode env)
(let (level x index u)
(declare (special |$exitModeStack| |$leaveLevelStack|))
- (setq level (second arg))
- (setq x (third arg))
+ (setq level (second form))
+ (setq x (third form))
(setq index
(- (1- (|#| |$exitModeStack|)) (elt |$leaveLevelStack| (1- level))))
- (when (setq u (|comp| x (elt |$exitModeStack| index) e))
+ (when (setq u (|comp| x (elt |$exitModeStack| index) env))
(|modifyModeStack| (second u) index)
- (list (list '|TAGGEDexit| index u) m e ))))
+ (list (list '|TAGGEDexit| index u) mode env ))))
\end{chunk}
-\defplist{mdef}{compMacro}
+\defplist{mdef}{compMacro plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'mdef 'special) '|compMacro|))
@@ -7258,7 +7288,7 @@ An angry JHD - August 15th., 1984
\usesdollar{compMacro}{NoValueMode}
\usesdollar{compMacro}{EmptyMode}
\begin{chunk}{defun compMacro}
-(defun |compMacro| (form m e)
+(defun |compMacro| (form mode env)
(let (|$macroIfTrue| lhs signature specialCases rhs prhs)
(declare (special |$macroIfTrue| |$NoValueMode| |$EmptyMode|))
(setq |$macroIfTrue| t)
@@ -7283,13 +7313,13 @@ An angry JHD - August 15th., 1984
(append (|formatUnabbreviated| lhs)
(cons " ==> "
(append prhs (list '|%d|)))))))
- (when (or (equal m |$EmptyMode|) (equal m |$NoValueMode|))
+ (when (or (equal mode |$EmptyMode|) (equal mode |$NoValueMode|))
(list '|/throwAway| |$NoValueMode|
- (|put| (CAR lhs) '|macro| (|macroExpand| rhs e) e)))))
+ (|put| (CAR lhs) '|macro| (|macroExpand| rhs env) env)))))
\end{chunk}
-\defplist{pretend}{compPretend}
+\defplist{pretend}{compPretend plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|pretend| 'special) '|compPretend|))
@@ -7306,31 +7336,31 @@ An angry JHD - August 15th., 1984
\usesdollar{compPretend}{newCompilerUnionFlag}
\usesdollar{compPretend}{EmptyMode}
\begin{chunk}{defun compPretend}
-(defun |compPretend| (arg m e)
+(defun |compPretend| (form mode env)
(let (x tt warningMessage td tp)
(declare (special |$newCompilerUnionFlag| |$EmptyMode|))
- (setq x (second arg))
- (setq tt (third arg))
- (setq e (|addDomain| tt e))
- (when (setq td (or (|comp| x tt e) (|comp| x |$EmptyMode| e)))
+ (setq x (second form))
+ (setq tt (third form))
+ (setq env (|addDomain| tt env))
+ (when (setq td (or (|comp| x tt env) (|comp| x |$EmptyMode| env)))
(when (equal (second td) tt)
(setq warningMessage (list '|pretend| tt '| -- should replace by @|)))
(cond
((and |$newCompilerUnionFlag|
(eq (|opOf| (second td)) '|Union|)
- (nequal (|opOf| m) '|Union|))
+ (nequal (|opOf| mode) '|Union|))
(|stackSemanticError|
- (list '|cannot pretend | x '| of mode | (second td) '| to mode | m)
+ (list '|cannot pretend | x '| of mode | (second td) '| to mode | mode)
nil))
(t
(setq td (list (first td) tt (third td)))
- (when (setq tp (|coerce| td m))
+ (when (setq tp (|coerce| td mode))
(when warningMessage (|stackWarning| warningMessage))
tp))))))
\end{chunk}
-\defplist{quote}{compQuote}
+\defplist{quote}{compQuote plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'quote 'special) '|compQuote|))
@@ -7339,19 +7369,121 @@ An angry JHD - August 15th., 1984
\defun{compQuote}{compQuote}
\begin{chunk}{defun compQuote}
-(defun |compQuote| (expr m e)
- (list expr m e))
+(defun |compQuote| (form mode env)
+ (list form mode env))
+
+\end{chunk}
+
+\defplist{reduce}{compReduce plist}
+\begin{chunk}{postvars}
+(eval-when (eval load)
+ (setf (get 'reduce 'special) '|compReduce|))
+
+\end{chunk}
+
+\defun{compReduce}{compReduce}
+\calls{compReduce}{compReduce1}
+\usesdollar{compReduce}{formalArgList}
+\begin{chunk}{defun compReduce}
+(defun |compReduce| (form mode env)
+ (declare (special |$formalArgList|))
+ (|compReduce1| form mode env |$formalArgList|))
+
+\end{chunk}
+
+\defun{compReduce1}{compReduce1}
+\calls{compReduce1}{systemError}
+\calls{compReduce1}{nreverse0}
+\calls{compReduce1}{compIterator}
+\calls{compReduce1}{comp}
+\calls{compReduce1}{parseTran}
+\calls{compReduce1}{getIdentity}
+\calls{compReduce1}{msubst}
+\usesdollar{compReduce1}{sideEffectsList}
+\usesdollar{compReduce1}{until}
+\usesdollar{compReduce1}{initList}
+\usesdollar{compReduce1}{Boolean}
+\usesdollar{compReduce1}{e}
+\usesdollar{compReduce1}{endTestList}
+\begin{chunk}{defun compReduce1}
+(defun |compReduce1| (form mode env |$formalArgList|)
+ (declare (special |$formalArgList|))
+ (let (|$sideEffectsList| |$until| |$initList| |$endTestList| collectForm
+ collectOp body op itl acc afterFirst bodyVal part1 part2 part3 id
+ identityCode untilCode finalCode tmp1 tmp2)
+ (declare (special |$sideEffectsList| |$until| |$initList| |$Boolean| |$e|
+ |$endTestList|))
+ (setq op (second form))
+ (setq collectForm (fourth form))
+ (setq collectOp (first collectForm))
+ (setq tmp1 (reverse (cdr collectForm)))
+ (setq body (first tmp1))
+ (setq itl (nreverse (cdr tmp1)))
+ (when (stringp op) (setq op (intern op)))
+ (cond
+ ((null (member collectOp '(collect collectv collectvec)))
+ (|systemError| (list '|illegal reduction form:| form)))
+ (t
+ (setq |$sideEffectsList| nil)
+ (setq |$until| nil)
+ (setq |$initList| nil)
+ (setq |$endTestList| nil)
+ (setq |$e| env)
+ (setq itl
+ (dolist (x itl (nreverse0 tmp2))
+ (setq tmp1 (or (|compIterator| x |$e|) (return '|failed|)))
+ (setq |$e| (second tmp1))
+ (push (elt tmp1 0) tmp2)))
+ (unless (eq itl '|failed|)
+ (setq env |$e|)
+ (setq acc (gensym))
+ (setq afterFirst (gensym))
+ (setq bodyVal (gensym))
+ (when (setq tmp1 (|comp| (list 'let bodyVal body ) mode env))
+ (setq part1 (first tmp1))
+ (setq mode (second tmp1))
+ (setq env (third tmp1))
+ (when (setq tmp1 (|comp| (list 'let acc bodyVal) mode env))
+ (setq part2 (first tmp1))
+ (setq env (third tmp1))
+ (when (setq tmp1
+ (|comp| (list 'let acc (|parseTran| (list op acc bodyVal)))
+ mode env))
+ (setq part3 (first tmp1))
+ (setq env (third tmp1))
+ (when (setq identityCode
+ (if (setq id (|getIdentity| op env))
+ (car (|comp| id mode env))
+ (list '|IdentityError| (mkq op))))
+ (setq finalCode
+ (cons 'progn
+ (cons (list 'let afterFirst nil)
+ (cons
+ (cons 'repeat
+ (append itl
+ (list
+ (list 'progn part1
+ (list 'if afterFirst part3
+ (list 'progn part2 (list 'let afterFirst (mkq t)))) nil))))
+ (list (list 'if afterFirst acc identityCode ))))))
+ (when |$until|
+ (setq tmp1 (|comp| |$until| |$Boolean| env))
+ (setq untilCode (first tmp1))
+ (setq env (third tmp1))
+ (setq finalCode
+ (msubst (list 'until untilCode) '|$until| finalCode)))
+ (list finalCode mode env ))))))))))
\end{chunk}
-\defplist{collect}{compRepeatOrCollect}
+\defplist{collect}{compRepeatOrCollect plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'collect 'special) '|compRepeatOrCollect|))
\end{chunk}
-\defplist{repeat}{compRepeatOrCollect}
+\defplist{repeat}{compRepeatOrCollect plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'repeat 'special) '|compRepeatOrCollect|))
@@ -7376,9 +7508,9 @@ An angry JHD - August 15th., 1984
\usesdollar{compRepeatOrCollect}{leaveLevelStack}
\usesdollar{compRepeatOrCollect}{formalArgList}
\begin{chunk}{defun compRepeatOrCollect}
-(defun |compRepeatOrCollect| (form m e)
+(defun |compRepeatOrCollect| (form mode env)
(labels (
- (fn (form |$exitModeStack| |$leaveLevelStack| |$formalArgList| e)
+ (fn (form |$exitModeStack| |$leaveLevelStack| |$formalArgList| env)
(declare (special |$exitModeStack| |$leaveLevelStack| |$formalArgList|))
(let (|$until| body itl xp targetMode repeatOrCollect bodyMode bodyp mp tmp1
untilCode ep itlp formp u mpp tmp2)
@@ -7390,9 +7522,9 @@ An angry JHD - August 15th., 1984
(setq itl (nreverse (cdr tmp1)))
(setq itlp
(dolist (x itl (nreverse0 tmp2))
- (setq tmp1 (or (|compIterator| x e) (return '|failed|)))
+ (setq tmp1 (or (|compIterator| x env) (return '|failed|)))
(setq xp (first tmp1))
- (setq e (second tmp1))
+ (setq env (second tmp1))
(push xp tmp2)))
(unless (eq itlp '|failed|)
(setq targetMode (car |$exitModeStack|))
@@ -7401,12 +7533,12 @@ An angry JHD - August 15th., 1984
(cond
((eq targetMode '|$EmptyMode|)
'|$EmptyMode|)
- ((setq u (|modeIsAggregateOf| '|List| targetMode e))
+ ((setq u (|modeIsAggregateOf| '|List| targetMode env))
(second u))
- ((setq u (|modeIsAggregateOf| '|PrimitiveArray| targetMode e))
+ ((setq u (|modeIsAggregateOf| '|PrimitiveArray| targetMode env))
(setq repeatOrCollect 'collectv)
(second u))
- ((setq u (|modeIsAggregateOf| '|Vector| targetMode e))
+ ((setq u (|modeIsAggregateOf| '|Vector| targetMode env))
(setq repeatOrCollect 'collectvec)
(second u))
(t
@@ -7414,7 +7546,7 @@ An angry JHD - August 15th., 1984
'|failed|))
|$NoValueMode|))
(unless (eq bodyMode '|failed|)
- (when (setq tmp1 (|compOrCroak| body bodyMode e))
+ (when (setq tmp1 (|compOrCroak| body bodyMode env))
(setq bodyp (first tmp1))
(setq mp (second tmp1))
(setq ep (third tmp1))
@@ -7427,131 +7559,29 @@ An angry JHD - August 15th., 1984
(setq mpp
(cond
((eq repeatOrCollect 'collect)
- (if (setq u (|modeIsAggregateOf| '|List| targetMode e))
+ (if (setq u (|modeIsAggregateOf| '|List| targetMode env))
(car u)
(list '|List| mp)))
((eq repeatOrCollect 'collectv)
- (if (setq u (|modeIsAggregateOf| '|PrimitiveArray| targetMode e))
+ (if (setq u (|modeIsAggregateOf| '|PrimitiveArray| targetMode env))
(car u)
(list '|PrimitiveArray| mp)))
((eq repeatOrCollect 'collectvec)
- (if (setq u (|modeIsAggregateOf| '|Vector| targetMode e))
+ (if (setq u (|modeIsAggregateOf| '|Vector| targetMode env))
(car u)
(list '|Vector| mp)))
(t mp)))
(|coerceExit| (list formp mpp ep) targetMode)))))) )
(declare (special |$exitModeStack| |$leaveLevelStack| |$formalArgList|))
(fn form
- (cons m |$exitModeStack|)
+ (cons mode |$exitModeStack|)
(cons (|#| |$exitModeStack|) |$leaveLevelStack|)
|$formalArgList|
- e)))
-
-
-\end{chunk}
-
-\defplist{reduce}{compReduce}
-\begin{chunk}{postvars}
-(eval-when (eval load)
- (setf (get 'reduce 'special) '|compReduce|))
-
-\end{chunk}
-
-\defun{compReduce}{compReduce}
-\calls{compReduce}{compReduce1}
-\usesdollar{compReduce}{formalArgList}
-\begin{chunk}{defun compReduce}
-(defun |compReduce| (form m e)
- (declare (special |$formalArgList|))
- (|compReduce1| form m e |$formalArgList|))
-
-\end{chunk}
-
-\defun{compReduce1}{compReduce1}
-\calls{compReduce1}{systemError}
-\calls{compReduce1}{nreverse0}
-\calls{compReduce1}{compIterator}
-\calls{compReduce1}{comp}
-\calls{compReduce1}{parseTran}
-\calls{compReduce1}{getIdentity}
-\calls{compReduce1}{msubst}
-\usesdollar{compReduce1}{sideEffectsList}
-\usesdollar{compReduce1}{until}
-\usesdollar{compReduce1}{initList}
-\usesdollar{compReduce1}{Boolean}
-\usesdollar{compReduce1}{e}
-\usesdollar{compReduce1}{endTestList}
-\begin{chunk}{defun compReduce1}
-(defun |compReduce1| (form m e |$formalArgList|)
- (declare (special |$formalArgList|))
- (let (|$sideEffectsList| |$until| |$initList| |$endTestList| collectForm
- collectOp body op itl acc afterFirst bodyVal part1 part2 part3 id
- identityCode untilCode finalCode tmp1 tmp2)
- (declare (special |$sideEffectsList| |$until| |$initList| |$Boolean| |$e|
- |$endTestList|))
- (setq op (second form))
- (setq collectForm (fourth form))
- (setq collectOp (first collectForm))
- (setq tmp1 (reverse (cdr collectForm)))
- (setq body (first tmp1))
- (setq itl (nreverse (cdr tmp1)))
- (when (stringp op) (setq op (intern op)))
- (cond
- ((null (member collectOp '(collect collectv collectvec)))
- (|systemError| (list '|illegal reduction form:| form)))
- (t
- (setq |$sideEffectsList| nil)
- (setq |$until| nil)
- (setq |$initList| nil)
- (setq |$endTestList| nil)
- (setq |$e| e)
- (setq itl
- (dolist (x itl (nreverse0 tmp2))
- (setq tmp1 (or (|compIterator| x |$e|) (return '|failed|)))
- (setq |$e| (second tmp1))
- (push (elt tmp1 0) tmp2)))
- (unless (eq itl '|failed|)
- (setq e |$e|)
- (setq acc (gensym))
- (setq afterFirst (gensym))
- (setq bodyVal (gensym))
- (when (setq tmp1 (|comp| (list 'let bodyVal body ) m e))
- (setq part1 (first tmp1))
- (setq m (second tmp1))
- (setq e (third tmp1))
- (when (setq tmp1 (|comp| (list 'let acc bodyVal) m e))
- (setq part2 (first tmp1))
- (setq e (third tmp1))
- (when (setq tmp1
- (|comp| (list 'let acc (|parseTran| (list op acc bodyVal))) m e))
- (setq part3 (first tmp1))
- (setq e (third tmp1))
- (when (setq identityCode
- (if (setq id (|getIdentity| op e))
- (car (|comp| id m e))
- (list '|IdentityError| (mkq op))))
- (setq finalCode
- (cons 'progn
- (cons (list 'let afterFirst nil)
- (cons
- (cons 'repeat
- (append itl
- (list
- (list 'progn part1
- (list 'if afterFirst part3
- (list 'progn part2 (list 'let afterFirst (mkq t)))) nil))))
- (list (list 'if afterFirst acc identityCode ))))))
- (when |$until|
- (setq tmp1 (|comp| |$until| |$Boolean| e))
- (setq untilCode (first tmp1))
- (setq e (third tmp1))
- (setq finalCode
- (msubst (list 'until untilCode) '|$until| finalCode)))
- (list finalCode m e ))))))))))
+ env)))
\end{chunk}
-\defplist{return}{compReturn}
+\defplist{return}{compReturn plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|return| 'special) '|compReturn|))
@@ -7568,11 +7598,11 @@ An angry JHD - August 15th., 1984
\usesdollar{compReturn}{exitModeStack}
\usesdollar{compReturn}{returnMode}
\begin{chunk}{defun compReturn}
-(defun |compReturn| (arg m e)
+(defun |compReturn| (form mode env)
(let (level x index u xp mp ep)
(declare (special |$returnMode| |$exitModeStack|))
- (setq level (second arg))
- (setq x (third arg))
+ (setq level (second form))
+ (setq x (third form))
(cond
((null |$exitModeStack|)
(|stackSemanticError|
@@ -7585,18 +7615,18 @@ An angry JHD - August 15th., 1984
(when (>= index 0)
(setq |$returnMode|
(|resolve| (elt |$exitModeStack| index) |$returnMode|)))
- (when (setq u (|comp| x |$returnMode| e))
+ (when (setq u (|comp| x |$returnMode| env))
(setq xp (first u))
(setq mp (second u))
(setq ep (third u))
(when (>= index 0)
(setq |$returnMode| (|resolve| mp |$returnMode|))
(|modifyModeStack| mp index))
- (list (list '|TAGGEDreturn| 0 u) m ep))))))
+ (list (list '|TAGGEDreturn| 0 u) mode ep))))))
\end{chunk}
-\defplist{seq}{compSeq}
+\defplist{seq}{compSeq plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'seq 'special) '|compSeq|))
@@ -7607,9 +7637,9 @@ An angry JHD - August 15th., 1984
\calls{compSeq}{compSeq1}
\usesdollar{compSeq}{exitModeStack}
\begin{chunk}{defun compSeq}
-(defun |compSeq| (arg0 m e)
+(defun |compSeq| (form mode env)
(declare (special |$exitModeStack|))
- (|compSeq1| (cdr arg0) (cons m |$exitModeStack|) e))
+ (|compSeq1| (cdr form) (cons mode |$exitModeStack|) env))
\end{chunk}
@@ -7623,24 +7653,25 @@ An angry JHD - August 15th., 1984
\usesdollar{compSeq1}{finalEnv}
\usesdollar{compSeq1}{NoValueMode}
\begin{chunk}{defun compSeq1}
-(defun |compSeq1| (l |$exitModeStack| e)
+(defun |compSeq1| (form |$exitModeStack| env)
(declare (special |$exitModeStack|))
- (let (|$insideExpressionIfTrue| |$finalEnv| tmp1 tmp2 c catchTag form)
+ (let (|$insideExpressionIfTrue| |$finalEnv| tmp1 tmp2 c catchTag newform)
(declare (special |$insideExpressionIfTrue| |$finalEnv| |$NoValueMode|))
(setq |$insideExpressionIfTrue| nil)
(setq |$finalEnv| nil)
(when
- (setq c (dolist (x l (nreverse0 tmp2))
+ (setq c (dolist (x form (nreverse0 tmp2))
(setq |$insideExpressionIfTrue| nil)
- (setq tmp1 (|compSeqItem| x |$NoValueMode| e))
+ (setq tmp1 (|compSeqItem| x |$NoValueMode| env))
(unless tmp1 (return nil))
- (setq e (third tmp1))
+ (setq env (third tmp1))
(push (first tmp1) tmp2)))
(setq catchTag (mkq (gensym)))
- (setq form
+ (setq newform
(cons 'seq
(|replaceExitEtc| c catchTag '|TAGGEDexit| (elt |$exitModeStack| 0))))
- (list (list 'catch catchTag form) (elt |$exitModeStack| 0) |$finalEnv|))))
+ (list (list 'catch catchTag newform)
+ (elt |$exitModeStack| 0) |$finalEnv|))))
\end{chunk}
@@ -7648,19 +7679,19 @@ An angry JHD - August 15th., 1984
\calls{compSeqItem}{comp}
\calls{compSeqItem}{macroExpand}
\begin{chunk}{defun compSeqItem}
-(defun |compSeqItem| (x m e)
- (|comp| (|macroExpand| x e) m e))
+(defun |compSeqItem| (form mode env)
+ (|comp| (|macroExpand| form env) mode env))
\end{chunk}
-\defplist{let}{compSetq}
+\defplist{let}{compSetq plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'let 'special) '|compSetq|))
\end{chunk}
-\defplist{setq}{compSetq}
+\defplist{setq}{compSetq plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'setq 'special) '|compSetq|))
@@ -7670,8 +7701,8 @@ An angry JHD - August 15th., 1984
\defun{compSetq}{compSetq}
\calls{compSetq}{compSetq1}
\begin{chunk}{defun compSetq}
-(defun |compSetq| (arg m e)
- (|compSetq1| (second arg) (third arg) m e))
+(defun |compSetq| (form mode env)
+ (|compSetq1| (second form) (third form) mode env))
\end{chunk}
@@ -7686,32 +7717,33 @@ An angry JHD - August 15th., 1984
\calls{compSetq1}{setqSetelt}
\usesdollar{compSetq1}{EmptyMode}
\begin{chunk}{defun compSetq1}
-(defun |compSetq1| (form val m e)
+(defun |compSetq1| (form val mode env)
(let (x y ep op z)
(declare (special |$EmptyMode|))
(cond
- ((identp form) (|setqSingle| form val m e))
+ ((identp form) (|setqSingle| form val mode env))
((and (pairp form) (eq (qcar form) '|:|) (pairp (qcdr form))
(pairp (qcdr (qcdr form))) (eq (qcdr (qcdr (qcdr form))) nil))
(setq x (second form))
(setq y (third form))
- (setq ep (third (|compMakeDeclaration| form |$EmptyMode| e)))
- (|compSetq| (list 'let x val) m ep))
+ (setq ep (third (|compMakeDeclaration| form |$EmptyMode| env)))
+ (|compSetq| (list 'let x val) mode ep))
((pairp form)
(setq op (qcar form))
(setq z (qcdr form))
(cond
- ((eq op 'cons) (|setqMultiple| (|uncons| form) val m e))
- ((eq op '|@Tuple|) (|setqMultiple| z val m e))
- (t (|setqSetelt| form val m e)))))))
+ ((eq op 'cons) (|setqMultiple| (|uncons| form) val mode env))
+ ((eq op '|@Tuple|) (|setqMultiple| z val mode env))
+ (t (|setqSetelt| form val mode env)))))))
\end{chunk}
\defun{setqSetelt}{setqSetelt}
\calls{setqSetelt}{comp}
\begin{chunk}{defun setqSetelt}
-(defun |setqSetelt| (arg val m e)
- (|comp| (cons '|setelt| (cons (car arg) (append (cdr arg) (list val)))) m e))
+(defun |setqSetelt| (form val mode env)
+ (|comp| (cons '|setelt| (cons (car form) (append (cdr form) (list val))))
+ mode env))
\end{chunk}
@@ -7744,58 +7776,58 @@ An angry JHD - August 15th., 1984
\usesdollar{setqSingle}{EmptyMode}
\usesdollar{setqSingle}{NoValueMode}
\begin{chunk}{defun setqSingle}
-(defun |setqSingle| (id val m e)
+(defun |setqSingle| (form val mode env)
(let (|$insideSetqSingleIfTrue| currentProplist mpp maxmpp td x mp tp key
- newProplist ep k form)
+ newProplist ep k newform)
(declare (special |$insideSetqSingleIfTrue| |$QuickLet| |$form|
|$profileCompiler| |$EmptyMode| |$NoValueMode|))
(setq |$insideSetqSingleIfTrue| t)
- (setq currentProplist (|getProplist| id e))
+ (setq currentProplist (|getProplist| form env))
(setq mpp
- (or (|get| id '|mode| e) (|getmode| id e)
- (if (equal m |$NoValueMode|) |$EmptyMode| m)))
+ (or (|get| form '|mode| env) (|getmode| form env)
+ (if (equal mode |$NoValueMode|) |$EmptyMode| mode)))
(when (setq td
(cond
- ((setq td (|comp| val mpp e))
+ ((setq td (|comp| val mpp env))
td)
- ((and (null (|get| id '|mode| e))
- (nequal mpp (setq maxmpp (|maxSuperType| mpp e)))
- (setq td (|comp| val maxmpp e)))
+ ((and (null (|get| form '|mode| env))
+ (nequal mpp (setq maxmpp (|maxSuperType| mpp env)))
+ (setq td (|comp| val maxmpp env)))
td)
- ((and (setq td (|comp| val |$EmptyMode| e))
- (|getmode| (second td) e))
- (|assignError| val (second td) id mpp))))
- (when (setq tp (|convert| td m))
+ ((and (setq td (|comp| val |$EmptyMode| env))
+ (|getmode| (second td) env))
+ (|assignError| val (second td) form mpp))))
+ (when (setq tp (|convert| td mode))
(setq x (first tp))
(setq mp (second tp))
(setq ep (third tp))
- (when (and |$profileCompiler| (identp id))
- (setq key (if (member id (cdr |$form|)) '|arguments| '|locals|))
- (|profileRecord| key id (second td)))
+ (when (and |$profileCompiler| (identp form))
+ (setq key (if (member form (cdr |$form|)) '|arguments| '|locals|))
+ (|profileRecord| key form (second td)))
(setq newProplist
- (|consProplistOf| id currentProplist '|value|
+ (|consProplistOf| form currentProplist '|value|
(|removeEnv| (cons val (cdr td)))))
- (setq ep (if (pairp id) ep (|addBinding| id newProplist ep)))
+ (setq ep (if (pairp form) ep (|addBinding| form newProplist ep)))
(when (|isDomainForm| val ep)
- (when (|isDomainInScope| id ep)
+ (when (|isDomainInScope| form ep)
(|stackWarning|
- (list '|domain valued variable| '|%b| id '|%d|
+ (list '|domain valued variable| '|%b| form '|%d|
'|has been reassigned within its scope| )))
- (setq ep (|augModemapsFromDomain1| id val ep)))
- (if (setq k (|NRTassocIndex| id))
- (setq form (list 'setelt '$ k x))
- (setq form
+ (setq ep (|augModemapsFromDomain1| form val ep)))
+ (if (setq k (|NRTassocIndex| form))
+ (setq newform (list 'setelt '$ k x))
+ (setq newform
(if |$QuickLet|
- (list 'let id x)
- (list 'let id x
+ (list 'let form x)
+ (list 'let form x
(if (|isDomainForm| x ep)
- (list 'elt id 0)
- (car (|outputComp| id ep)))))))
- (list form mp ep)))))
+ (list 'elt form 0)
+ (car (|outputComp| form ep)))))))
+ (list newform mp ep)))))
\end{chunk}
-\defplist{String}{compString}
+\defplist{String}{compString plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|String| 'special) '|compString|))
@@ -7806,13 +7838,13 @@ An angry JHD - August 15th., 1984
\calls{compString}{resolve}
\usesdollar{compString}{StringCategory}
\begin{chunk}{defun compString}
-(defun |compString| (x m e)
+(defun |compString| (form mode env)
(declare (special |$StringCategory|))
- (list x (|resolve| |$StringCategory| m) e))
+ (list form (|resolve| |$StringCategory| mode) env))
\end{chunk}
-\defplist{SubDomain}{compSubDomain}
+\defplist{SubDomain}{compSubDomain plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|SubDomain| 'special) '|compSubDomain|))
@@ -7827,18 +7859,18 @@ An angry JHD - August 15th., 1984
\usesdollar{compSubDomain}{addForm}
\usesdollar{compSubDomain}{addFormLhs}
\begin{chunk}{defun compSubDomain}
-(defun |compSubDomain| (arg m e)
+(defun |compSubDomain| (form mode env)
(let (|$addFormLhs| |$addForm| domainForm predicate tmp1)
(declare (special |$addFormLhs| |$addForm| |$NRTaddForm| |$addFormLhs|))
- (setq domainForm (second arg))
- (setq predicate (third arg))
+ (setq domainForm (second form))
+ (setq predicate (third form))
(setq |$addFormLhs| domainForm)
(setq |$addForm| nil)
(setq |$NRTaddForm| domainForm)
- (setq tmp1 (|compSubDomain1| domainForm predicate m e))
+ (setq tmp1 (|compSubDomain1| domainForm predicate mode env))
(setq |$addForm| (first tmp1))
- (setq e (third tmp1))
- (|compCapsule| (list 'capsule) m e)))
+ (setq env (third tmp1))
+ (|compCapsule| (list 'capsule) mode env)))
\end{chunk}
@@ -7855,14 +7887,14 @@ An angry JHD - August 15th., 1984
\usesdollar{compSubDomain1}{Boolean}
\usesdollar{compSubDomain1}{EmptyMode}
\begin{chunk}{defun compSubDomain1}
-(defun |compSubDomain1| (domainForm predicate m e)
+(defun |compSubDomain1| (domainForm predicate mode env)
(let (u prefixPredicate opp dFp)
(declare (special |$CategoryFrame| |$op| |$lisplibSuperDomain| |$Boolean|
|$EmptyMode|))
- (setq e (third
+ (setq env (third
(|compMakeDeclaration| (list '|:| '|#1| domainForm)
- |$EmptyMode| (|addDomain| domainForm e))))
- (setq u (|compOrCroak| predicate |$Boolean| e))
+ |$EmptyMode| (|addDomain| domainForm env))))
+ (setq u (|compOrCroak| predicate |$Boolean| env))
(unless u
(|stackSemanticError|
(list '|predicate: | predicate
@@ -7879,11 +7911,11 @@ An angry JHD - August 15th., 1984
(list 'cons (list 'quote (cons |$op| prefixPredicate))
(list 'delasc opp (list '|get| dFp ''|SubDomain| '|$CategoryFrame|)))
'|$CategoryFrame|))))
- (list domainForm m e)))
+ (list domainForm mode env)))
\end{chunk}
-\defplist{SubsetCategory}{compSubsetCategory}
+\defplist{SubsetCategory}{compSubsetCategory plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|SubsetCategory| 'special) '|compSubsetCategory|))
@@ -7891,19 +7923,20 @@ An angry JHD - August 15th., 1984
\end{chunk}
\defun{compSubsetCategory}{compSubsetCategory}
+\tpdhere{See LocalAlgebra for an example call}
\calls{compSubsetCategory}{put}
\calls{compSubsetCategory}{comp}
\calls{compSubsetCategory}{msubst}
\usesdollar{compSubsetCategory}{lhsOfColon}
\begin{chunk}{defun compSubsetCategory}
-(defun |compSubsetCategory| (arg m e)
+(defun |compSubsetCategory| (form mode env)
(let (cat r)
(declare (special |$lhsOfColon|))
- (setq cat (second arg))
- (setq r (third arg))
+ (setq cat (second form))
+ (setq r (third form))
; --1. put "Subsets" property on R to allow directly coercion to subset;
; -- allow automatic coercion from subset to R but not vice versa
- (setq e (|put| r '|Subsets| (list (list |$lhsOfColon| '|isFalse|)) e))
+ (setq env (|put| r '|Subsets| (list (list |$lhsOfColon| '|isFalse|)) env))
; --2. give the subset domain modemaps of cat plus 3 new functions
(|comp|
(list '|Join| cat
@@ -7912,11 +7945,11 @@ An angry JHD - August 15th., 1984
(list 'signature '|coerce| (list r '$))
(list 'signature '|lift| (list r '$))
(list 'signature '|reduce| (list '$ r)))))
- m e)))
+ mode env)))
\end{chunk}
-\defplist{|}{compSuchthat}
+\defplist{|}{compSuchthat plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '\| 'special) '|compSuchthat|))
@@ -7928,24 +7961,24 @@ An angry JHD - August 15th., 1984
\calls{compSuchthat}{put}
\usesdollar{compSuchthat}{Boolean}
\begin{chunk}{defun compSuchthat}
-(defun |compSuchthat| (arg m e)
+(defun |compSuchthat| (form mode env)
(let (x p xp mp tmp1 pp)
(declare (special |$Boolean|))
- (setq x (second arg))
- (setq p (third arg))
- (when (setq tmp1 (|comp| x m e))
+ (setq x (second form))
+ (setq p (third form))
+ (when (setq tmp1 (|comp| x mode env))
(setq xp (first tmp1))
(setq mp (second tmp1))
- (setq e (third tmp1))
- (when (setq tmp1 (|comp| p |$Boolean| e))
+ (setq env (third tmp1))
+ (when (setq tmp1 (|comp| p |$Boolean| env))
(setq pp (first tmp1))
- (setq e (third tmp1))
- (setq e (|put| xp '|condition| pp e))
- (list xp mp e)))))
+ (setq env (third tmp1))
+ (setq e (|put| xp '|condition| pp env))
+ (list xp mp env)))))
\end{chunk}
-\defplist{vector}{compVector}
+\defplist{vector}{compVector plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'vector 'special) '|compVector|))
@@ -7962,28 +7995,29 @@ An angry JHD - August 15th., 1984
\calls{compVector}{comp}
\usesdollar{compVector}{EmptyVector}
\begin{chunk}{defun compVector}
-(defun |compVector| (l m e)
- (let (tmp1 tmp2 t0 failed (mUnder (second m)))
+(defun |compVector| (form mode env)
+ (let (tmp1 tmp2 t0 failed (newmode (second mode)))
(declare (special |$EmptyVector|))
- (if (null l)
- (list |$EmptyVector| m e)
+ (if (null form)
+ (list |$EmptyVector| mode env)
(progn
(setq t0
- (do ((t3 l (cdr t3)) (x nil))
+ (do ((t3 form (cdr t3)) (x nil))
((or (atom t3) failed) (unless failed (nreverse0 tmp2)))
(setq x (car t3))
- (if (setq tmp1 (|comp| x mUnder e))
+ (if (setq tmp1 (|comp| x newmode env))
(progn
- (setq mUnder (second tmp1))
- (setq e (third tmp1))
+ (setq newmode (second tmp1))
+ (setq env (third tmp1))
(push tmp1 tmp2))
(setq failed t))))
(unless failed
- (list (cons 'vector (loop for texpr in t0 collect (car texpr))) m e))))))
+ (list (cons 'vector
+ (loop for texpr in t0 collect (car texpr))) mode env))))))
\end{chunk}
-\defplist{where}{compWhere}
+\defplist{where}{compWhere plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|where| 'special) '|compWhere|))
@@ -7999,13 +8033,13 @@ An angry JHD - August 15th., 1984
\usesdollar{compWhere}{insideWhereIfTrue}
\usesdollar{compWhere}{EmptyMode}
\begin{chunk}{defun compWhere}
-(defun |compWhere| (arg0 m eInit)
- (let (|$insideExpressionIfTrue| |$insideWhereIfTrue| form exprList e
+(defun |compWhere| (form mode eInit)
+ (let (|$insideExpressionIfTrue| |$insideWhereIfTrue| newform exprList e
eBefore tmp1 x eAfter del eFinal)
(declare (special |$insideExpressionIfTrue| |$insideWhereIfTrue|
|$EmptyMode|))
- (setq form (second arg0))
- (setq exprlist (cddr arg0))
+ (setq newform (second form))
+ (setq exprlist (cddr form))
(setq |$insideExpressionIfTrue| nil)
(setq |$insideWhereIfTrue| t)
(setq e eInit)
@@ -8014,16 +8048,16 @@ An angry JHD - August 15th., 1984
(unless tmp1 (return nil))
(setq e (third tmp1)))
(setq |$insideWhereIfTrue| nil)
- (setq tmp1 (|comp| (|macroExpand| form (setq eBefore e)) m e))
+ (setq tmp1 (|comp| (|macroExpand| newform (setq eBefore e)) mode e))
(when tmp1
(setq x (first tmp1))
- (setq m (second tmp1))
+ (setq mode (second tmp1))
(setq eAfter (third tmp1))
(setq del (|deltaContour| eAfter eBefore))
(if del
(setq eFinal (|addContour| del eInit))
(setq eFinal eInit))
- (list x m eFinal)))))
+ (list x mode eFinal)))))
\end{chunk}
@@ -8151,8 +8185,8 @@ An angry JHD - August 15th., 1984
\calls{postScriptsForm}{length}
\calls{postScriptsForm}{postTranScripts}
\begin{chunk}{defun postScriptsForm}
-(defun |postScriptsForm| (arg0 argl)
- (let ((op (second arg0)) (a (third arg0)))
+(defun |postScriptsForm| (form argl)
+ (let ((op (second form)) (a (third form)))
(cons (|getScriptName| op a (|#| argl))
(append (|postTranScripts| a) argl))))
@@ -8326,7 +8360,7 @@ of the symbol being parsed. The original list read:
with postWith
\end{verbatim}
-\defplist{add}{postAdd}
+\defplist{add}{postAdd plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|add| '|postTran|) '|postAdd|))
@@ -8407,7 +8441,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{@}{postAtSign}
+\defplist{@}{postAtSign plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '@ '|postTran|) '|postAtSign|))
@@ -8448,7 +8482,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{:BF:}{postBigFloat}
+\defplist{:BF:}{postBigFloat plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|:BF:| '|postTran|) '|postBigFloat|))
@@ -8475,7 +8509,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{Block}{postBlock}
+\defplist{Block}{postBlock plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Block| '|postTran|) '|postBlock|))
@@ -8496,7 +8530,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{category}{postCategory}
+\defplist{category}{postCategory plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'category '|postTran|) '|postCategory|))
@@ -8574,7 +8608,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{collect}{postCollect}
+\defplist{collect}{postCollect plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'collect '|postTran|) '|postCollect|))
@@ -8642,7 +8676,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{:}{postColon}
+\defplist{:}{postColon plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|:| '|postTran|) '|postColon|))
@@ -8664,7 +8698,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{::}{postColonColon}
+\defplist{::}{postColonColon plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|::| '|postTran|) '|postColonColon|))
@@ -8683,7 +8717,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{,}{postComma}
+\defplist{,}{postComma plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|,| '|postTran|) '|postComma|))
@@ -8722,7 +8756,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{construct}{postConstruct}
+\defplist{construct}{postConstruct plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|construct| '|postTran|) '|postConstruct|))
@@ -8776,7 +8810,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{==}{postDef}
+\defplist{==}{postDef plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|==| '|postTran|) '|postDef|))
@@ -8873,7 +8907,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{$=>$}{postExit}
+\defplist{$=>$}{postExit plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|=>| '|postTran|) '|postExit|))
@@ -8890,7 +8924,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{if}{postIf}
+\defplist{if}{postIf plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|if| '|postTran|) '|postIf|))
@@ -8914,7 +8948,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{in}{postin}
+\defplist{in}{postin plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|in| '|postTran|) '|postin|))
@@ -8950,7 +8984,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{In}{postIn}
+\defplist{In}{postIn plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'in '|postTran|) '|postIn|))
@@ -8970,7 +9004,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{Join}{postJoin}
+\defplist{Join}{postJoin plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Join| '|postTran|) '|postJoin|))
@@ -8993,7 +9027,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{$->$}{postMapping}
+\defplist{$->$}{postMapping plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|->| '|postTran|) '|postMapping|))
@@ -9014,7 +9048,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{$==>$}{postMDef}
+\defplist{$==>$}{postMDef plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|==>| '|postTran|) '|postMDef|))
@@ -9065,7 +9099,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{pretend}{postPretend}
+\defplist{pretend}{postPretend plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|pretend| '|postTran|) '|postPretend|))
@@ -9081,7 +9115,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{quote}{postQUOTE}
+\defplist{quote}{postQUOTE plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'quote '|postTran|) '|postQUOTE|))
@@ -9094,7 +9128,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{reduce}{postReduce}
+\defplist{reduce}{postReduce plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Reduce| '|postTran|) '|postReduce|))
@@ -9120,7 +9154,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{repeat}{postRepeat}
+\defplist{repeat}{postRepeat plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get 'repeat '|postTran|) '|postRepeat|))
@@ -9140,7 +9174,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{Scripts}{postScripts}
+\defplist{Scripts}{postScripts plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Scripts| '|postTran|) '|postScripts|))
@@ -9157,7 +9191,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{;}{postSemiColon}
+\defplist{;}{postSemiColon plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|;| '|postTran|) '|postSemiColon|))
@@ -9189,7 +9223,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{Signature}{postSignature}
+\defplist{Signature}{postSignature plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|Signature| '|postTran|) '|postSignature|))
@@ -9238,7 +9272,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{/}{postSlash}
+\defplist{/}{postSlash plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '/ '|postTran|) '|postSlash|))
@@ -9255,7 +9289,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{@Tuple}{postTuple}
+\defplist{@Tuple}{postTuple plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|@Tuple| '|postTran|) '|postTuple|))
@@ -9274,7 +9308,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{TupleCollect}{postTupleCollect}
+\defplist{TupleCollect}{postTupleCollect plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|TupleCollect| '|postTran|) '|postTupleCollect|))
@@ -9294,7 +9328,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{where}{postWhere}
+\defplist{where}{postWhere plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|where| '|postTran|) '|postWhere|))
@@ -9313,7 +9347,7 @@ of the symbol being parsed. The original list read:
\end{chunk}
-\defplist{with}{postWith}
+\defplist{with}{postWith plist}
\begin{chunk}{postvars}
(eval-when (eval load)
(setf (get '|with| '|postTran|) '|postWith|))
@@ -11949,6 +11983,7 @@ Stack of results of reduced productions.
\calls{parseTranCheckForRecord}{parseTran}
\begin{chunk}{defun parseTranCheckForRecord}
(defun |parseTranCheckForRecord| (x op)
+ (declare (ignore op))
(let (tmp3)
(setq x (|parseTran| x))
(cond
@@ -13558,10 +13593,10 @@ And the {\bf s-process} function which returns a parsed version of the input.
\usesdollar{compTopLevel}{packagesUsed}
\usesdollar{compTopLevel}{envHashTable}
\begin{chunk}{defun compTopLevel}
-(defun |compTopLevel| (x m e)
+(defun |compTopLevel| (form mode env)
(let (|$NRTderivedTargetIfTrue| |$killOptimizeIfTrue| |$forceAdd|
|$compTimeSum| |$resolveTimeSum| |$packagesUsed| |$envHashTable|
- t1 t2 t3 val mode)
+ t1 t2 t3 val newmode)
(declare (special |$NRTderivedTargetIfTrue| |$killOptimizeIfTrue|
|$forceAdd| |$compTimeSum| |$resolveTimeSum|
|$packagesUsed| |$envHashTable| ))
@@ -13572,23 +13607,23 @@ And the {\bf s-process} function which returns a parsed version of the input.
(setq |$resolveTimeSum| 0)
(setq |$packagesUsed| NIL)
(setq |$envHashTable| (make-hashtable 'equal))
- (dolist (u (car (car e)))
+ (dolist (u (car (car env)))
(dolist (v (cdr u))
(hput |$envHashTable| (cons (car u) (cons (car v) nil)) t)))
(cond
- ((or (and (pairp x) (eq (qcar x) 'def))
- (and (pairp x) (eq (qcar x) '|where|)
+ ((or (and (pairp form) (eq (qcar form) 'def))
+ (and (pairp form) (eq (qcar form) '|where|)
(progn
- (setq t1 (qcdr x))
+ (setq t1 (qcdr form))
(and (pairp t1)
(progn
(setq t2 (qcar t1))
(and (pairp t2) (eq (qcar t2) 'def)))))))
- (setq t3 (|compOrCroak| x m e))
+ (setq t3 (|compOrCroak| form mode env))
(setq val (car t3))
- (setq mode (second t3))
- (cons val (cons mode (cons e nil))))
- (t (|compOrCroak| x m e)))))
+ (setq newmode (second t3))
+ (cons val (cons newmode (cons env nil))))
+ (t (|compOrCroak| form mode env)))))
\end{chunk}
Given:
@@ -13629,8 +13664,8 @@ The third argument, {\tt e}, is the environment.
\defun{compOrCroak}{compOrCroak}
\calls{compOrCroak}{compOrCroak1}
\begin{chunk}{defun compOrCroak}
-(defun |compOrCroak| (x m e)
- (|compOrCroak1| x m e nil nil))
+(defun |compOrCroak| (form mode env)
+ (|compOrCroak1| form mode env nil nil))
\end{chunk}
@@ -13680,14 +13715,15 @@ implicit stacking to retain the information.
\usesdollar{compOrCroak1}{exitModeStack}
\catches{compOrCroak1}{compOrCroak}
\begin{chunk}{defun compOrCroak1}
-(defun |compOrCroak1| (x m e |$compStack| |$compErrorMessageStack|)
+(defun |compOrCroak1| (form mode env |$compStack| |$compErrorMessageStack|)
(declare (special |$compStack| |$compErrorMessageStack|))
(let (td errorMessage)
(declare (special |$level| |$s| |$scanIfTrue| |$exitModeStack|))
(cond
- ((setq td (catch '|compOrCroak| (|comp| x m e))) td)
+ ((setq td (catch '|compOrCroak| (|comp| form mode env))) td)
(t
- (setq |$compStack| (cons (list x m e |$exitModeStack|) |$compStack|))
+ (setq |$compStack|
+ (cons (list form mode env |$exitModeStack|) |$compStack|))
(setq |$s| (|compOrCroak1,compactify| |$compStack|))
(setq |$level| (|#| |$s|))
(setq errorMessage
@@ -13697,7 +13733,7 @@ implicit stacking to retain the information.
(cond
(|$scanIfTrue|
(|stackSemanticError| errorMessage (|mkErrorExpr| |$level|))
- (list '|failedCompilation| m e ))
+ (list '|failedCompilation| mode env ))
(t
(|displaySemanticErrors|)
(say "****** comp fails at level " |$level| " with expression: ******")
@@ -13711,12 +13747,12 @@ implicit stacking to retain the information.
\usesdollar{comp}{compStack}
\usesdollar{comp}{exitModeStack}
\begin{chunk}{defun comp}
-(defun |comp| (x m e)
+(defun |comp| (form mode env)
(let (td)
(declare (special |$compStack| |$exitModeStack|))
- (if (setq td (|compNoStacking| x m e))
+ (if (setq td (|compNoStacking| form mode env))
(setq |$compStack| nil)
- (push (list x m e |$exitModeStack|) |$compStack|))
+ (push (list form mode env |$exitModeStack|) |$compStack|))
td))
\end{chunk}
@@ -13731,14 +13767,14 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{compNoStacking}{Representation}
\usesdollar{compNoStacking}{EmptyMode}
\begin{chunk}{defun compNoStacking}
-(defun |compNoStacking| (x m e)
+(defun |compNoStacking| (form mode env)
(let (td)
(declare (special |$compStack| |$Representation| |$EmptyMode|))
- (if (setq td (|comp2| x m e))
- (if (and (equal m |$EmptyMode|) (equal (second td) |$Representation|))
+ (if (setq td (|comp2| form mode env))
+ (if (and (equal mode |$EmptyMode|) (equal (second td) |$Representation|))
(list (car td) '$ (third td))
td)
- (|compNoStacking1| x m e |$compStack|))))
+ (|compNoStacking1| form mode env |$compStack|))))
\end{chunk}
@@ -13747,12 +13783,12 @@ preferred to the underlying representation -- RDJ 9/12/83
\calls{compNoStacking1}{comp2}
\usesdollar{compNoStacking1}{compStack}
\begin{chunk}{defun compNoStacking1}
-(defun |compNoStacking1| (x m e |$compStack|)
+(defun |compNoStacking1| (form mode env |$compStack|)
(declare (special |$compStack|))
(let (u td)
- (if (setq u (|get| (if (eq m '$) '|Rep| m) '|value| e))
- (if (setq td (|comp2| x (car u) e))
- (list (car td) m (third td))
+ (if (setq u (|get| (if (eq mode '$) '|Rep| mode) '|value| env))
+ (if (setq td (|comp2| form (car u) env))
+ (list (car td) mode (third td))
nil)
nil)))
@@ -13770,19 +13806,19 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{comp2}{packagesUsed}
\usesdollar{comp2}{lisplib}
\begin{chunk}{defun comp2}
-(defun |comp2| (x m e)
+(defun |comp2| (form mode env)
(let (tmp1)
(declare (special |$bootStrapMode| |$packagesUsed| $lisplib))
- (when (setq tmp1 (|comp3| x m e))
- (destructuring-bind (y mprime e) tmp1
- (when (and $lisplib (|isDomainForm| x e) (|isFunctor| x))
- (setq |$packagesUsed| (|insert| (list (|opOf| x)) |$packagesUsed|)))
+ (when (setq tmp1 (|comp3| form mode env))
+ (destructuring-bind (y mprime env) tmp1
+ (when (and $lisplib (|isDomainForm| form env) (|isFunctor| form))
+ (setq |$packagesUsed| (|insert| (list (|opOf| form)) |$packagesUsed|)))
; isDomainForm test needed to prevent error while compiling Ring
; $bootStrapMode-test necessary for compiling Ring in $bootStrapMode
- (if (and (nequal m mprime)
- (or |$bootStrapMode| (|isDomainForm| mprime e)))
- (list y mprime (|addDomain| mprime e))
- (list y mprime e))))))
+ (if (and (nequal mode mprime)
+ (or |$bootStrapMode| (|isDomainForm| mprime env)))
+ (list y mprime (|addDomain| mprime env))
+ (list y mprime env))))))
\end{chunk}
@@ -13825,33 +13861,35 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{comp3}{e}
\usesdollar{comp3}{insideCompTypeOf}
\begin{chunk}{defun comp3}
-(defun |comp3| (x m |$e|)
+(defun |comp3| (form mode |$e|)
(declare (special |$e|))
- (let (e a op ml u sig varlist tmp3 body tt xprime tmp1 mprime tmp2 eprime)
+ (let (env a op ml u sig varlist tmp3 body tt xprime tmp1 mprime tmp2 eprime)
(declare (special |$insideCompTypeOf|))
- (setq |$e| (|addDomain| m |$e|))
- (setq e |$e|)
+ (setq |$e| (|addDomain| mode |$e|))
+ (setq env |$e|)
(cond
- ((and (pairp m) (eq (qcar m) '|Mapping|)) (|compWithMappingMode| x m e))
- ((and (pairp m) (eq (qcar m) 'quote)
+ ((and (pairp mode) (eq (qcar mode) '|Mapping|))
+ (|compWithMappingMode| form mode env))
+ ((and (pairp mode) (eq (qcar mode) 'quote)
(progn
- (setq tmp1 (qcdr m))
+ (setq tmp1 (qcdr mode))
(and (pairp tmp1) (eq (qcdr tmp1) nil)
(progn (setq a (qcar tmp1)) t))))
- (when (equal x a) (list x m |$e|)))
- ((stringp m)
- (when (and (atom x) (or (equal m x) (equal m (princ-to-string x))))
- (list m m e )))
- ((or (null x) (atom x)) (|compAtom| x m e))
+ (when (equal form a) (list form mode |$e|)))
+ ((stringp mode)
+ (when (and (atom form)
+ (or (equal mode form) (equal mode (princ-to-string form))))
+ (list mode mode env )))
+ ((or (null form) (atom form)) (|compAtom| form mode env))
(t
- (setq op (car x))
+ (setq op (car form))
(cond
((and (progn
- (setq tmp1 (|getmode| op e))
+ (setq tmp1 (|getmode| op env))
(and (pairp tmp1)
(eq (qcar tmp1) '|Mapping|)
(progn (setq ml (qcdr tmp1)) t)))
- (setq u (|applyMapping| x m e ml)))
+ (setq u (|applyMapping| form mode env ml)))
u)
((and (pairp op) (eq (qcar op) 'kappa)
(progn
@@ -13869,14 +13907,14 @@ preferred to the underlying representation -- RDJ 9/12/83
(progn
(setq body (qcar tmp3))
t))))))))
- (|compApply| sig varlist body (cdr x) m e))
- ((eq op '|:|) (|compColon| x m e))
- ((eq op '|::|) (|compCoerce| x m e))
+ (|compApply| sig varlist body (cdr form) mode env))
+ ((eq op '|:|) (|compColon| form mode env))
+ ((eq op '|::|) (|compCoerce| form mode env))
((and (null (eq |$insideCompTypeOf| t))
(|stringPrefix?| "TypeOf" (pname op)))
- (|compTypeOf| x m e))
+ (|compTypeOf| form mode env))
(t
- (setq tt (|compExpression| x m e))
+ (setq tt (|compExpression| form mode env))
(cond
((and (pairp tt)
(progn
@@ -13905,16 +13943,16 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{compTypeOf}{insideCompTypeOf}
\usesdollar{compTypeOf}{FormalMapVariableList}
\begin{chunk}{defun compTypeOf}
-(defun |compTypeOf| (x m e)
+(defun |compTypeOf| (form mode env)
(let (|$insideCompTypeOf| op argl newModemap)
(declare (special |$insideCompTypeOf| |$FormalMapVariableList|))
- (setq op (car x))
- (setq argl (cdr x))
+ (setq op (car form))
+ (setq argl (cdr form))
(setq |$insideCompTypeOf| t)
(setq newModemap
- (eqsubstlist argl |$FormalMapVariableList| (|get| op '|modemap| e)))
- (setq e (|put| op '|modemap| newModemap e))
- (|comp3| x m e)))
+ (eqsubstlist argl |$FormalMapVariableList| (|get| op '|modemap| env)))
+ (setq env (|put| op '|modemap| newModemap env))
+ (|comp3| form mode env)))
\end{chunk}
@@ -13928,23 +13966,23 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{compColonInside}{newCompilerUnionFlag}
\usesdollar{compColonInside}{EmptyMode}
\begin{chunk}{defun compColonInside}
-(defun |compColonInside| (x m e mprime)
+(defun |compColonInside| (form mode env mprime)
(let (mpp warningMessage td tprime)
(declare (special |$newCompilerUnionFlag| |$EmptyMode|))
- (setq e (|addDomain| mprime e))
- (when (setq td (|comp| x |$EmptyMode| e))
+ (setq env (|addDomain| mprime env))
+ (when (setq td (|comp| form |$EmptyMode| env))
(cond
((equal (setq mpp (second td)) mprime)
(setq warningMessage
(list '|:| mprime '| -- should replace by @|))))
(setq td (list (car td) mprime (third td)))
- (when (setq tprime (|coerce| td m))
+ (when (setq tprime (|coerce| td mode))
(cond
(warningMessage (|stackWarning| warningMessage))
((and |$newCompilerUnionFlag| (eq (|opOf| mpp) '|Union|))
(setq tprime
(|stackSemanticError|
- (list '|cannot pretend | x '| of mode | mpp '| to mode | mprime )
+ (list '|cannot pretend | form '| of mode | mpp '| to mode | mprime )
nil)))
(t
(|stackWarning|
@@ -13982,17 +14020,18 @@ preferred to the underlying representation -- RDJ 9/12/83
\calls{compAtom}{primitiveType}
\usesdollar{compAtom}{Expression}
\begin{chunk}{defun compAtom}
-(defun |compAtom| (x m e)
+(defun |compAtom| (form mode env)
(prog (tmp1 tmp2 r td tt)
(declare (special |$Expression|))
(return
(cond
- ((setq td (|compAtomWithModemap| x m e (|get| x '|modemap| e))) td)
- ((eq x '|nil|)
+ ((setq td
+ (|compAtomWithModemap| form mode env (|get| form '|modemap| env))) td)
+ ((eq form '|nil|)
(setq td
(cond
((progn
- (setq tmp1 (|modeIsAggregateOf| '|List| m e))
+ (setq tmp1 (|modeIsAggregateOf| '|List| mode env))
(and (pairp tmp1)
(progn
(setq tmp2 (qcdr tmp1))
@@ -14000,25 +14039,26 @@ preferred to the underlying representation -- RDJ 9/12/83
(eq (qcdr tmp2) nil)
(progn
(setq r (qcar tmp2)) t)))))
- (|compList| x (list '|List| r) e))
+ (|compList| form (list '|List| r) env))
((progn
- (setq tmp1 (|modeIsAggregateOf| '|Vector| m e))
+ (setq tmp1 (|modeIsAggregateOf| '|Vector| mode env))
(and (pairp tmp1)
(progn
(setq tmp2 (qcdr tmp1))
(and (pairp tmp2) (eq (qcdr tmp2) nil)
(progn
(setq r (qcar tmp2)) t)))))
- (|compVector| x (list '|Vector| r) e))))
- (when td (|convert| td m)))
+ (|compVector| form (list '|Vector| r) env))))
+ (when td (|convert| td mode)))
(t
(setq tt
(cond
- ((|isSymbol| x) (or (|compSymbol| x m e) (return nil)))
- ((and (equal m |$Expression|) (|primitiveType| x)) (list x m e ))
- ((stringp x) (list x x e ))
- (t (list x (or (|primitiveType| x) (return nil)) e ))))
- (|convert| tt m))))))
+ ((|isSymbol| form) (or (|compSymbol| form mode env) (return nil)))
+ ((and (equal mode |$Expression|)
+ (|primitiveType| form)) (list form mode env ))
+ ((stringp form) (list form form env ))
+ (t (list form (or (|primitiveType| form) (return nil)) env ))))
+ (|convert| tt mode))))))
\end{chunk}
@@ -14026,12 +14066,13 @@ preferred to the underlying representation -- RDJ 9/12/83
\calls{convert}{resolve}
\calls{convert}{coerce}
\begin{chunk}{defun convert}
-(defun |convert| (td m)
+(defun |convert| (td mode)
(let (res)
- (when (setq res (|resolve| (second td) m))
+ (when (setq res (|resolve| (second td) mode))
(|coerce| td res))))
\end{chunk}
+
\defun{primitiveType}{primitiveType}
\usesdollar{primitiveType}{DoubleFloat}
\usesdollar{primitiveType}{NegativeInteger}
@@ -14040,18 +14081,18 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{primitiveType}{String}
\usesdollar{primitiveType}{EmptyMode}
\begin{chunk}{defun primitiveType}
-(defun |primitiveType| (x)
+(defun |primitiveType| (form)
(declare (special |$DoubleFloat| |$NegativeInteger| |$PositiveInteger|
|$NonNegativeInteger| |$String| |$EmptyMode|))
(cond
- ((null x) |$EmptyMode|)
- ((stringp x) |$String|)
- ((integerp x)
+ ((null form) |$EmptyMode|)
+ ((stringp form) |$String|)
+ ((integerp form)
(cond
- ((eql x 0) |$NonNegativeInteger|)
- ((> x 0) |$PositiveInteger|)
+ ((eql form 0) |$NonNegativeInteger|)
+ ((> form 0) |$PositiveInteger|)
(t |$NegativeInteger|)))
- ((floatp x) |$DoubleFloat|)
+ ((floatp form) |$DoubleFloat|)
(t nil)))
\end{chunk}
@@ -14073,41 +14114,42 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{compSymbol}{Boolean}
\usesdollar{compSymbol}{NoValue}
\begin{chunk}{defun compSymbol}
-(defun |compSymbol| (s m e)
- (let (v mprime mode)
+(defun |compSymbol| (form mode env)
+ (let (v mprime newmode)
(declare (special |$Symbol| |$Expression| |$FormalMapVariableList|
|$compForModeIfTrue| |$formalArgList| |$NoValueMode|
|$functorLocalParameters| |$Boolean| |$NoValue|))
(cond
- ((eq s '|$NoValue|) (list '|$NoValue| |$NoValueMode| e ))
- ((|isFluid| s)
- (setq mode (|getmode| s e))
- (when mode (list s (|getmode| s e) e)))
- ((eq s '|true|) (list '(quote t) |$Boolean| e ))
- ((eq s '|false|) (list nil |$Boolean| e ))
- ((or (equal s m) (|get| s '|isLiteral| e)) (list (list 'quote s) s e))
- ((setq v (|get| s '|value| e))
+ ((eq form '|$NoValue|) (list '|$NoValue| |$NoValueMode| env ))
+ ((|isFluid| form)
+ (setq newmode (|getmode| form env))
+ (when newmode (list form (|getmode| form env) env)))
+ ((eq form '|true|) (list '(quote t) |$Boolean| env ))
+ ((eq form '|false|) (list nil |$Boolean| env ))
+ ((or (equal form mode)
+ (|get| form '|isLiteral| env)) (list (list 'quote form) form env))
+ ((setq v (|get| form '|value| env))
(cond
- ((member s |$functorLocalParameters|)
+ ((member form |$functorLocalParameters|)
; s will be replaced by an ELT form in beforeCompile
- (|NRTgetLocalIndex| s)
- (list s (second v) e))
+ (|NRTgetLocalIndex| form)
+ (list form (second v) env))
(t
- ; s has been SETQd
- (list s (second v) e))))
- ((setq mprime (|getmode| s e))
+ ; form has been SETQd
+ (list form (second v) env))))
+ ((setq mprime (|getmode| form env))
(cond
- ((and (null (|member| s |$formalArgList|))
- (null (member s |$FormalMapVariableList|))
- (null (|isFunction| s e))
+ ((and (null (|member| form |$formalArgList|))
+ (null (member form |$FormalMapVariableList|))
+ (null (|isFunction| form env))
(null (eq |$compForModeIfTrue| t)))
- (|errorRef| s)))
- (list s mprime e ))
- ((member s |$FormalMapVariableList|)
- (|stackMessage| (list '|no mode found for| s )))
- ((or (equal m |$Expression|) (equal m |$Symbol|))
- (list (list 'quote s) m e ))
- ((null (|isFunction| s e)) (|errorRef| s)))))
+ (|errorRef| form)))
+ (list form mprime env ))
+ ((member form |$FormalMapVariableList|)
+ (|stackMessage| (list '|no mode found for| form )))
+ ((or (equal mode |$Expression|) (equal mode |$Symbol|))
+ (list (list 'quote form) mode env ))
+ ((null (|isFunction| form env)) (|errorRef| form)))))
\end{chunk}
@@ -14121,25 +14163,25 @@ preferred to the underlying representation -- RDJ 9/12/83
\end{verbatim}
\calls{compList}{comp}
\begin{chunk}{defun compList}
-(defun |compList| (l m e)
- (let (tmp1 tmp2 t0 failed (mUnder (second m)))
- (if (null l)
- (list nil m e)
+(defun |compList| (form mode env)
+ (let (tmp1 tmp2 t0 failed (newmode (second mode)))
+ (if (null form)
+ (list nil mode env)
(progn
(setq t0
- (do ((t3 l (cdr t3)) (x nil))
+ (do ((t3 form (cdr t3)) (x nil))
((or (atom t3) failed) (unless failed (nreverse0 tmp2)))
(setq x (car t3))
- (if (setq tmp1 (|comp| x mUnder e))
+ (if (setq tmp1 (|comp| x newmode env))
(progn
- (setq mUnder (second tmp1))
- (setq e (third tmp1))
+ (setq newmode (second tmp1))
+ (setq env (third tmp1))
(push tmp1 tmp2))
(setq failed t))))
(unless failed
(cons
(cons 'list (loop for texpr in t0 collect (car texpr)))
- (list (list '|List| mUnder) e)))))))
+ (list (list '|List| newmode) env)))))))
\end{chunk}
@@ -14148,13 +14190,13 @@ preferred to the underlying representation -- RDJ 9/12/83
\calls{compExpression}{compForm}
\usesdollar{compExpression}{insideExpressionIfTrue}
\begin{chunk}{defun compExpression}
-(defun |compExpression| (x m e)
+(defun |compExpression| (form mode env)
(let (|$insideExpressionIfTrue| fn)
(declare (special |$insideExpressionIfTrue|))
(setq |$insideExpressionIfTrue| t)
- (if (and (atom (car x)) (setq fn (getl (car x) 'special)))
- (funcall fn x m e)
- (|compForm| x m e))))
+ (if (and (atom (car form)) (setq fn (getl (car form) 'special)))
+ (funcall fn form mode env)
+ (|compForm| form mode env))))
\end{chunk}
@@ -14163,10 +14205,10 @@ preferred to the underlying representation -- RDJ 9/12/83
\calls{compForm}{compArgumentsAndTryAgain}
\calls{compForm}{stackMessageIfNone}
\begin{chunk}{defun compForm}
-(defun |compForm| (form m e)
+(defun |compForm| (form mode env)
(cond
- ((|compForm1| form m e))
- ((|compArgumentsAndTryAgain| form m e))
+ ((|compForm1| form mode env))
+ ((|compArgumentsAndTryAgain| form mode env))
(t (|stackMessageIfNone| (list '|cannot compile| '|%b| form '|%d| )))))
\end{chunk}
@@ -14189,7 +14231,7 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{compForm1}{Expression}
\usesdollar{compForm1}{EmptyMode}
\begin{chunk}{defun compForm1}
-(defun |compForm1| (form m e)
+(defun |compForm1| (form mode env)
(let (|$NumberOfArgsIfInteger| op argl domain tmp1 opprime ans mmList td
tmp2 tmp3 tmp4 tmp5 tmp6 tmp7)
(declare (special |$NumberOfArgsIfInteger| |$Expression| |$EmptyMode|))
@@ -14201,10 +14243,10 @@ preferred to the underlying representation -- RDJ 9/12/83
(list
(cons op
(dolist (x argl (nreverse0 tmp4))
- (setq tmp2 (|outputComp| x e))
- (setq e (third tmp2))
+ (setq tmp2 (|outputComp| x env))
+ (setq env (third tmp2))
(push (car tmp2) tmp4)))
- m e))
+ mode env))
((and (pairp op) (eq (qcar op) '|elt|)
(progn
(setq tmp3 (qcdr op))
@@ -14222,20 +14264,20 @@ preferred to the underlying representation -- RDJ 9/12/83
(list
(cons opprime
(dolist (x argl (nreverse tmp7))
- (setq tmp2 (|compOrCroak| x |$EmptyMode| e))
- (setq e (third tmp2))
+ (setq tmp2 (|compOrCroak| x |$EmptyMode| env))
+ (setq env (third tmp2))
(push (car tmp2) tmp7)))
- m e))
+ mode env))
((and (equal domain |$Expression|) (eq opprime '|construct|))
- (|compExpressionList| argl m e))
- ((and (eq opprime 'collect) (|coerceable| domain m e))
- (when (setq td (|comp| (cons opprime argl) domain e))
- (|coerce| td m)))
+ (|compExpressionList| argl mode env))
+ ((and (eq opprime 'collect) (|coerceable| domain mode env))
+ (when (setq td (|comp| (cons opprime argl) domain env))
+ (|coerce| td mode)))
((and (pairp domain) (eq (qcar domain) '|Mapping|)
(setq ans
- (|compForm2| (cons opprime argl) m
- (setq e (|augModemapsFromDomain1| domain domain e))
- (dolist (x (|getFormModemaps| (cons opprime argl) e)
+ (|compForm2| (cons opprime argl) mode
+ (setq env (|augModemapsFromDomain1| domain domain env))
+ (dolist (x (|getFormModemaps| (cons opprime argl) env)
(nreverse0 tmp6))
(when
(and (pairp x)
@@ -14243,27 +14285,27 @@ preferred to the underlying representation -- RDJ 9/12/83
(push x tmp6))))))
ans)
((setq ans
- (|compForm2| (cons opprime argl) m
- (setq e (|addDomain| domain e))
- (dolist (x (|getFormModemaps| (cons opprime argl) e)
+ (|compForm2| (cons opprime argl) mode
+ (setq env (|addDomain| domain env))
+ (dolist (x (|getFormModemaps| (cons opprime argl) env)
(nreverse0 tmp5))
(when
(and (pairp x)
(and (pairp (qcar x)) (equal (qcar (qcar x)) domain)))
(push x tmp5)))))
ans)
- ((and (eq opprime '|construct|) (|coerceable| domain m e))
- (when (setq td (|comp| (cons opprime argl) domain e))
- (|coerce| td m)))
+ ((and (eq opprime '|construct|) (|coerceable| domain mode env))
+ (when (setq td (|comp| (cons opprime argl) domain env))
+ (|coerce| td mode)))
(t nil)))
(t
- (setq e (|addDomain| m e))
+ (setq env (|addDomain| mode env))
(cond
- ((and (setq mmList (|getFormModemaps| form e))
- (setq td (|compForm2| form m e mmList)))
+ ((and (setq mmList (|getFormModemaps| form env))
+ (setq td (|compForm2| form mode env mmList)))
td)
(t
- (|compToApply| op argl m e)))))))
+ (|compToApply| op argl mode env)))))))
\end{chunk}
@@ -14281,7 +14323,7 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{compForm2}{EmptyMode}
\usesdollar{compForm2}{TriangleVariableList}
\begin{chunk}{defun compForm2}
-(defun |compForm2| (form m e modemapList)
+(defun |compForm2| (form mode env modemapList)
(let (op argl sargl aList dc cond nsig v ncond deleteList newList td tl
partialModeList tmp1 tmp2 tmp3 tmp4 tmp5 tmp6 tmp7)
(declare (special |$EmptyMode| |$TriangleVariableList|))
@@ -14343,15 +14385,16 @@ preferred to the underlying representation -- RDJ 9/12/83
(setq tl
(loop for x in argl
while (and (|isSimple| x)
- (setq td (|compUniquely| x |$EmptyMode| e)))
+ (setq td (|compUniquely| x |$EmptyMode| env)))
collect td
- do (setq e (third td))))
+ do (setq env (third td))))
(cond
((some #'identity tl)
(setq partialModeList (loop for x in tl collect (when x (second x))))
- (or (|compFormPartiallyBottomUp| form m e modemapList partialModeList)
- (|compForm3| form m e modemapList)))
- (t (|compForm3| form m e modemapList)))))
+ (or
+ (|compFormPartiallyBottomUp| form mode env modemapList partialModeList)
+ (|compForm3| form mode env modemapList)))
+ (t (|compForm3| form mode env modemapList)))))
\end{chunk}
@@ -14360,7 +14403,7 @@ preferred to the underlying representation -- RDJ 9/12/83
\calls{compArgumentsAndTryAgain}{compForm1}
\usesdollar{compArgumentsAndTryAgain}{EmptyMode}
\begin{chunk}{defun compArgumentsAndTryAgain}
-(defun |compArgumentsAndTryAgain| (form m e)
+(defun |compArgumentsAndTryAgain| (form mode env)
(let (argl tmp1 a tmp2 tmp3 u)
(declare (special |$EmptyMode|))
(setq argl (cdr form))
@@ -14373,26 +14416,26 @@ preferred to the underlying representation -- RDJ 9/12/83
(setq a (qcar tmp1))
(setq tmp2 (qcdr tmp1))
(and (pairp tmp2) (eq (qcdr tmp2) nil))))))
- (when (setq tmp3 (|comp| a |$EmptyMode| e))
- (setq e (third tmp3))
- (|compForm1| form m e)))
+ (when (setq tmp3 (|comp| a |$EmptyMode| env))
+ (setq env (third tmp3))
+ (|compForm1| form mode env)))
(t
(setq u
(dolist (x argl)
- (setq tmp3 (or (|comp| x |$EmptyMode| e) (return '|failed|)))
- (setq e (third tmp3))
+ (setq tmp3 (or (|comp| x |$EmptyMode| env) (return '|failed|)))
+ (setq env (third tmp3))
tmp3))
(unless (eq u '|failed|)
- (|compForm1| form m e))))))
+ (|compForm1| form mode env))))))
\end{chunk}
\defun{compWithMappingMode}{compWithMappingMode}
\calls{compWithMappingMode}{compWithMappingMode1}
\usesdollar{compWithMappingMode}{formalArgList}
\begin{chunk}{defun compWithMappingMode}
-(defun |compWithMappingMode| (x m oldE)
+(defun |compWithMappingMode| (form mode oldE)
(declare (special |$formalArgList|))
- (|compWithMappingMode1| x m oldE |$formalArgList|))
+ (|compWithMappingMode1| form mode oldE |$formalArgList|))
\end{chunk}
@@ -14532,7 +14575,7 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{compWithMappingMode1}{CategoryFrame}
\usesdollar{compWithMappingMode1}{formatArgList}
\begin{chunk}{defun compWithMappingMode1}
-(defun |compWithMappingMode1| (x m oldE |$formalArgList|)
+(defun |compWithMappingMode1| (form mode oldE |$formalArgList|)
(declare (special |$formalArgList|))
(prog (|$killOptimizeIfTrue| $funname $funnameTail mprime sl tmp1 tmp2
tmp3 tmp4 tmp5 tmp6 target argModeList nx oldstyle ress vl1 vl e tt
@@ -14543,15 +14586,15 @@ preferred to the underlying representation -- RDJ 9/12/83
(return
(seq
(progn
- (setq mprime (second m))
- (setq sl (cddr m))
+ (setq mprime (second mode))
+ (setq sl (cddr mode))
(setq |$killOptimizeIfTrue| t)
(setq e oldE)
(cond
- ((|isFunctor| x)
+ ((|isFunctor| form)
(cond
((and (progn
- (setq tmp1 (|get| x '|modemap| |$CategoryFrame|))
+ (setq tmp1 (|get| form '|modemap| |$CategoryFrame|))
(and (pairp tmp1)
(progn
(setq tmp2 (qcar tmp1))
@@ -14574,29 +14617,29 @@ preferred to the underlying representation -- RDJ 9/12/83
(return
(do ((t2 nil (null t1))
(t3 argModeList (cdr t3))
- (mode nil)
+ (newmode nil)
(t4 sl (cdr t4))
(s nil))
((or t2 (atom t3)
- (progn (setq mode (car t3)) nil)
+ (progn (setq newmode (car t3)) nil)
(atom t4)
(progn (setq s (car t4)) nil))
t1)
(seq (exit
(setq t1
- (and t1 (|extendsCategoryForm| '$ s mode))))))))
+ (and t1 (|extendsCategoryForm| '$ s newmode))))))))
(|extendsCategoryForm| '$ target mprime))
- (return (list x m e )))
+ (return (list form mode e )))
(t nil)))
(t
- (when (stringp x) (setq x (intern x)))
+ (when (stringp form) (setq form (intern form)))
(setq ress nil)
(setq oldstyle t)
(cond
- ((and (pairp x)
- (eq (qcar x) '+->)
+ ((and (pairp form)
+ (eq (qcar form) '+->)
(progn
- (setq tmp1 (qcdr x))
+ (setq tmp1 (qcdr form))
(and (pairp tmp1)
(progn
(setq vl (qcar tmp1))
@@ -14607,7 +14650,7 @@ preferred to the underlying representation -- RDJ 9/12/83
(setq oldstyle nil)
(cond
((and (pairp vl) (eq (qcar vl) '|:|))
- (setq ress (|compLambda| x m oldE))
+ (setq ress (|compLambda| form mode oldE))
ress)
(t
(setq vl
@@ -14636,7 +14679,7 @@ preferred to the underlying representation -- RDJ 9/12/83
(t
(|stackAndThrow| (cons '|bad +-> arguments:| (list vl ))))))
(setq |$formatArgList| (append vl |$formalArgList|))
- (setq x nx))))
+ (setq form nx))))
(t
(setq vl (take (|#| sl) |$FormalMapVariableList|))))
(cond
@@ -14656,19 +14699,19 @@ preferred to the underlying representation -- RDJ 9/12/83
(cond
((and oldstyle
(null (null vl))
- (null (|hasFormalMapVariable| x vl)))
+ (null (|hasFormalMapVariable| form vl)))
(return
(progn
- (setq tmp6 (or (|comp| (cons x vl) mprime e) (return nil)))
+ (setq tmp6 (or (|comp| (cons form vl) mprime e) (return nil)))
(setq u (car tmp6))
- (|extractCodeAndConstructTriple| u m oldE))))
- ((and (null vl) (setq tt (|comp| (cons x nil) mprime e)))
+ (|extractCodeAndConstructTriple| u mode oldE))))
+ ((and (null vl) (setq tt (|comp| (cons form nil) mprime e)))
(return
(progn
(setq u (car tt))
- (|extractCodeAndConstructTriple| u m oldE))))
+ (|extractCodeAndConstructTriple| u mode oldE))))
(t
- (setq tmp6 (or (|comp| x mprime e) (return nil)))
+ (setq tmp6 (or (|comp| form mprime e) (return nil)))
(setq u (car tmp6))
(setq uu (|optimizeFunctionDef| `(nil (lambda ,vl ,u))))
; -- At this point, we have a function that we would like to pass.
@@ -14756,18 +14799,18 @@ preferred to the underlying representation -- RDJ 9/12/83
(cond
(frees (list 'cons fname vec))
(t (list 'list fname))))
- (list uu m oldE))))))))))))
+ (list uu mode oldE))))))))))))
\end{chunk}
\defun{extractCodeAndConstructTriple}{extractCodeAndConstructTriple}
\begin{chunk}{defun extractCodeAndConstructTriple}
-(defun |extractCodeAndConstructTriple| (u m oldE)
+(defun |extractCodeAndConstructTriple| (form mode oldE)
(let (tmp1 a fn op env)
(cond
- ((and (pairp u) (eq (qcar u) '|call|)
+ ((and (pairp form) (eq (qcar form) '|call|)
(progn
- (setq tmp1 (qcdr u))
+ (setq tmp1 (qcdr form))
(and (pairp tmp1)
(progn (setq fn (qcar tmp1)) t))))
(cond
@@ -14777,11 +14820,11 @@ preferred to the underlying representation -- RDJ 9/12/83
(and (pairp tmp1) (eq (qcdr tmp1) nil)
(progn (setq a (qcar tmp1)) t))))
(setq fn a)))
- (list fn m oldE))
+ (list fn mode oldE))
(t
- (setq op (car u))
- (setq env (car (reverse (cdr u))))
- (list (list 'cons (list '|function| op) env) m oldE)))))
+ (setq op (car form))
+ (setq env (car (reverse (cdr form))))
+ (list (list 'cons (list '|function| op) env) mode oldE)))))
\end{chunk}
@@ -14845,11 +14888,11 @@ preferred to the underlying representation -- RDJ 9/12/83
\calls{compMakeDeclaration}{compColon}
\usesdollar{compMakeDeclaration}{insideExpressionIfTrue}
\begin{chunk}{defun compMakeDeclaration}
-(defun |compMakeDeclaration| (x m e)
+(defun |compMakeDeclaration| (form mode env)
(let (|$insideExpressionIfTrue|)
(declare (special |$insideExpressionIfTrue|))
(setq |$insideExpressionIfTrue| nil)
- (|compColon| x m e)))
+ (|compColon| form mode env)))
\end{chunk}
@@ -14861,17 +14904,17 @@ preferred to the underlying representation -- RDJ 9/12/83
\usesdollar{modifyModeStack}{reportExitModeStack}
\usesdollar{modifyModeStack}{exitModeStack}
\begin{chunk}{defun modifyModeStack}
-(defun |modifyModeStack| (|m| |index|)
+(defun |modifyModeStack| (m index)
(declare (special |$exitModeStack| |$reportExitModeStack|))
(if |$reportExitModeStack|
(say "exitModeStack: " (copy |$exitModeStack|)
" ====> "
(progn
- (setelt |$exitModeStack| |index|
- (|resolve| |m| (elt |$exitModeStack| |index|)))
+ (setelt |$exitModeStack| index
+ (|resolve| m (elt |$exitModeStack| index)))
|$exitModeStack|))
- (setelt |$exitModeStack| |index|
- (|resolve| |m| (elt |$exitModeStack| |index|)))))
+ (setelt |$exitModeStack| index
+ (|resolve| m (elt |$exitModeStack| index)))))
\end{chunk}
diff --git a/changelog b/changelog
index d834214..0f0140e 100644
--- a/changelog
+++ b/changelog
@@ -1,3 +1,5 @@
+20110514 tpd src/axiom-website/patches.html 20110514.02.tpd.patch
+20110514 tpd books/bookvol9 normalize argument names to top level functions
20110514 tpd src/axiom-website/patches.html 20110514.01.tpd.patch
20110514 tpd books/bookvolbib set textlength 400
20110514 tpd books/bookvol8 set textlength 400
diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html
index d42e9f0..38da88e 100644
--- a/src/axiom-website/patches.html
+++ b/src/axiom-website/patches.html
@@ -3470,7 +3470,9 @@ books/bookvol5 treeshake interpreter
books/bookvol5 treeshake interpreter
20110513.01.tpd.patch
books/bookvol9 treeshake compiler
-20110513.01.tpd.patch
+20110514.01.tpd.patch
books/bookvol* set textlength 400
+20110514.02.tpd.patch
+books/bookvol9 normalize argument names to top level functions