diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 92a2528..0942f8a 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -2556,6 +2556,491 @@ of the symbol being parsed. The original list read: @ +\chapter{Compile Transformers} +\section{Direct called comp routines} +\section{Indirect called comp routines} +In the {\bf compExpression} function there is the code: +\begin{verbatim} + (if (and (atom (car x)) (setq fn (getl (car x) 'special))) + (funcall fn x m e) + (|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|) + +\defplist{@}{compAtSign} +<>= +(eval-when (eval load) + (setf (get '|@| 'special) '|compAtSign|)) + +@ + +\defun{compAtSign}{compAtSign} +\calls{compAtSign}{addDomain} +\calls{compAtSign}{comp} +\calls{compAtSign}{coerce} +<>= +(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)))) + +@ + +\defplist{:}{compColon} +<>= +(eval-when (eval load) + (setf (get '|:| 'special) '|compColon|)) + +@ + +\defun{compColon}{compColon} +\begin{verbatim} +;compColon([":",f,t],m,e) == +; $insideExpressionIfTrue=true => compColonInside(f,m,e,t) +; --if inside an expression, ":" means to convert to m "on faith" +; $lhsOfColon: local:= f +; t:= +; atom t and (t':= ASSOC(t,getDomainsInScope e)) => t' +; isDomainForm(t,e) and not $insideCategoryIfTrue => +; (if not MEMBER(t,getDomainsInScope e) then e:= addDomain(t,e); t) +; isDomainForm(t,e) or isCategoryForm(t,e) => t +; t is ["Mapping",m',:r] => t +; unknownTypeError t +; t +; f is ["LISTOF",:l] => +; (for x in l repeat T:= [.,.,e]:= compColon([":",x,t],m,e); T) +; e:= +; f is [op,:argl] and not (t is ["Mapping",:.]) => +; --for MPOLY--replace parameters by formal arguments: RDJ 3/83 +; newTarget:= EQSUBSTLIST(take(#argl,$FormalMapVariableList), +; [(x is [":",a,m] => a; x) for x in argl],t) +; signature:= +; ["Mapping",newTarget,: +; [(x is [":",a,m] => m; +; getmode(x,e) or systemErrorHere '"compColonOld") for x in argl]] +; put(op,"mode",signature,e) +; put(f,"mode",t,e) +; if not $bootStrapMode and $insideFunctorIfTrue and +; makeCategoryForm(t,e) is [catform,e] then +; e:= put(f,"value",[genSomeVariable(),t,$noEnv],e) +; ["/throwAway",getmode(f,e),e] +\end{verbatim} +\calls{compColon}{compColonInside} +\calls{compColon}{assoc} +\calls{compColon}{getDomainsInScope} +\calls{compColon}{isDomainForm} +\calls{compColon}{member} +\calls{compColon}{addDomain} +\calls{compColon}{isDomainForm} +\calls{compColon}{isCategoryForm} +\calls{compColon}{unknownTypeError} +\calls{compColon}{compColon} +\calls{compColon}{eqsubstlist} +\calls{compColon}{take} +\calls{compColon}{length} +\calls{compColon}{nreverse0} +\calls{compColon}{getmode} +\calls{compColon}{systemErrorHere} +\calls{compColon}{put} +\calls{compColon}{makeCategoryForm} +\calls{compColon}{genSomeVariable} +\usesdollar{compColon}{lhsOfColon} +\usesdollar{compColon}{noEnv} +\usesdollar{compColon}{insideFunctorIfTrue} +\usesdollar{compColon}{bootStrapMode} +\usesdollar{compColon}{FormalMapVariableList} +\usesdollar{compColon}{insideCategoryIfTrue} +\usesdollar{compColon}{insideExpressionIfTrue} +<>= +(defun |compColon| (arg0 m e) + (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)) + (if |$insideExpressionIfTrue| + (|compColonInside| argf m e argt) + (progn + (setq |$lhsOfColon| argf) + (setq argt + (cond + ((and (atom argt) + (setq tprime (|assoc| argt (|getDomainsInScope| e)))) + tprime) + ((and (|isDomainForm| argt e) (null |$insideCategoryIfTrue|)) + (unless (|member| argt (|getDomainsInScope| e)) + (setq e (|addDomain| argt e))) + argt) + ((or (|isDomainForm| argt e) (|isCategoryForm| argt e)) + argt) + ((and (pairp argt) (eq (qcar argt) '|Mapping|) + (progn + (setq tmp2 (qcdr argt)) + (and (pairp tmp2) + (progn + (setq mprime (qcar tmp2)) + (setq r (qcdr tmp2)) + t)))) + argt) + (t + (|unknownTypeError| argt) + argt))) + (cond + ((eq (car argf) 'listof) + (dolist (x (cdr argf) td) + (setq td (|compColon| (list '|:| x argt) m e)) + (setq e (third td)))) + (t + (setq e + (cond + ((and (pairp argf) + (progn + (setq op (qcar argf)) + (setq argl (qcdr argf)) + t) + (null (and (pairp argt) (eq (qcar argt) '|Mapping|)))) + (setq newTarget + (eqsubstlist (take (|#| argl) |$FormalMapVariableList|) + (dolist (x argl (nreverse0 g2)) + (setq g2 + (cons + (cond + ((and (pairp x) (eq (qcar x) '|:|) + (progn + (setq tmp2 (qcdr x)) + (and (pairp tmp2) + (progn + (setq a (qcar tmp2)) + (setq tmp3 (qcdr tmp2)) + (and (pairp tmp3) + (eq (qcdr tmp3) nil) + (progn + (setq m (qcar tmp3)) + t)))))) + a) + (t x)) + g2))) + argt)) + (setq signature + (cons '|Mapping| + (cons newTarget + (dolist (x argl (nreverse0 g5)) + (setq g5 + (cons + (cond + ((and (pairp x) (eq (qcar x) '|:|) + (progn + (setq tmp2 (qcdr x)) + (and (pairp tmp2) + (progn + (setq a (qcar tmp2)) + (setq tmp3 (qcdr tmp2)) + (and (pairp tmp3) + (eq (qcdr tmp3) nil) + (progn + (setq m (qcar tmp3)) + t)))))) + m) + (t + (or (|getmode| x e) + (|systemErrorHere| "compColonOld")))) + g5)))))) + (|put| op '|mode| signature e)) + (t (|put| argf '|mode| argt e)))) + (cond + ((and (null |$bootStrapMode|) |$insideFunctorIfTrue| + (progn + (setq tmp2 (|makeCategoryForm| argt e)) + (and (pairp tmp2) + (progn + (setq catform (qcar tmp2)) + (setq tmp3 (qcdr tmp2)) + (and (pairp tmp3) + (eq (qcdr tmp3) nil) + (progn + (setq e (qcar tmp3)) + t)))))) + (setq e + (|put| argf '|value| (list (|genSomeVariable|) argt |$noEnv|) + e)))) + (list '|/throwAway| (|getmode| argf e) e ))))))) + +@ + +\defplist{exit}{compExit} +<>= +(eval-when (eval load) + (setf (get '|exit| 'special) '|compExit|)) + +@ + +\defun{compExit}{compExit} +\calls{compExit}{comp} +\calls{compExit}{modifyModeStack} +\calls{compExit}{stackMessageIfNone} +\usesdollar{compExit}{exitModeStack} +<>= +(defun |compExit| (arg0 m e) + (let (x index m1 u) + (declare (special |$exitModeStack|)) + (setq index (1- (second arg0))) + (setq x (third arg0)) + (cond + ((null |$exitModeStack|) + (|comp| x m e)) + (t + (setq m1 (elt |$exitModeStack| index)) + (setq u (|comp| x m1 e)) + (cond + (u + (|modifyModeStack| (second u) index) + (list (list '|TAGGEDexit| index u) m e)) + (t + (|stackMessageIfNone| + (list '|cannot compile exit expression| x '|in mode| m1)))))))) + +@ + +\defplist{+->}{compLambda} +<>= +(eval-when (eval load) + (setf (get '|+->| 'special) '|compLambda|)) + +@ + +\defun{compLambda}{compLambda} +\calls{compLambda}{qcar} +\calls{compLambda}{qcdr} +\calls{compLambda}{argsToSig} +\calls{compLambda}{compAtSign} +\calls{compLambda}{stackAndThrow} +<>= +(defun |compLambda| (x m e) + (let (vl body tmp1 tmp2 tmp3 target args arg1 sig1 ress) + (setq vl (second x)) + (setq body (third x)) + (cond + ((and (pairp vl) (eq (qcar vl) '|:|) + (progn + (setq tmp1 (qcdr vl)) + (and (pairp tmp1) + (progn + (setq args (qcar tmp1)) + (setq tmp2 (qcdr tmp1)) + (and (pairp tmp2) + (eq (qcdr tmp2) nil) + (progn + (setq target (qcar tmp2)) + t)))))) + (when (and (pairp args) (eq (qcar args) '|@Tuple|)) + (setq args (qcdr args))) + (cond + ((listp args) + (setq tmp3 (|argsToSig| args)) + (setq arg1 (CAR tmp3)) + (setq sig1 (second tmp3)) + (cond + (sig1 + (setq ress + (|compAtSign| + (list '@ + (list '+-> arg1 body) + (cons '|Mapping| (cons target sig1))) m e)) + ress) + (t (|stackAndThrow| (list '|compLambda| x ))))) + (t (|stackAndThrow| (list '|compLambda| x ))))) + (t (|stackAndThrow| (list '|compLambda| x )))))) + +@ + +\defplist{seq}{compSeq} +<>= +(eval-when (eval load) + (setf (get 'seq 'special) '|compSeq|)) + +@ + +\defun{compSeq}{compSeq} +\calls{compSeq}{compSeq1} +\usesdollar{compSeq}{exitModeStack} +<>= +(defun |compSeq| (arg0 m e) + (declare (special |$exitModeStack|)) + (|compSeq1| (cdr arg0) (cons m |$exitModeStack|) e)) + +@ + +\defun{compSeq1}{compSeq1} +\calls{compSeq1}{nreverse0} +\calls{compSeq1}{compSeqItem} +\calls{compSeq1}{mkq} +\calls{compSeq1}{replaceExitEtc} +\usesdollar{compSeq1}{exitModeStack} +\usesdollar{compSeq1}{insideExpressionIfTrue} +\usesdollar{compSeq1}{finalEnv} +\usesdollar{compSeq1}{NoValueMode} +<>= +(defun |compSeq1| (l |$exitModeStack| e) + (declare (special |$exitModeStack|)) + (let (|$insideExpressionIfTrue| |$finalEnv| tmp1 tmp2 c catchTag form) + (declare (special |$insideExpressionIfTrue| |$finalEnv| |$NoValueMode|)) + (setq |$insideExpressionIfTrue| nil) + (setq |$finalEnv| nil) + (when + (setq c (dolist (x l (nreverse0 tmp2)) + (setq |$insideExpressionIfTrue| nil) + (setq tmp1 (|compSeqItem| x |$NoValueMode| e)) + (unless tmp1 (return nil)) + (setq e (third tmp1)) + (push (first tmp1) tmp2))) + (setq catchTag (mkq (gensym))) + (setq form + (cons 'seq + (|replaceExitEtc| c catchTag '|TAGGEDexit| (elt |$exitModeStack| 0)))) + (list (list 'catch catchTag form) (elt |$exitModeStack| 0) |$finalEnv|)))) + +@ + +\defun{compSeqItem}{compSeqItem} +\calls{compSeqItem}{comp} +\calls{compSeqItem}{macroExpand} +<>= +(defun |compSeqItem| (x m e) + (|comp| (|macroExpand| x e) m e)) + +@ + +\defplist{vector}{compVector} +<>= +(eval-when (eval load) + (setf (get 'vector 'special) '|compVector|)) + +@ + +\defun{compVector}{compVector} +\begin{verbatim} +; null l => [$EmptyVector,m,e] +; Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] +; Tl="failed" => nil +; [["VECTOR",:[T.expr for T in Tl]],m,e] +\end{verbatim} +\calls{compVector}{comp} +\usesdollar{compVector}{EmptyVector} +<>= +(defun |compVector| (l m e) + (let (tmp1 tmp2 t0 failed (mUnder (second m))) + (declare (special |$EmptyVector|)) + (if (null l) + (list |$EmptyVector| m e) + (progn + (setq t0 + (do ((t3 l (cdr t3)) (x nil)) + ((or (atom t3) failed) (unless failed (nreverse0 tmp2))) + (setq x (car t3)) + (if (setq tmp1 (|comp| x mUnder e)) + (progn + (setq mUnder (second tmp1)) + (setq e (third tmp1)) + (push tmp1 tmp2)) + (setq failed t)))) + (unless failed + (list (cons 'vector (loop for texpr in t0 collect (car texpr))) m e)))))) + +@ + +\defplist{where}{compWhere} +<>= +(eval-when (eval load) + (setf (get '|where| 'special) '|compWhere|)) + +@ + +\defun{compWhere}{compWhere} +\calls{compWhere}{comp} +\calls{compWhere}{macroExpand} +\calls{compWhere}{deltaContour} +\calls{compWhere}{addContour} +\usesdollar{compWhere}{insideExpressionIfTrue} +\usesdollar{compWhere}{insideWhereIfTrue} +\usesdollar{compWhere}{EmptyMode} +<>= +(defun |compWhere| (arg0 m eInit) + (let (|$insideExpressionIfTrue| |$insideWhereIfTrue| form exprList e + eBefore tmp1 x eAfter del eFinal) + (declare (special |$insideExpressionIfTrue| |$insideWhereIfTrue| + |$EmptyMode|)) + (setq form (second arg0)) + (setq exprlist (cddr arg0)) + (setq |$insideExpressionIfTrue| nil) + (setq |$insideWhereIfTrue| t) + (setq e eInit) + (when (dolist (item exprList t) + (setq tmp1 (|comp| item |$EmptyMode| e)) + (unless tmp1 (return nil)) + (setq e (third tmp1))) + (setq |$insideWhereIfTrue| nil) + (setq tmp1 (|comp| (|macroExpand| form (setq eBefore e)) m e)) + (when tmp1 + (setq x (first tmp1)) + (setq m (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))))) + +@ + \chapter{Post Transformers} \section{Direct called postparse routines} \defun{postTransform}{postTransform} @@ -3411,7 +3896,7 @@ of the symbol being parsed. The original list read: \defplist{quote}{postQUOTE} <>= (eval-when (eval load) - (setf (get 'quote '|postTran|) '|postQuote|)) + (setf (get 'quote '|postTran|) '|postQUOTE|)) @ @@ -7969,7 +8454,7 @@ And the {\bf s-process} function which returns a parsed version of the input. (if (not |$InteractiveMode|) (list (|addBinding| '|$DomainsInScope| `((fluid . |true|) - (|special| . ,(copy-tree |$InitialDomainsInScope|))) + (special . ,(copy-tree |$InitialDomainsInScope|))) (|addBinding| '|$Information| nil (|makeInitialModemapFrame|))))) (init-boot/spad-reader) @@ -8184,7 +8669,7 @@ the resulting call looks like: ((( (|$DomainsInScope| (FLUID . |true|) - (|special| |$EmptyMode| |$NoValueMode|)))))) + (special |$EmptyMode| |$NoValueMode|)))))) \end{verbatim} This compiler call expects the first argument {\tt x} @@ -8217,7 +8702,7 @@ This results in a call to the inner function with (((( |$DomainsInScope| (FLUID . |true|) - (|special| |$EmptyMode| |$NoValueMode|))))) + (special |$EmptyMode| |$NoValueMode|))))) NIL NIL |comp|) @@ -8485,182 +8970,6 @@ preferred to the underlying representation -- RDJ 9/12/83 @ -\defun{compColon}{compColon} -\begin{verbatim} -;compColon([":",f,t],m,e) == -; $insideExpressionIfTrue=true => compColonInside(f,m,e,t) -; --if inside an expression, ":" means to convert to m "on faith" -; $lhsOfColon: local:= f -; t:= -; atom t and (t':= ASSOC(t,getDomainsInScope e)) => t' -; isDomainForm(t,e) and not $insideCategoryIfTrue => -; (if not MEMBER(t,getDomainsInScope e) then e:= addDomain(t,e); t) -; isDomainForm(t,e) or isCategoryForm(t,e) => t -; t is ["Mapping",m',:r] => t -; unknownTypeError t -; t -; f is ["LISTOF",:l] => -; (for x in l repeat T:= [.,.,e]:= compColon([":",x,t],m,e); T) -; e:= -; f is [op,:argl] and not (t is ["Mapping",:.]) => -; --for MPOLY--replace parameters by formal arguments: RDJ 3/83 -; newTarget:= EQSUBSTLIST(take(#argl,$FormalMapVariableList), -; [(x is [":",a,m] => a; x) for x in argl],t) -; signature:= -; ["Mapping",newTarget,: -; [(x is [":",a,m] => m; -; getmode(x,e) or systemErrorHere '"compColonOld") for x in argl]] -; put(op,"mode",signature,e) -; put(f,"mode",t,e) -; if not $bootStrapMode and $insideFunctorIfTrue and -; makeCategoryForm(t,e) is [catform,e] then -; e:= put(f,"value",[genSomeVariable(),t,$noEnv],e) -; ["/throwAway",getmode(f,e),e] -\end{verbatim} -\calls{compColon}{compColonInside} -\calls{compColon}{assoc} -\calls{compColon}{getDomainsInScope} -\calls{compColon}{isDomainForm} -\calls{compColon}{member} -\calls{compColon}{addDomain} -\calls{compColon}{isDomainForm} -\calls{compColon}{isCategoryForm} -\calls{compColon}{unknownTypeError} -\calls{compColon}{compColon} -\calls{compColon}{eqsubstlist} -\calls{compColon}{take} -\calls{compColon}{length} -\calls{compColon}{nreverse0} -\calls{compColon}{getmode} -\calls{compColon}{systemErrorHere} -\calls{compColon}{put} -\calls{compColon}{makeCategoryForm} -\calls{compColon}{genSomeVariable} -\usesdollar{compColon}{lhsOfColon} -\usesdollar{compColon}{noEnv} -\usesdollar{compColon}{insideFunctorIfTrue} -\usesdollar{compColon}{bootStrapMode} -\usesdollar{compColon}{FormalMapVariableList} -\usesdollar{compColon}{insideCategoryIfTrue} -\usesdollar{compColon}{insideExpressionIfTrue} -<>= -(defun |compColon| (arg0 m e) - (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)) - (if |$insideExpressionIfTrue| - (|compColonInside| argf m e argt) - (progn - (setq |$lhsOfColon| argf) - (setq argt - (cond - ((and (atom argt) - (setq tprime (|assoc| argt (|getDomainsInScope| e)))) - tprime) - ((and (|isDomainForm| argt e) (null |$insideCategoryIfTrue|)) - (unless (|member| argt (|getDomainsInScope| e)) - (setq e (|addDomain| argt e))) - argt) - ((or (|isDomainForm| argt e) (|isCategoryForm| argt e)) - argt) - ((and (pairp argt) (eq (qcar argt) '|Mapping|) - (progn - (setq tmp2 (qcdr argt)) - (and (pairp tmp2) - (progn - (setq mprime (qcar tmp2)) - (setq r (qcdr tmp2)) - t)))) - argt) - (t - (|unknownTypeError| argt) - argt))) - (cond - ((eq (car argf) 'listof) - (dolist (x (cdr argf) td) - (setq td (|compColon| (list '|:| x argt) m e)) - (setq e (third td)))) - (t - (setq e - (cond - ((and (pairp argf) - (progn - (setq op (qcar argf)) - (setq argl (qcdr argf)) - t) - (null (and (pairp argt) (eq (qcar argt) '|Mapping|)))) - (setq newTarget - (eqsubstlist (take (|#| argl) |$FormalMapVariableList|) - (dolist (x argl (nreverse0 g2)) - (setq g2 - (cons - (cond - ((and (pairp x) (eq (qcar x) '|:|) - (progn - (setq tmp2 (qcdr x)) - (and (pairp tmp2) - (progn - (setq a (qcar tmp2)) - (setq tmp3 (qcdr tmp2)) - (and (pairp tmp3) - (eq (qcdr tmp3) nil) - (progn - (setq m (qcar tmp3)) - t)))))) - a) - (t x)) - g2))) - argt)) - (setq signature - (cons '|Mapping| - (cons newTarget - (dolist (x argl (nreverse0 g5)) - (setq g5 - (cons - (cond - ((and (pairp x) (eq (qcar x) '|:|) - (progn - (setq tmp2 (qcdr x)) - (and (pairp tmp2) - (progn - (setq a (qcar tmp2)) - (setq tmp3 (qcdr tmp2)) - (and (pairp tmp3) - (eq (qcdr tmp3) nil) - (progn - (setq m (qcar tmp3)) - t)))))) - m) - (t - (or (|getmode| x e) - (|systemErrorHere| "compColonOld")))) - g5)))))) - (|put| op '|mode| signature e)) - (t (|put| argf '|mode| argt e)))) - (cond - ((and (null |$bootStrapMode|) |$insideFunctorIfTrue| - (progn - (setq tmp2 (|makeCategoryForm| argt e)) - (and (pairp tmp2) - (progn - (setq catform (qcar tmp2)) - (setq tmp3 (qcdr tmp2)) - (and (pairp tmp3) - (eq (qcdr tmp3) nil) - (progn - (setq e (qcar tmp3)) - t)))))) - (setq e - (|put| argf '|value| (list (|genSomeVariable|) argt |$noEnv|) - e)))) - (list '|/throwAway| (|getmode| argf e) e ))))))) - -@ - \defun{compColonInside}{compColonInside} \calls{compColonInside}{addDomain} \calls{compColonInside}{comp} @@ -8886,36 +9195,6 @@ preferred to the underlying representation -- RDJ 9/12/83 @ -\defun{compVector}{compVector} -\begin{verbatim} -; null l => [$EmptyVector,m,e] -; Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l] -; Tl="failed" => nil -; [["VECTOR",:[T.expr for T in Tl]],m,e] -\end{verbatim} -\calls{compVector}{comp} -\usesdollar{compVector}{EmptyVector} -<>= -(defun |compVector| (l m e) - (let (tmp1 tmp2 t0 failed (mUnder (second m))) - (declare (special |$EmptyVector|)) - (if (null l) - (list |$EmptyVector| m e) - (progn - (setq t0 - (do ((t3 l (cdr t3)) (x nil)) - ((or (atom t3) failed) (unless failed (nreverse0 tmp2))) - (setq x (car t3)) - (if (setq tmp1 (|comp| x mUnder e)) - (progn - (setq mUnder (second tmp1)) - (setq e (third tmp1)) - (push tmp1 tmp2)) - (setq failed t)))) - (unless failed - (list (cons 'vector (loop for texpr in t0 collect (car texpr))) m e)))))) - -@ \defun{compExpression}{compExpression} \calls{compExpression}{getl} \calls{compExpression}{compForm} @@ -9569,149 +9848,6 @@ preferred to the underlying representation -- RDJ 9/12/83 (|ScanOrPairVec| #'(lambda (y) (member y |$formalMapVariables|)) x)))) @ -\defun{compLambda}{compLambda} -\calls{compLambda}{qcar} -\calls{compLambda}{qcdr} -\calls{compLambda}{argsToSig} -\calls{compLambda}{compAtSign} -\calls{compLambda}{stackAndThrow} -<>= -(defun |compLambda| (x m e) - (let (vl body tmp1 tmp2 tmp3 target args arg1 sig1 ress) - (setq vl (second x)) - (setq body (third x)) - (cond - ((and (pairp vl) (eq (qcar vl) '|:|) - (progn - (setq tmp1 (qcdr vl)) - (and (pairp tmp1) - (progn - (setq args (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) - (and (pairp tmp2) - (eq (qcdr tmp2) nil) - (progn - (setq target (qcar tmp2)) - t)))))) - (when (and (pairp args) (eq (qcar args) '|@Tuple|)) - (setq args (qcdr args))) - (cond - ((listp args) - (setq tmp3 (|argsToSig| args)) - (setq arg1 (CAR tmp3)) - (setq sig1 (second tmp3)) - (cond - (sig1 - (setq ress - (|compAtSign| - (list '@ - (list '+-> arg1 body) - (cons '|Mapping| (cons target sig1))) m e)) - ress) - (t (|stackAndThrow| (list '|compLambda| x ))))) - (t (|stackAndThrow| (list '|compLambda| x ))))) - (t (|stackAndThrow| (list '|compLambda| x )))))) - -@ - -\defun{compAtSign}{compAtSign} -\calls{compAtSign}{addDomain} -\calls{compAtSign}{comp} -\calls{compAtSign}{coerce} -<>= -(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{compWhere}{compWhere} -\calls{compWhere}{comp} -\calls{compWhere}{macroExpand} -\calls{compWhere}{deltaContour} -\calls{compWhere}{addContour} -\usesdollar{compWhere}{insideExpressionIfTrue} -\usesdollar{compWhere}{insideWhereIfTrue} -\usesdollar{compWhere}{EmptyMode} -<>= -(defun |compWhere| (arg0 m eInit) - (let (|$insideExpressionIfTrue| |$insideWhereIfTrue| form exprList e - eBefore tmp1 x eAfter del eFinal) - (declare (special |$insideExpressionIfTrue| |$insideWhereIfTrue| - |$EmptyMode|)) - (setq form (second arg0)) - (setq exprlist (cddr arg0)) - (setq |$insideExpressionIfTrue| nil) - (setq |$insideWhereIfTrue| t) - (setq e eInit) - (when (dolist (item exprList t) - (setq tmp1 (|comp| item |$EmptyMode| e)) - (unless tmp1 (return nil)) - (setq e (third tmp1))) - (setq |$insideWhereIfTrue| nil) - (setq tmp1 (|comp| (|macroExpand| form (setq eBefore e)) m e)) - (when tmp1 - (setq x (first tmp1)) - (setq m (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))))) - -@ - -\defun{compSeq}{compSeq} -\calls{compSeq}{compSeq1} -\usesdollar{compSeq}{exitModeStack} -<>= -(defun |compSeq| (arg0 m e) - (declare (special |$exitModeStack|)) - (|compSeq1| (cdr arg0) (cons m |$exitModeStack|) e)) - -@ - -\defun{compSeq1}{compSeq1} -\calls{compSeq1}{nreverse0} -\calls{compSeq1}{compSeqItem} -\calls{compSeq1}{mkq} -\calls{compSeq1}{replaceExitEtc} -\usesdollar{compSeq1}{exitModeStack} -\usesdollar{compSeq1}{insideExpressionIfTrue} -\usesdollar{compSeq1}{finalEnv} -\usesdollar{compSeq1}{NoValueMode} -<>= -(defun |compSeq1| (l |$exitModeStack| e) - (declare (special |$exitModeStack|)) - (let (|$insideExpressionIfTrue| |$finalEnv| tmp1 tmp2 c catchTag form) - (declare (special |$insideExpressionIfTrue| |$finalEnv| |$NoValueMode|)) - (setq |$insideExpressionIfTrue| nil) - (setq |$finalEnv| nil) - (when - (setq c (dolist (x l (nreverse0 tmp2)) - (setq |$insideExpressionIfTrue| nil) - (setq tmp1 (|compSeqItem| x |$NoValueMode| e)) - (unless tmp1 (return nil)) - (setq e (third tmp1)) - (push (first tmp1) tmp2))) - (setq catchTag (mkq (gensym))) - (setq form - (cons 'seq - (|replaceExitEtc| c catchTag '|TAGGEDexit| (elt |$exitModeStack| 0)))) - (list (list 'catch catchTag form) (elt |$exitModeStack| 0) |$finalEnv|)))) - -@ - -\defun{compSeqItem}{compSeqItem} -\calls{compSeqItem}{comp} -\calls{compSeqItem}{macroExpand} -<>= -(defun |compSeqItem| (x m e) - (|comp| (|macroExpand| x e) m e)) - -@ \defun{argsToSig}{argsToSig} <>= @@ -9769,32 +9905,6 @@ preferred to the underlying representation -- RDJ 9/12/83 @ -\defun{compExit}{compExit} -\calls{compExit}{comp} -\calls{compExit}{modifyModeStack} -\calls{compExit}{stackMessageIfNone} -\usesdollar{compExit}{exitModeStack} -<>= -(defun |compExit| (arg0 m e) - (let (x index m1 u) - (declare (special |$exitModeStack|)) - (setq index (1- (second arg0))) - (setq x (third arg0)) - (cond - ((null |$exitModeStack|) - (|comp| x m e)) - (t - (setq m1 (elt |$exitModeStack| index)) - (setq u (|comp| x m1 e)) - (cond - (u - (|modifyModeStack| (second u) index) - (list (list '|TAGGEDexit| index u) m e)) - (t - (|stackMessageIfNone| - (list '|cannot compile exit expression| x '|in mode| m1)))))))) - -@ \defun{modifyModeStack}{modifyModeStack} \calls{modifyModeStack}{say} \calls{modifyModeStack}{copy} diff --git a/changelog b/changelog index 848bdd9..096a064 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,13 @@ +20101121 tpd src/axiom-website/patches.html 20101121.01.tpd.patch +20101121 tpd src/interp/postprop.lisp fix |special| bug +20101121 tpd src/interp/vmlisp.lisp fix |special| bug +20101121 tpd src/interp/modemap.lisp fix |special| bug +20101121 tpd src/interp/define.lisp fix |special| bug +20101121 tpd src/interp/info.lisp fix |special| bug +20101121 tpd src/interp/category.lisp fix |special| bug +20101121 tpd src/interp/br-con.lisp fix |special| bug +20101121 tpd src/interp/apply.lisp fix |special| bug +20101121 tpd books/bookvol9 fix |special| bug 20101120 tpd src/axiom-website/patches.html 20101120.01.tpd.patch 20101120 tpd books/bookvolbib Chee Keng Yap [Yap00] 20101119 tpd src/axiom-website/patches.html 20101119.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index b1975f3..2a3f027 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3266,5 +3266,7 @@ books/bookvol9 treeshake compiler
books/bookvol9 treeshake compiler
20101120.01.tpd.patch books/bookvolbib Chee Keng Yap [Yap00]
+20101121.01.tpd.patch +books/bookvol9 fix |special| bug
diff --git a/src/interp/apply.lisp.pamphlet b/src/interp/apply.lisp.pamphlet index 1969e16..a1a5ece 100644 --- a/src/interp/apply.lisp.pamphlet +++ b/src/interp/apply.lisp.pamphlet @@ -881,7 +881,7 @@ (t nil))) ((|member| (cons 'attribute (cons dc (cons cexpr nil))) - (|get| '|$Information| '|special| |$e|)) + (|get| '|$Information| 'special |$e|)) t) (t (|stackMessage| `("not known that" %b ,dc %d "has" %b ,cexpr %d)) diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index be44527..f2b550c 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -9076,7 +9076,7 @@ ; [:head,'"(",:first sargl,:"append"/[[",",:y] for y in rest sargl],'")"] (DEFUN |conform2StringList| (|form| |opFn| |argFn| |exception|) - (PROG (|op1| |args| |op| |special| |cosig| |atypes| |y| |ISTMP#2| |t| + (PROG (|op1| |args| |op| special |cosig| |atypes| |y| |ISTMP#2| |t| |keyword| |typ| |ISTMP#1| |a| |u| |res| |sargl| |head|) (declare (special |$lowerCaseConTb|)) @@ -9091,11 +9091,11 @@ (COND ((NULL |args|) (APPLY |opFn| (CONS |op| NIL))) ('T - (SPADLET |special| + (SPADLET special (member |op| '(|Union| |Record| |Mapping|))) (SPADLET |cosig| (COND - (|special| + (special (PROG (G170930) (SPADLET G170930 NIL) (RETURN @@ -9114,7 +9114,7 @@ ('T (CDR (GETDATABASE |op| 'COSIG))))) (SPADLET |atypes| (COND - (|special| |cosig|) + (special |cosig|) ('T (CDR (CDAR (GETDATABASE |op| 'CONSTRUCTORMODEMAP)))))) @@ -9230,7 +9230,7 @@ ('T (SPADLET |head| (COND - (|special| (CONS |op| NIL)) + (special (CONS |op| NIL)) ('T (APPLY |opFn| (CONS |form| NIL))))) (APPEND |head| (CONS "(" @@ -26730,7 +26730,7 @@ $dbKindAlist := (SPADLET |$insideCapsuleFunctionIfTrue| 'T) (SPADLET |$CapsuleModemapFrame| |e|) (SPADLET |$CapsuleDomainsInScope| - (|get| '|$DomainsInScope| '|special| |e|)) + (|get| '|$DomainsInScope| 'special |e|)) (SPADLET |$insideExpressionIfTrue| 'T) (SPADLET |$returnMode| |m|) (SPADLET |$op| (CAR |form|)) diff --git a/src/interp/category.lisp.pamphlet b/src/interp/category.lisp.pamphlet index ac0865a..ca7d5b8 100644 --- a/src/interp/category.lisp.pamphlet +++ b/src/interp/category.lisp.pamphlet @@ -1780,7 +1780,7 @@ copy. (COND ((|member| |pred| (|get| '|$Information| - '|special| |$e|)) + 'special |$e|)) (SPADLET |l| (APPEND |l| (CONS @@ -1825,7 +1825,7 @@ copy. |u| (|get| '|$Information| - '|special| + 'special |$e|))) (NULL (BOOT-EQUAL diff --git a/src/interp/define.lisp.pamphlet b/src/interp/define.lisp.pamphlet index 3cbf380..f200595 100644 --- a/src/interp/define.lisp.pamphlet +++ b/src/interp/define.lisp.pamphlet @@ -3331,7 +3331,7 @@ (SPADLET |$insideCapsuleFunctionIfTrue| 'T) (SPADLET |$CapsuleModemapFrame| |e|) (SPADLET |$CapsuleDomainsInScope| - (|get| '|$DomainsInScope| '|special| |e|)) + (|get| '|$DomainsInScope| 'special |e|)) (SPADLET |$insideExpressionIfTrue| 'T) (SPADLET |$returnMode| |m|) (SPADLET |$op| (CAR |form|)) diff --git a/src/interp/info.lisp.pamphlet b/src/interp/info.lisp.pamphlet index b3567ce..57e5115 100644 --- a/src/interp/info.lisp.pamphlet +++ b/src/interp/info.lisp.pamphlet @@ -45,7 +45,7 @@ modemap is of the form : ((op (targ arg1 arg2 ... argn)) pred (elt $ n)) (DEFUN |printInfo| (|$e|) (DECLARE (SPECIAL |$e|)) (SEQ (PROGN - (DO ((G166061 (|get| '|$Information| '|special| |$e|) + (DO ((G166061 (|get| '|$Information| 'special |$e|) (CDR G166061)) (|u| NIL)) ((OR (ATOM G166061) @@ -105,9 +105,9 @@ modemap is of the form : ((op (targ arg1 arg2 ... argn)) pred (elt $ n)) (SPADLET |$Information| NIL) (|addInformation,info| |m|) (SPADLET |$e| - (|put| '|$Information| '|special| + (|put| '|$Information| 'special (APPEND |$Information| - (|get| '|$Information| '|special| |$e|)) + (|get| '|$Information| 'special |$e|)) |$e|)) |$e|)))) @@ -364,7 +364,7 @@ modemap is of the form : ((op (targ arg1 arg2 ... argn)) pred (elt $ n)) (SPADLET |$e| (|actOnInfo| |pred| |$e|)) (SPADLET |pred| (|infoToHas| |pred|)) (EXIT (DO ((G166301 - (|get| '|$Information| '|special| |$e|) + (|get| '|$Information| 'special |$e|) (CDR G166301)) (|u| NIL)) ((OR (ATOM G166301) @@ -448,16 +448,16 @@ modemap is of the form : ((op (targ arg1 arg2 ... argn)) pred (elt $ n)) (IF (|member| |v'| (|get| '|$Information| - '|special| |$e|)) + 'special |$e|)) (EXIT NIL)) (EXIT (SPADLET |$e| (|put| '|$Information| - '|special| + 'special (CONS |v'| (|get| '|$Information| - '|special| |$e|)) + 'special |$e|)) |$e|)))))) (EXIT NIL))))))))))))) @@ -582,7 +582,7 @@ modemap is of the form : ((op (targ arg1 arg2 ... argn)) pred (elt $ n)) (RETURN (SEQ (COND ((BOOT-EQUAL |pred| 'T) 'T) - ((|member| |pred| (|get| '|$Information| '|special| |$e|)) + ((|member| |pred| (|get| '|$Information| 'special |$e|)) 'T) ((AND (PAIRP |pred|) (EQ (QCAR |pred|) 'OR) (PROGN (SPADLET |l| (QCDR |pred|)) 'T)) @@ -855,11 +855,11 @@ modemap is of the form : ((op (targ arg1 arg2 ... argn)) pred (elt $ n)) |$e|) ('T (SPADLET |$e| - (|put| '|$Information| '|special| + (|put| '|$Information| 'special (SPADLET |Info| (CONS |u| (|get| '|$Information| - '|special| |$e|))) + 'special |$e|))) |$e|)) (COND ((AND (PAIRP |u|) (EQ (QCAR |u|) 'COND) diff --git a/src/interp/modemap.lisp.pamphlet b/src/interp/modemap.lisp.pamphlet index 0153f1f..a58ef71 100644 --- a/src/interp/modemap.lisp.pamphlet +++ b/src/interp/modemap.lisp.pamphlet @@ -1135,7 +1135,7 @@ (COND ((BOOT-EQUAL |$insideCapsuleFunctionIfTrue| 'T) |$CapsuleDomainsInScope|) - ('T (|get| '|$DomainsInScope| '|special| |e|)))) + ('T (|get| '|$DomainsInScope| 'special |e|)))) ;putDomainsInScope(x,e) == ; l:= getDomainsInScope e @@ -1159,7 +1159,7 @@ (COND (|$insideCapsuleFunctionIfTrue| (SPADLET |$CapsuleDomainsInScope| |newValue|) |e|) - ('T (|put| '|$DomainsInScope| '|special| |newValue| |e|))))))) + ('T (|put| '|$DomainsInScope| 'special |newValue| |e|))))))) @ \eject diff --git a/src/interp/postprop.lisp.pamphlet b/src/interp/postprop.lisp.pamphlet index f529d46..555dd55 100644 --- a/src/interp/postprop.lisp.pamphlet +++ b/src/interp/postprop.lisp.pamphlet @@ -48,104 +48,54 @@ (in-package "BOOT") -(mapcar #'(lambda (x) (MAKEPROP (CAR X) '|special| (CADR X))) - '((LET |compSetq|) (|Join| |compJoin|) - (|Record| |compCat|) - (|Union| |compCat|) (\: |compColon|) - (\:\: |compCoerce|) (CAPSULE |compCapsule|) - (|has| |compHas|) (|is| |compIs|) - (|add| |compAdd|) (CONS |compCons|) - (IF |compIf|) (|exit| |compExit|) - (|return| |compReturn|) (|leave| |compLeave|) - (|elt| |compElt|) (DEF |compDefine|) - (MDEF |compMacro|) (|SubsetCategory| |compSubsetCategory|) - (|SubDomain| |compSubDomain|) - (|case| |compCase|) (|String| |compString|) +(mapcar #'(lambda (x) (MAKEPROP (CAR X) 'special (CADR X))) + '( + (|add| |compAdd|) +; (\@ |compAtSign|) + (CAPSULE |compCapsule|) + (|case| |compCase|) + (|Record| |compCat|) + (|Mapping| |compCat|) + (|Union| |compCat|) + (CATEGORY |compCategory|) + (\:\: |compCoerce|) + (COLLECTV |compCollectV|) +; (\: |compColon|) + (CONS |compCons|) + (|ListCategory| |compConstructorCategory|) (|RecordCategory| |compConstructorCategory|) - (|ListCategory| |compConstructorCategory|) + (|UnionCategory| |compConstructorCategory|) (|VectorCategory| |compConstructorCategory|) - (|UnionCategory| |compConstructorCategory|) - (CATEGORY |compCategory|) - (COLLECT |compRepeatOrCollect|) - (COLLECTV |compCollectV|) - (REPEAT |compRepeatOrCollect|) - (REDUCE |compReduce|) (|where| |compWhere|) - (\| |compSuchthat|) (|construct| |compConstruct|) - (SEQ |compSeq|) (SETQ |compSetq|) - (VECTOR |compVector|))) + (|construct| |compConstruct|) + (DEF |compDefine|) + (|elt| |compElt|) +; (|exit| |compExit|) + (|has| |compHas|) + (IF |compIf|) + (|import| |compImport|) + (|is| |compIs|) + (|Join| |compJoin|) +; (|+->| |compLambda|) + (|leave| |compLeave|) + (MDEF |compMacro|) + (|pretend| |compPretend|) + (QUOTE |compQuote|) + (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|) +)) -(mapcar #'(lambda (x) (MAKEPROP (CAR X) '|postTran| (second X))) - '((|with| |postWith|) - (|Scripts| |postScripts|) - (/ |postSlash|) - (|construct| |postConstruct|) - (|Block| |postBlock|) - (QUOTE |postQUOTE|) - (COLLECT |postCollect|) - (\:BF\: |postBigFloat|) - (|in| |postin|) ; the infix operator version of i - (IN |postIn|) ; the iterator form of i - (REPEAT |postRepeat|) - (|TupleCollect| |postTupleCollect|) - (|add| |postAdd|) - (|Reduce| |postReduce|) - (\, |postComma|) - (\; |postSemiColon|) - (|where| |postWhere|) - (\: |postColon|) - (\@ |postAtSign|) - (|pretend| |postPretend|) - (|if| |postIf|) - (|Join| |postJoin|) - (|Signature| |postSignature|) - (CATEGORY |postCategory|) - (== |postDef|) - (==> |postMDef|) - (-> |postMapping|) - (=> |postExit|) - (|@Tuple| |postTuple|))) -;(mapcar #'(lambda (x) (MAKEPROP (CAR X) '|parseTran| (CADR X))) -; '( -; (\<= |parseLessEqual|) -; (\> |parseGreaterThan|) -; (\>= |parseGreaterEqual|) -; ($\<= |parseDollarLessEqual|) -; ($\> |parseDollarGreaterThan|) -; ($\>= |parseDollarGreaterEqual|) -; ($^= |parseDollarNotEqual|) -; (^ |parseNot|) -; (^= |parseNotEqual|) -; (\: |parseColon|) -; (\:\: |parseCoerce|) -; (\@ |parseAtSign|) -; (|and| |parseAnd|) -; (CATEGORY |parseCategory|) -; (|construct| |parseConstruct|) -; (DEF |parseDEF|) -; (|eqv| |parseEquivalence|) -; (|exit| |parseExit|) -; (|has| |parseHas|) -; (IF |parseIf|) -; (|implies| |parseImplies|) -; (IN |parseIn|) -; (INBY |parseInBy|) -; (|is| |parseIs|) -; (|isnt| |parseIsnt|) -;; (|Join| |parseJoin|) -; (|leave| |parseLeave|) -; (LET |parseLET|) -; (LETD |parseLETD|) -; (MDEF |parseMDEF|) -; (|not| |parseNot|) -; (|or| |parseOr|) -; (|pretend| |parsePretend|) -; (|return| |parseReturn|) -; (SEQ |parseSeq|) -; (VCONS |parseVCONS|) -; (|where| |parseWhere|) -;; (|xor| |parseExclusiveOr|) -;)) @ \eject \begin{thebibliography}{99} diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 0122098..8a35c10 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -5712,7 +5712,7 @@ now the function is defined but does nothing. (DEFUN /TRANSPAD (X) (PROG (proplist) (setq proplist (LIST '(FLUID . |true|) - (CONS '|special| + (CONS 'special (COPY-TREE |$InitialDomainsInScope|)))) (SETQ |$tripleCache| NIL) (SETQ |$InteractiveFrame| @@ -5747,7 +5747,7 @@ now the function is defined but does nothing. (defun READ-SPAD (FN FM TO) (LET ((proplist (LIST '(FLUID . |true|) - (CONS '|special| (COPY-TREE |$InitialDomainsInScope|))))) + (CONS 'special (COPY-TREE |$InitialDomainsInScope|))))) (SETQ |$InteractiveFrame| (|addBinding| '|$DomainsInScope| proplist (|addBinding| '|$Information| NIL @@ -6904,54 +6904,6 @@ o there is some code at the end of SPECEVAL BOOT that puts "up" )) (MAKEPROP (CAR X) '|SEL,FUNCTION| (CADR X))) (REPEAT (IN X '( - (\| |compSuchthat|) - (\@ |compAtSign|) - (|:| |compColon|) - (\:\: |compCoerce|) - (|+->| |compLambda|) - (QUOTE |compQuote|) -;; We have a similar problem with the control-G character. -;; (control-G |compContained|) - (|add| |compAdd|) - (CAPSULE |compCapsule|) - (|case| |compCase|) - (CATEGORY |compCategory|) - (COLLECT |compRepeatOrCollect|) - (COLLECTV |compCollectV|) - (CONS |compCons|) - (|construct| |compConstruct|) - (DEF |compDefine|) - (|elt| |compElt|) - (|exit| |compExit|) - (|has| |compHas|) - (IF |compIf|) - (|import| |compImport|) - (|is| |compIs|) - (|Join| |compJoin|) - (|leave| |compLeave|) - (LET |compSetq|) - (|ListCategory| |compConstructorCategory|) - (MDEF |compMacro|) - (|pretend| |compPretend|) - (|Record| |compCat|) - (|RecordCategory| |compConstructorCategory|) - (REDUCE |compReduce|) - (REPEAT |compRepeatOrCollect|) - (|return| |compReturn|) - (SEQ |compSeq|) - (SETQ |compSetq|) - (|String| |compString|) - (|SubDomain| |compSubDomain|) - (|SubsetCategory| |compSubsetCategory|) - (|Union| |compCat|) - (|Mapping| |compCat|) - (|UnionCategory| |compConstructorCategory|) - (VECTOR |compVector|) - (|VectorCategory| |compConstructorCategory|) - (|where| |compWhere|) -)) (MAKEPROP (CAR X) 'SPECIAL (CADR X))) - -(REPEAT (IN X '( (\: |compColonInteractive|) (DEF |compDefineInteractive|) (|construct| |compConstructInteractive|)