diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index 50beb64..cf1c2bf 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -29944,6 +29944,8 @@ o )cd )clear : remove declarations, definitions or values )close : throw away an interpreter client and workspace )compile : invoke constructor compiler + )copyright : show copyright and trademark information + )describe : show database information for a category, domain, or package )display : display Library operations and objects in your workspace )edit : edit a file )frame : manage interpreter workspaces diff --git a/books/bookvol9.pamphlet b/books/bookvol9.pamphlet index 449ee85..f027e8c 100644 --- a/books/bookvol9.pamphlet +++ b/books/bookvol9.pamphlet @@ -4443,16 +4443,16 @@ A reduction of a rule is any S-Expression the rule chooses to stack. (g (op) (let (tmp1 tmp2 x) (seq - (if (and (consp op) (eq (qcar op) '|elt|) + (if (and (consp op) (eq (qfirst op) '|elt|) (progn - (setq tmp1 (qcdr op)) + (setq tmp1 (qrest op)) (and (consp tmp1) (progn - (setq op (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) + (setq op (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) - (eq (qcdr tmp2) nil) - (progn (setq x (qcar tmp2)) t)))))) + (eq (qrest tmp2) nil) + (progn (setq x (qfirst tmp2)) t)))))) (exit (g x))) (exit op))))) (let (|$op| argl u r fn) @@ -4467,7 +4467,7 @@ A reduction of a rule is any S-Expression the rule chooses to stack. (cond ((eq u '|construct|) (setq r (|parseConstruct| argl)) - (if (and (consp |$op|) (eq (qcar |$op|) '|elt|)) + (if (and (consp |$op|) (eq (qfirst |$op|) '|elt|)) (cons (|parseTran| |$op|) (cdr r)) r)) ((and (atom u) (setq fn (getl u '|parseTran|))) @@ -4625,9 +4625,9 @@ of the symbol being parsed. The original list read: (defun |parseType| (x) (declare (special |$EmptyMode| |$quadSymbol|)) (setq x (msubst |$EmptyMode| |$quadSymbol| x)) - (if (and (consp x) (eq (qcar x) '|typeOf|) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil)) - (list '|typeOf| (|parseTran| (qcar (qcdr x)))) + (if (and (consp x) (eq (qfirst x) '|typeOf|) + (consp (qrest x)) (eq (qcddr x) nil)) + (list '|typeOf| (|parseTran| (qsecond x))) x)) \end{chunk} @@ -4658,11 +4658,11 @@ of the symbol being parsed. The original list read: (defun |parseDropAssertions| (x) (cond ((not (consp x)) x) - ((and (consp (qcar x)) (eq (qcar (qcar x)) 'if) - (consp (qcdr (qcar x))) - (eq (qcar (qcdr (qcar x))) '|asserted|)) - (|parseDropAssertions| (qcdr x))) - (t (cons (qcar x) (|parseDropAssertions| (qcdr x)))))) + ((and (consp (qfirst x)) (eq (qcaar x) 'if) + (consp (qcdar x)) + (eq (qcadar x) '|asserted|)) + (|parseDropAssertions| (qrest x))) + (t (cons (qfirst x) (|parseDropAssertions| (qrest x)))))) \end{chunk} @@ -4702,9 +4702,9 @@ of the symbol being parsed. The original list read: (defun |parseColon| (arg) (declare (special |$insideConstructIfTrue|)) (cond - ((and (consp arg) (eq (qcdr arg) nil)) + ((and (consp arg) (eq (qrest arg) nil)) (list '|:| (|parseTran| (first arg)))) - ((and (consp arg) (consp (qcdr arg)) (eq (qcdr (qcdr arg)) nil)) + ((and (consp arg) (consp (qrest arg)) (eq (qcddr arg) nil)) (if |$InteractiveMode| (if |$insideConstructIfTrue| (list 'tag (|parseTran| (first arg)) @@ -4783,29 +4783,29 @@ of the symbol being parsed. The original list read: (defun |transIs1| (u) (let (x h v tmp3) (cond - ((and (consp u) (eq (qcar u) '|construct|)) - (dolist (x (qcdr u) (nreverse0 tmp3)) + ((and (consp u) (eq (qfirst u) '|construct|)) + (dolist (x (qrest u) (nreverse0 tmp3)) (push (|transIs| x) tmp3))) - ((and (consp u) (eq (qcar u) '|append|) (consp (qcdr u)) - (consp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) - (setq x (qcar (qcdr u))) + ((and (consp u) (eq (qfirst u) '|append|) (consp (qrest u)) + (consp (qcddr u)) (eq (qcdddr u) nil)) + (setq x (qsecond u)) (setq h (list '|:| (|transIs| x))) - (setq v (|transIs1| (qcar (qcdr (qcdr u))))) + (setq v (|transIs1| (qthird u))) (cond - ((and (consp v) (eq (qcar v) '|:|) - (consp (qcdr v)) (eq (qcdr (qcdr v)) nil)) - (list h (qcar (qcdr v)))) + ((and (consp v) (eq (qfirst v) '|:|) + (consp (qrest v)) (eq (qcddr v) nil)) + (list h (qsecond v))) ((eq v '|nil|) (car (cdr h))) ((atom v) (list h (list '|:| v))) (t (cons h v)))) - ((and (consp u) (eq (qcar u) '|cons|) (consp (qcdr u)) - (consp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) - (setq h (|transIs| (qcar (qcdr u)))) - (setq v (|transIs1| (qcar (qcdr (qcdr u))))) + ((and (consp u) (eq (qfirst u) '|cons|) (consp (qrest u)) + (consp (qcddr u)) (eq (qcdddr u) nil)) + (setq h (|transIs| (qsecond u))) + (setq v (|transIs1| (qthird u))) (cond - ((and (consp v) (eq (qcar v) '|:|) (consp (qcdr v)) - (eq (qcdr (qcdr v)) nil)) - (cons h (list (qcar (qcdr v))))) + ((and (consp v) (eq (qfirst v) '|:|) (consp (qrest v)) + (eq (qcddr v) nil)) + (cons h (list (qsecond v)))) ((eq v '|nil|) (cons h nil)) ((atom v) (list h (list '|:| v))) (t (cons h v)))) @@ -4817,7 +4817,7 @@ of the symbol being parsed. The original list read: \calls{isListConstructor}{member} \begin{chunk}{defun isListConstructor} (defun |isListConstructor| (u) - (and (consp u) (|member| (qcar u) '(|construct| |append| |cons|)))) + (and (consp u) (|member| (qfirst u) '(|construct| |append| |cons|)))) \end{chunk} @@ -5002,18 +5002,18 @@ of the symbol being parsed. The original list read: (declare (special |$InteractiveMode|)) (when |$InteractiveMode| (setq arg (|unabbrevAndLoad| arg))) (cond - ((and (consp arg) (eq (qcar arg) '|:|) (consp (qcdr arg)) - (consp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil) - (consp (qcar (qcdr (qcdr arg)))) - (eq (qcar (qcar (qcdr (qcdr arg)))) '|Mapping|)) + ((and (consp arg) (eq (qfirst arg) '|:|) (consp (qrest arg)) + (consp (qcddr arg)) (eq (qcdddr arg) nil) + (consp (qthird arg)) + (eq (qcaaddr arg) '|Mapping|)) (setq map (rest (third arg))) (setq op (second arg)) (setq op (if (stringp op) (intern op) op)) (list (list 'signature op map))) - ((and (consp arg) (eq (qcar arg) '|Join|)) + ((and (consp arg) (eq (qfirst arg) '|Join|)) (dolist (z (rest arg) tmp4) (setq tmp4 (append tmp4 (fn z))))) - ((and (consp arg) (eq (qcar arg) 'category)) + ((and (consp arg) (eq (qfirst arg) 'category)) (dolist (z (rest arg) tmp6) (setq tmp6 (append tmp6 (fn z))))) (t @@ -5021,9 +5021,9 @@ of the symbol being parsed. The original list read: (cond ((or (eq kk '|domain|) (eq kk '|category|)) (list (|makeNonAtomic| arg))) - ((and (consp arg) (eq (qcar arg) 'attribute)) + ((and (consp arg) (eq (qfirst arg) 'attribute)) (list arg)) - ((and (consp arg) (eq (qcar arg) 'signature)) + ((and (consp arg) (eq (qfirst arg) 'signature)) (list arg)) (|$InteractiveMode| (|parseHasRhs| arg)) @@ -5035,8 +5035,8 @@ of the symbol being parsed. The original list read: (setq tmp1 (|get| x '|value| |$CategoryFrame|)) (when |$InteractiveMode| (setq x - (if (and (consp tmp1) (consp (qcdr tmp1)) (consp (qcdr (qcdr tmp1))) - (eq (qcdr (qcdr (qcdr tmp1))) nil) + (if (and (consp tmp1) (consp (qrest tmp1)) (consp (qcddr tmp1)) + (eq (qcdddr tmp1) nil) (|member| (second tmp1) '((|Mode|) (|Domain|) (|SubDomain| (|Domain|))))) (first tmp1) @@ -5044,8 +5044,8 @@ of the symbol being parsed. The original list read: (setq tmp2 (dolist (u (fn (second arg)) (nreverse0 tmp3)) (push (list '|has| x u ) tmp3))) - (if (and (consp tmp2) (eq (qcdr tmp2) nil)) - (qcar tmp2) + (if (and (consp tmp2) (eq (qrest tmp2) nil)) + (qfirst tmp2) (cons '|and| tmp2))))) \end{chunk} @@ -5065,8 +5065,8 @@ of the symbol being parsed. The original list read: (declare (special |$CategoryFrame|)) (setq tmp1 (|get| u '|value| |$CategoryFrame|)) (cond - ((and (consp tmp1) (consp (qcdr tmp1)) - (consp (qcdr (qcdr tmp1))) (eq (qcdr (qcdr (qcdr tmp1))) nil) + ((and (consp tmp1) (consp (qrest tmp1)) + (consp (qcddr tmp1)) (eq (qcdddr tmp1) nil) (|member| (second tmp1) '((|Mode|) (|Domain|) (|SubDomain| (|Domain|))))) (second tmp1)) @@ -5208,8 +5208,8 @@ of the symbol being parsed. The original list read: \calls{parseIf}{parseTran} \begin{chunk}{defun parseIf} (defun |parseIf| (arg) - (if (null (and (consp arg) (consp (qcdr arg)) - (consp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil))) + (if (null (and (consp arg) (consp (qrest arg)) + (consp (qcddr arg)) (eq (qcdddr arg) nil))) arg (|parseIf,ifTran| (|parseTran| (first arg)) @@ -5234,41 +5234,41 @@ of the symbol being parsed. The original list read: a) ((and (null |$InteractiveMode|) (eq pred '|false|)) b) - ((and (consp pred) (eq (qcar pred) '|not|) - (consp (qcdr pred)) (eq (qcdr (qcdr pred)) nil)) + ((and (consp pred) (eq (qfirst pred) '|not|) + (consp (qrest pred)) (eq (qcddr pred) nil)) (|parseIf,ifTran| (second pred) b a)) - ((and (consp pred) (eq (qcar pred) 'if) + ((and (consp pred) (eq (qfirst pred) 'if) (progn - (setq tmp1 (qcdr pred)) + (setq tmp1 (qrest pred)) (and (consp tmp1) (progn - (setq pp (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) + (setq pp (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) (progn - (setq ap (qcar tmp2)) - (setq tmp3 (qcdr tmp2)) + (setq ap (qfirst tmp2)) + (setq tmp3 (qrest tmp2)) (and (consp tmp3) - (eq (qcdr tmp3) nil) - (progn (setq bp (qcar tmp3)) t)))))))) + (eq (qrest tmp3) nil) + (progn (setq bp (qfirst tmp3)) t)))))))) (|parseIf,ifTran| pp (|parseIf,ifTran| ap (copy a) (copy b)) (|parseIf,ifTran| bp a b))) - ((and (consp pred) (eq (qcar pred) 'seq) - (consp (qcdr pred)) (progn (setq tmp2 (reverse (qcdr pred))) t) + ((and (consp pred) (eq (qfirst pred) 'seq) + (consp (qrest pred)) (progn (setq tmp2 (reverse (qrest pred))) t) (and (consp tmp2) - (consp (qcar tmp2)) - (eq (qcar (qcar tmp2)) '|exit|) + (consp (qfirst tmp2)) + (eq (qcaar tmp2) '|exit|) (progn - (setq tmp4 (qcdr (qcar tmp2))) + (setq tmp4 (qcdar tmp2)) (and (consp tmp4) - (equal (qcar tmp4) 1) + (equal (qfirst tmp4) 1) (progn - (setq tmp5 (qcdr tmp4)) + (setq tmp5 (qrest tmp4)) (and (consp tmp5) - (eq (qcdr tmp5) nil) - (progn (setq pp (qcar tmp5)) t))))) - (progn (setq z (qcdr tmp2)) t)) + (eq (qrest tmp5) nil) + (progn (setq pp (qfirst tmp5)) t))))) + (progn (setq z (qrest tmp2)) t)) (progn (setq z (nreverse z)) t)) (cons 'seq (append z @@ -5276,36 +5276,36 @@ of the symbol being parsed. The original list read: (list '|exit| 1 (|parseIf,ifTran| pp (|incExitLevel| a) (|incExitLevel| b))))))) - ((and (consp a) (eq (qcar a) 'if) (consp (qcdr a)) - (equal (qcar (qcdr a)) pred) (consp (qcdr (qcdr a))) - (consp (qcdr (qcdr (qcdr a)))) - (eq (qcdr (qcdr (qcdr (qcdr a)))) nil)) + ((and (consp a) (eq (qfirst a) 'if) (consp (qrest a)) + (equal (qsecond a) pred) (consp (qcddr a)) + (consp (qcdddr a)) + (eq (qcddddr a) nil)) (list 'if pred (third a) b)) - ((and (consp b) (eq (qcar b) 'if) - (consp (qcdr b)) (equal (qcar (qcdr b)) pred) - (consp (qcdr (qcdr b))) - (consp (qcdr (qcdr (qcdr b)))) - (eq (qcdr (qcdr (qcdr (qcdr b)))) nil)) + ((and (consp b) (eq (qfirst b) 'if) + (consp (qrest b)) (equal (qsecond b) pred) + (consp (qcddr b)) + (consp (qcdddr b)) + (eq (qcddddr b) nil)) (list 'if pred a (fourth b))) ((progn (setq tmp1 (|makeSimplePredicateOrNil| pred)) - (and (consp tmp1) (eq (qcar tmp1) 'seq) + (and (consp tmp1) (eq (qfirst tmp1) 'seq) (progn - (setq tmp2 (qcdr tmp1)) + (setq tmp2 (qrest tmp1)) (and (and (consp tmp2) (progn (setq tmp3 (reverse tmp2)) t)) (and (consp tmp3) (progn - (setq tmp4 (qcar tmp3)) - (and (consp tmp4) (eq (qcar tmp4) '|exit|) + (setq tmp4 (qfirst tmp3)) + (and (consp tmp4) (eq (qfirst tmp4) '|exit|) (progn - (setq tmp5 (qcdr tmp4)) - (and (consp tmp5) (equal (qcar tmp5) 1) + (setq tmp5 (qrest tmp4)) + (and (consp tmp5) (equal (qfirst tmp5) 1) (progn - (setq tmp6 (qcdr tmp5)) - (and (consp tmp6) (eq (qcdr tmp6) nil) - (progn (setq val (qcar tmp6)) t))))))) - (progn (setq s (qcdr tmp3)) t)))))) + (setq tmp6 (qrest tmp5)) + (and (consp tmp6) (eq (qrest tmp6) nil) + (progn (setq val (qfirst tmp6)) t))))))) + (progn (setq s (qrest tmp3)) t)))))) (setq s (nreverse s)) (|parseTran| (cons 'seq @@ -5347,32 +5347,32 @@ of the symbol being parsed. The original list read: (setq i (|parseTran| (first arg))) (setq n (|parseTran| (second arg))) (cond - ((and (consp n) (eq (qcar n) 'segment) - (consp (qcdr n)) (eq (qcdr (qcdr n)) nil)) + ((and (consp n) (eq (qfirst n) 'segment) + (consp (qrest n)) (eq (qcddr n) nil)) (list 'step i (second n) 1)) - ((and (consp n) (eq (qcar n) '|reverse|) - (consp (qcdr n)) (eq (qcdr (qcdr n)) nil) - (consp (qcar (qcdr n))) (eq (qcar (qcar (qcdr n))) 'segment) - (consp (qcdr (qcar (qcdr n)))) - (eq (qcdr (qcdr (qcar (qcdr n)))) nil)) + ((and (consp n) (eq (qfirst n) '|reverse|) + (consp (qrest n)) (eq (qcddr n) nil) + (consp (qsecond n)) (eq (qcaadr n) 'segment) + (consp (qcdadr n)) + (eq (qcddadr n) nil)) (|postError| (list " You cannot reverse an infinite sequence." ))) - ((and (consp n) (eq (qcar n) 'segment) - (consp (qcdr n)) (consp (qcdr (qcdr n))) - (eq (qcdr (qcdr (qcdr n))) nil)) + ((and (consp n) (eq (qfirst n) 'segment) + (consp (qrest n)) (consp (qcddr n)) + (eq (qcdddr n) nil)) (if (third n) (list 'step i (second n) 1 (third n)) (list 'step i (second n) 1))) - ((and (consp n) (eq (qcar n) '|reverse|) - (consp (qcdr n)) (eq (qcdr (qcdr n)) nil) - (consp (qcar (qcdr n))) (eq (qcar (qcar (qcdr n))) 'segment) - (consp (qcdr (qcar (qcdr n)))) - (consp (qcdr (qcdr (qcar (qcdr n))))) - (eq (qcdr (qcdr (qcdr (qcar (qcdr n))))) nil)) + ((and (consp n) (eq (qfirst n) '|reverse|) + (consp (qrest n)) (eq (qcddr n) nil) + (consp (qsecond n)) (eq (qcaadr n) 'segment) + (consp (qcdadr n)) + (consp (qcddadr n)) + (eq (qrest (qcddadr n)) nil)) (if (third (second n)) (list 'step i (third (second n)) -1 (second (second n))) (|postError| (list " You cannot reverse an infinite sequence.")))) - ((and (consp n) (eq (qcar n) '|tails|) - (consp (qcdr n)) (eq (qcdr (qcdr n)) nil)) + ((and (consp n) (eq (qfirst n) '|tails|) + (consp (qrest n)) (eq (qcddr n) nil)) (list 'on i (second n))) (t (list 'in i n))))) @@ -5399,10 +5399,10 @@ of the symbol being parsed. The original list read: (setq inc (third arg)) (setq u (|parseIn| (list i n))) (cond - ((null (and (consp u) (eq (qcar u) 'step) - (consp (qcdr u)) - (consp (qcdr (qcdr u))) - (consp (qcdr (qcdr (qcdr u)))))) + ((null (and (consp u) (eq (qfirst u) 'step) + (consp (qrest u)) + (consp (qcddr u)) + (consp (qcdddr u)))) (|postError| (cons '| You cannot use| (append (|bright| "by") @@ -5466,7 +5466,7 @@ of the symbol being parsed. The original list read: (cond ((null arg) nil) - ((and (consp arg) (consp (qcar arg)) (eq (qcar (qcar arg)) '|Join|)) + ((and (consp arg) (consp (qfirst arg)) (eq (qcaar arg) '|Join|)) (append (cdar arg) (fn (rest arg)))) (t (cons (first arg) (fn (rest arg)))))) @@ -5649,8 +5649,8 @@ of the symbol being parsed. The original list read: (|$InteractiveMode| (cons '|or| (|parseTranList| arg))) ((null arg) '|false|) ((null (cdr arg)) (car arg)) - ((and (consp x) (eq (qcar x) '|not|) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil)) + ((and (consp x) (eq (qfirst x) '|not|) + (consp (qrest x)) (eq (qcddr x) nil)) (|parseIf| (list (second x) (|parseOr| (cdr arg)) '|true|))) (t (|parseIf| (list x '|true| (|parseOr| (cdr arg)))))))) @@ -5713,7 +5713,7 @@ of the symbol being parsed. The original list read: \calls{parseSegment}{parseTran} \begin{chunk}{defun parseSegment} (defun |parseSegment| (arg) - (if (and (consp arg) (consp (qcdr arg)) (eq (qcdr (qcdr arg)) nil)) + (if (and (consp arg) (consp (qrest arg)) (eq (qcddr arg) nil)) (if (second arg) (list 'segment (|parseTran| (first arg)) (|parseTran| (second arg))) (list 'segment (|parseTran| (first arg)))) @@ -5738,7 +5738,7 @@ of the symbol being parsed. The original list read: (let (tmp1) (when (consp arg) (setq tmp1 (reverse arg))) (if (null (and (consp arg) (consp tmp1) - (consp (qcar tmp1)) (eq (qcar (qcar tmp1)) '|exit|))) + (consp (qfirst tmp1)) (eq (qcaar tmp1) '|exit|))) (|postError| (list " Invalid ending to block: " (|last| arg))) (|transSeq| (|mapInto| arg '|parseTran|))))) @@ -5914,26 +5914,26 @@ $\rightarrow$ (defun |getTargetFromRhs| (lhs rhs env) (declare (special |$EmptyMode|)) (cond - ((and (consp rhs) (eq (qcar rhs) 'capsule)) + ((and (consp rhs) (eq (qfirst rhs) 'capsule)) (|stackSemanticError| (list "target category of " lhs " cannot be determined from definition") nil)) - ((and (consp rhs) (eq (qcar rhs) '|SubDomain|) (consp (qcdr rhs))) + ((and (consp rhs) (eq (qfirst rhs) '|SubDomain|) (consp (qrest rhs))) (|getTargetFromRhs| lhs (second rhs) env)) - ((and (consp rhs) (eq (qcar rhs) '|add|) - (consp (qcdr rhs)) (consp (qcdr (qcdr rhs))) - (eq (qcdr (qcdr (qcdr rhs))) nil) - (consp (qcar (qcdr (qcdr rhs)))) - (eq (qcar (qcar (qcdr (qcdr rhs)))) 'capsule)) + ((and (consp rhs) (eq (qfirst rhs) '|add|) + (consp (qrest rhs)) (consp (qcddr rhs)) + (eq (qcdddr rhs) nil) + (consp (qthird rhs)) + (eq (qcaaddr rhs) 'capsule)) (|getTargetFromRhs| lhs (second rhs) env)) - ((and (consp rhs) (eq (qcar rhs) '|Record|)) + ((and (consp rhs) (eq (qfirst rhs) '|Record|)) (cons '|RecordCategory| (rest rhs))) - ((and (consp rhs) (eq (qcar rhs) '|Union|)) + ((and (consp rhs) (eq (qfirst rhs) '|Union|)) (cons '|UnionCategory| (rest rhs))) - ((and (consp rhs) (eq (qcar rhs) '|List|)) + ((and (consp rhs) (eq (qfirst rhs) '|List|)) (cons '|ListCategory| (rest rhs))) - ((and (consp rhs) (eq (qcar rhs) '|Vector|)) + ((and (consp rhs) (eq (qfirst rhs) '|Vector|)) (cons '|VectorCategory| (rest rhs))) (t (second (|compOrCroak| rhs |$EmptyMode| env))))) @@ -5980,12 +5980,12 @@ $\rightarrow$ (if (setq u (|get| form '|macro| env)) (|macroExpand| u env) form)) - ((and (consp form) (eq (qcar form) 'def) - (consp (qcdr form)) - (consp (qcdr (qcdr form))) - (consp (qcdr (qcdr (qcdr form)))) - (consp (qcdr (qcdr (qcdr (qcdr form))))) - (eq (qcdr (qcdr (qcdr (qcdr (qcdr form))))) nil)) + ((and (consp form) (eq (qfirst form) 'def) + (consp (qrest form)) + (consp (qcddr form)) + (consp (qcdddr form)) + (consp (qcddddr form)) + (eq (qrest (qcddddr form)) nil)) (list 'def (|macroExpand| (second form) env) (|macroExpandList| (third form) env) (|macroExpandList| (fourth form) env) @@ -6000,9 +6000,9 @@ $\rightarrow$ \begin{chunk}{defun macroExpandList} (defun |macroExpandList| (lst env) (let (tmp) - (if (and (consp lst) (eq (qcdr lst) nil) - (identp (qcar lst)) (getdatabase (qcar lst) 'niladic) - (setq tmp (|get| (qcar lst) '|macro| env))) + (if (and (consp lst) (eq (qrest lst) nil) + (identp (qfirst lst)) (getdatabase (qfirst lst) 'niladic) + (setq tmp (|get| (qfirst lst) '|macro| env))) (|macroExpand| tmp env) (loop for x in lst collect (|macroExpand| x env))))) @@ -6036,9 +6036,9 @@ $\rightarrow$ (setq sc (fourth df)) (setq body (fifth df)) (setq categoryCapsule - (when (and (consp body) (eq (qcar body) '|add|) - (consp (qcdr body)) (consp (qcdr (qcdr body))) - (eq (qcdr (qcdr (qcdr body))) nil)) + (when (and (consp body) (eq (qfirst body) '|add|) + (consp (qrest body)) (consp (qcddr body)) + (eq (qcdddr body) nil)) (setq tmp1 (third body)) (setq body (second body)) tmp1)) @@ -6068,11 +6068,11 @@ $\rightarrow$ (fn (u pl) (declare (special |$tvl| |$mvl|)) (cond - ((and (consp u) (eq (qcar u) '|Join|) (consp (qcdr u))) - (fn (car (reverse (qcdr u))) pl)) - ((and (consp u) (eq (qcar u) '|has|)) + ((and (consp u) (eq (qfirst u) '|Join|) (consp (qrest u))) + (fn (car (reverse (qrest u))) pl)) + ((and (consp u) (eq (qfirst u) '|has|)) (|insert| (eqsubstlist |$mvl| |$tvl| u) pl)) - ((and (consp u) (member (qcar u) '(signature attribute))) pl) + ((and (consp u) (member (qfirst u) '(signature attribute))) pl) ((atom u) pl) (t (fnl u pl)))) (fnl (u pl) @@ -6105,14 +6105,14 @@ $\rightarrow$ (fn (x oplist) (cond ((atom x) oplist) - ((and (consp x) (eq (qcar x) 'def) (consp (qcdr x))) + ((and (consp x) (eq (qfirst x) 'def) (consp (qrest x))) (cons (second x) oplist)) (t (fn (cdr x) (fn (car x) oplist))))) (gn (cat) (cond - ((and (consp cat) (eq (qcar cat) 'category)) (cddr cat)) - ((and (consp cat) (eq (qcar cat) '|Join|)) (gn (|last| (qcdr cat)))) + ((and (consp cat) (eq (qfirst cat) 'category)) (cddr cat)) + ((and (consp cat) (eq (qfirst cat) '|Join|)) (gn (|last| (qrest cat)))) (t nil)))) (let (|$options| op argl packageName packageAbb nameForDollar packageArgl capsuleDefAlist explicitCatPart catvec fullCatOpList op1 sig @@ -6173,8 +6173,8 @@ $\rightarrow$ |$CategoryNames|)) (if (consp c) (progn - (setq op (qcar c)) - (setq argl (qcdr c)) + (setq op (qfirst c)) + (setq argl (qrest c)) (cond ((eq op '|Join|) (cons '|Join| @@ -6421,7 +6421,7 @@ $\rightarrow$ (and (null (|member| op |$formalArgList|)) (progn (setq tmp1 (|getmode| op |$e|)) - (and (consp tmp1) (eq (qcar tmp1) '|Mapping|))))))) + (and (consp tmp1) (eq (qfirst tmp1) '|Mapping|))))))) (let (op lamExpr DC sig sel opexport opmodes opp parts s tt unew optimizedBody stuffToCompile result functionStats) (declare (special |$functionStats| |$macroIfTrue| |$doNotCompileJustPrint| @@ -6557,8 +6557,8 @@ Code for encoding function names inside package or domain (mkRepfun (z n) (cond ((null z) nil) - ((and (consp z) (eq (qcdr z) nil) (list (cons n (qcar z))))) - ((and (consp z) (consp (qcdr z)) (equal (qcar (qcdr z)) (qcar z))) + ((and (consp z) (eq (qrest z) nil) (list (cons n (qfirst z))))) + ((and (consp z) (consp (qrest z)) (equal (qsecond z) (qfirst z))) (mkRepfun (cdr z) (1+ n))) (t (cons (cons n (car z)) (mkRepfun (cdr z) 1)))))) (mkRepfun z 1))) @@ -6597,7 +6597,7 @@ Code for encoding function names inside package or domain \begin{chunk}{defun encodeItem} (defun |encodeItem| (x) (cond - ((consp x) (|getCaps| (qcar x))) + ((consp x) (|getCaps| (qfirst x))) ((identp x) (pname x)) (t (stringimage x)))) @@ -6671,13 +6671,13 @@ constructMacro (form is [nam,[lam,vl,body]]) ((and (consp vl) (progn (setq tmp1 (reverse vl)) t) (consp tmp1) (progn - (setq e (qcar tmp1)) - (setq vlp (qcdr tmp1)) + (setq e (qfirst tmp1)) + (setq vlp (qrest tmp1)) t) (progn (setq vlp (nreverse vlp)) t) (consp body) - (progn (setq namp (qcar body)) t) - (equal (qcdr body) vlp)) + (progn (setq namp (qfirst body)) t) + (equal (qrest body) vlp)) (|LAM,EVALANDFILEACTQ| (list 'put (mkq nam) (mkq '|SPADreplace|) (mkq namp))) (|sayBrightly| @@ -6692,8 +6692,8 @@ constructMacro (form is [nam,[lam,vl,body]]) (progn (setq tmp1 (reverse vl)) t) (consp tmp1) (progn - (setq e (qcar tmp1)) - (setq vlp (qcdr tmp1)) + (setq e (qfirst tmp1)) + (setq vlp (qrest tmp1)) t) (progn (setq vlp (nreverse vlp)) t) (null (contained e body))) @@ -6857,32 +6857,32 @@ constructMacro (form is [nam,[lam,vl,body]]) (atomizeOp (op) (cond ((atom op) op) - ((and (consp op) (eq (qcdr op) nil)) (qcar op)) + ((and (consp op) (eq (qrest op) nil)) (qfirst op)) (t (|keyedSystemError| 'S2GE0016 (list "mkAlistOfExplicitCategoryOps" "bad signature"))))) (fn (op u) - (if (and (consp u) (consp (qcar u))) - (if (equal (qcar (qcar u)) op) - (cons (qcdr (qcar u)) (fn op (qcdr u))) - (fn op (qcdr u)))))) + (if (and (consp u) (consp (qfirst u))) + (if (equal (qcaar u) op) + (cons (qcdar u) (fn op (qrest u))) + (fn op (qrest u)))))) (let (z tmp1 op sig u opList) (declare (special |$e|)) - (when (and (consp target) (eq (qcar target) '|add|) (consp (qcdr target))) + (when (and (consp target) (eq (qfirst target) '|add|) (consp (qrest target))) (setq target (second target))) (cond - ((and (consp target) (eq (qcar target) '|Join|)) - (setq z (qcdr target)) + ((and (consp target) (eq (qfirst target) '|Join|)) + (setq z (qrest target)) (PROG (tmp1) (RETURN (DO ((G167566 z (CDR G167566)) (cat nil)) ((OR (ATOM G167566) (PROGN (setq cat (CAR G167566)) nil)) tmp1) (setq tmp1 (|union| tmp1 (|mkAlistOfExplicitCategoryOps| cat))))))) - ((and (consp target) (eq (qcar target) 'category) + ((and (consp target) (eq (qfirst target) 'category) (progn - (setq tmp1 (qcdr target)) + (setq tmp1 (qrest target)) (and (consp tmp1) - (progn (setq z (qcdr tmp1)) t)))) + (progn (setq z (qrest tmp1)) t)))) (setq z (|flattenSignatureList| (cons 'progn z))) (setq u (prog (G167577) @@ -6891,10 +6891,10 @@ constructMacro (form is [nam,[lam,vl,body]]) ((or (atom G167583)) (nreverse0 G167577)) (setq x (car G167583)) (cond - ((and (consp x) (eq (qcar x) 'signature) (consp (qcdr x)) - (consp (qcdr (qcdr x)))) - (setq op (qcar (qcdr x))) - (setq sig (qcar (qcdr (qcdr x)))) + ((and (consp x) (eq (qfirst x) 'signature) (consp (qrest x)) + (consp (qcddr x))) + (setq op (qsecond x)) + (setq sig (qthird x)) (setq G167577 (cons (cons (atomizeOp op) sig) G167577)))))))) (setq opList (remdup (assocleft u))) (prog (G167593) @@ -6919,16 +6919,16 @@ constructMacro (form is [nam,[lam,vl,body]]) (let (zz) (cond ((atom x) nil) - ((and (consp x) (eq (qcar x) 'signature)) (list x)) - ((and (consp x) (eq (qcar x) 'if) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (consp (qcdr (qcdr (qcdr x)))) - (eq (qcdr (qcdr (qcdr (qcdr x)))) nil)) + ((and (consp x) (eq (qfirst x) 'signature)) (list x)) + ((and (consp x) (eq (qfirst x) 'if) (consp (qrest x)) + (consp (qcddr x)) (consp (qcdddr x)) + (eq (qcddddr x) nil)) (append (|flattenSignatureList| (third x)) (|flattenSignatureList| (fourth x)))) - ((and (consp x) (eq (qcar x) 'progn)) - (loop for x in (qcdr x) + ((and (consp x) (eq (qfirst x) 'progn)) + (loop for x in (qrest x) do - (if (and (consp x) (eq (qcar x) 'signature)) + (if (and (consp x) (eq (qfirst x) 'signature)) (setq zz (cons x zz)) (setq zz (append (|flattenSignatureList| x) zz)))) zz) @@ -6953,10 +6953,10 @@ variables, and predicates (defun |interactiveModemapForm| (mm) (labels ( (fn (x) - (if (and (consp x) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil) - (nequal (qcar x) '|isFreeFunction|) - (atom (qcar (qcdr (qcdr x))))) + (if (and (consp x) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil) + (nequal (qfirst x) '|isFreeFunction|) + (atom (qthird x))) (list (first x) (second x) (list (third x))) x))) (let (pattern dc sig mmpat patternAlist partial patvars @@ -7031,11 +7031,11 @@ identifier in newvars in the expression x (t (setq pred (|orderPredicateItems| (car predicates) sig skip)) (setq dependList - (when (and (consp pred) (eq (qcar pred) '|isDomain|) - (consp (qcdr pred)) (consp (qcdr (qcdr pred))) - (eq (qcdr (qcdr (qcdr pred))) nil) - (consp (qcar (qcdr (qcdr pred)))) - (eq (qcdr (qcar (qcdr (qcdr pred)))) nil)) + (when (and (consp pred) (eq (qfirst pred) '|isDomain|) + (consp (qrest pred)) (consp (qcddr pred)) + (eq (qcdddr pred) nil) + (consp (qthird pred)) + (eq (qcdaddr pred) nil)) (list (second pred)))))) (setq pred (|moveORsOutside| pred)) (when partial (setq pred (cons '|partial| pred))) @@ -7052,8 +7052,8 @@ identifier in newvars in the expression x (defun |orderPredicateItems| (pred1 sig skip) (let (pred) (setq pred (|signatureTran| pred1)) - (if (and (consp pred) (eq (qcar pred) 'and)) - (|orderPredTran| (qcdr pred) sig skip) + (if (and (consp pred) (eq (qfirst pred) 'and)) + (|orderPredTran| (qrest pred) sig skip) pred))) \end{chunk} @@ -7067,9 +7067,9 @@ identifier in newvars in the expression x (declare (special |$e|)) (cond ((atom pred) pred) - ((and (consp pred) (eq (qcar pred) '|has|) (CONSP (qcdr pred)) - (consp (qcdr (qcdr pred))) - (eq (qcdr (qcdr (qcdr pred))) nil) + ((and (consp pred) (eq (qfirst pred) '|has|) (CONSP (qrest pred)) + (consp (qcddr pred)) + (eq (qcdddr pred) nil) (|isCategoryForm| (third pred) |$e|)) (list '|ofCategory| (second pred) (third pred))) (t @@ -7099,16 +7099,16 @@ identifier in newvars in the expression x (SEQ (loop for pred in oldList do (cond - ((or (and (consp pred) (consp (qcdr pred)) - (consp (qcdr (qcdr pred))) - (eq (qcdr (qcdr (qcdr pred))) nil) - (member (qcar pred) '(|isDomain| |ofCategory|)) - (equal (qcar (qcdr pred)) (car sig)) - (null (|member| (qcar (qcdr pred)) (cdr sig)))) - (and (null skip) (consp pred) (eq (qcar pred) '|isDomain|) - (consp (qcdr pred)) (consp (qcdr (qcdr pred))) - (eq (qcdr (qcdr (qcdr pred))) nil) - (equal (qcar (qcdr pred)) '*1))) + ((or (and (consp pred) (consp (qrest pred)) + (consp (qcddr pred)) + (eq (qcdddr pred) nil) + (member (qfirst pred) '(|isDomain| |ofCategory|)) + (equal (qsecond pred) (car sig)) + (null (|member| (qsecond pred) (cdr sig)))) + (and (null skip) (consp pred) (eq (qfirst pred) '|isDomain|) + (consp (qrest pred)) (consp (qcddr pred)) + (eq (qcdddr pred) nil) + (equal (qsecond pred) '*1))) (setq oldList (|delete| pred oldList)) (setq lastPreds (cons pred lastPreds))))) ; --(2a) lastDependList=list of all variables that lastPred forms depend upon @@ -7123,9 +7123,9 @@ identifier in newvars in the expression x (loop for x in oldList do (when (and (consp x) - (or (eq (qcar x) '|isDomain|) (eq (qcar x) '|ofCategory|)) - (consp (qcdr x)) (consp (qcdr (qcdr x))) - (eq (qcdr (qcdr (qcdr x))) nil)) + (or (eq (qfirst x) '|isDomain|) (eq (qfirst x) '|ofCategory|)) + (consp (qrest x)) (consp (qcddr x)) + (eq (qcdddr x) nil)) (setq result (unionq result (|listOfPatternIds| (third x)))))) result)) ; --(3a) newList= list of ofCat/isDom entries that don't depend on @@ -7133,9 +7133,9 @@ identifier in newvars in the expression x do (cond ((and (consp x) - (or (eq (qcar x) '|ofCategory|) (eq (qcar x) '|isDomain|)) - (consp (qcdr x)) (consp (qcdr (qcdr x))) - (eq (qcdr (qcdr (qcdr x))) nil)) + (or (eq (qfirst x) '|ofCategory|) (eq (qfirst x) '|isDomain|)) + (consp (qrest x)) (consp (qcddr x)) + (eq (qcdddr x) nil)) (setq indepvl (|listOfPatternIds| (second x))) (setq depvl (|listOfPatternIds| (third x)))) (t @@ -7152,9 +7152,9 @@ identifier in newvars in the expression x (loop for x in oldList do (cond ((and (consp x) - (or (eq (qcar x) '|ofCategory|) (eq (qcar x) '|isDomain|)) - (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + (or (eq (qfirst x) '|ofCategory|) (eq (qfirst x) '|isDomain|)) + (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (setq indepvl (|listOfPatternIds| (second x))) (setq depvl (|listOfPatternIds| (third x)))) (t @@ -7173,10 +7173,10 @@ identifier in newvars in the expression x (loop for pred in newList do (when (and (consp pred) - (or (eq (qcar pred) '|isDomain|) (eq (qcar x) '|ofCategory|)) - (consp (qcdr pred)) - (consp (qcdr (qcdr pred))) - (eq (qcdr (qcdr (qcdr pred))) nil)) + (or (eq (qfirst pred) '|isDomain|) (eq (qfirst x) '|ofCategory|)) + (consp (qrest pred)) + (consp (qcddr pred)) + (eq (qcdddr pred) nil)) (setq ids (|listOfPatternIds| (third pred))) (when (let (result) @@ -7199,11 +7199,11 @@ identifier in newvars in the expression x (findSub (x alist) (cond ((null alist) nil) - ((and (consp alist) (consp (qcar alist)) - (eq (qcar (qcar alist)) '|isDomain|) - (consp (qcdr (qcar alist))) - (consp (qcdr (qcdr (qcar alist)))) - (eq (qcdr (qcdr (qcdr (qcar alist)))) nil) + ((and (consp alist) (consp (qfirst alist)) + (eq (qcaar alist) '|isDomain|) + (consp (qcdar alist)) + (consp (qcddar alist)) + (eq (qcdddar alist) nil) (equal x (cadar alist))) (caddar alist)) (t (findSub x (cdr alist))))) @@ -7223,13 +7223,13 @@ identifier in newvars in the expression x (let (head tail nhead) (if (consp u) (progn - (setq head (qcar u)) - (setq tail (qcdr u)) + (setq head (qfirst u)) + (setq tail (qrest u)) (setq nhead (cond - ((and (consp head) (eq (qcar head) '|isDomain|) - (consp (qcdr head)) (consp (qcdr (qcdr head))) - (eq (qcdr (qcdr (qcdr head))) nil)) + ((and (consp head) (eq (qfirst head) '|isDomain|) + (consp (qrest head)) (consp (qcddr head)) + (eq (qcdddr head) nil)) (list '|isDomain| (second head) (fn (third head) tail))) (t head))) @@ -7244,7 +7244,7 @@ identifier in newvars in the expression x (defun |moveORsOutside| (p) (let (q x) (cond - ((and (consp p) (eq (qcar p) 'and)) + ((and (consp p) (eq (qfirst p) 'and)) (setq q (prog (G167169) (return @@ -7256,7 +7256,7 @@ identifier in newvars in the expression x ((setq x (let (tmp1) (loop for r in q - when (and (consp r) (eq (qcar r) 'or)) + when (and (consp r) (eq (qfirst r) 'or)) do (setq tmp1 (or tmp1 r))) tmp1)) (|moveORsOutside| @@ -7271,11 +7271,11 @@ identifier in newvars in the expression x ;(defun |moveORsOutside| (p) ; (let (q s x tmp1) ; (cond -; ((and (consp p) (eq (qcar p) 'and)) -; (setq q (loop for r in (qcdr p) collect (|moveORsOutside| r))) +; ((and (consp p) (eq (qfirst p) 'and)) +; (setq q (loop for r in (qrest p) collect (|moveORsOutside| r))) ; (setq tmp1 ; (loop for r in q -; when (and (consp r) (eq (qcdr r) 'or)) +; when (and (consp r) (eq (qrest r) 'or)) ; collect r)) ; (setq x (mapcar #'(lambda (a b) (or a b)) tmp1)) ; (if x @@ -7339,9 +7339,9 @@ Make pattern variable substitutions. (maplist #'(lambda (xTails) (let ((x (car xTails))) - (when (and (consp x) (eq (qcar x) '|Union|) - (consp (qcdr x)) (consp (qcdr (qcdr x))) - (eq (qcdr (qcdr (qcdr x))) nil) + (when (and (consp x) (eq (qfirst x) '|Union|) + (consp (qrest x)) (consp (qcddr x)) + (eq (qcdddr x) nil) (equal (third x) "failed") (equal xTails sig)) (setq x (second x)) @@ -7802,14 +7802,14 @@ where item has form (setq implementation (caddr item)) (setq kind (cond - ((and (consp implementation) (consp (qcdr implementation)) - (consp (qcdr (qcdr implementation))) - (eq (qcdr (qcdr (qcdr implementation))) nil) - (progn (setq n (qcar (qcdr (qcdr implementation)))) t) - (|member| (setq eltEtc (qcar implementation)) '(const elt))) + ((and (consp implementation) (consp (qrest implementation)) + (consp (qcddr implementation)) + (eq (qcdddr implementation) nil) + (progn (setq n (qthird implementation)) t) + (|member| (setq eltEtc (qfirst implementation)) '(const elt))) eltEtc) ((consp implementation) - (setq impOp (qcar implementation)) + (setq impOp (qfirst implementation)) (cond ((eq impop 'xlam) implementation) ((|member| impOp '(const |Subsumed|)) impOp) @@ -8032,9 +8032,9 @@ where item has form (FindRep (cb) (loop while cb do (when (atom cb) (return nil)) - (when (and (consp cb) (consp (qcar cb)) (eq (qcar (qcar cb)) 'let) - (consp (qcdr (qcar cb))) (eq (qcar (qcdr (qcar cb))) '|Rep|) - (consp (qcdr (qcdr (qcar cb))))) + (when (and (consp cb) (consp (qfirst cb)) (eq (qcaar cb) 'let) + (consp (qcdar cb)) (eq (qcadar cb) '|Rep|) + (consp (qcddar cb))) (return (caddar cb))) (pop cb)))) (let (|$addForm| |$viewNames| |$functionStats| |$functorStats| @@ -8154,15 +8154,15 @@ where item has form (third (|compMakeDeclaration| (list '|:| '$ target) mode |$e|))) (unless |$insideCategoryPackageIfTrue| (if - (and (consp body) (eq (qcar body) '|add|) - (consp (qcdr body)) - (consp (qcar (qcdr body))) - (consp (qcdr (qcdr body))) - (eq (qcdr (qcdr (qcdr body))) nil) - (consp (qcar (qcdr (qcdr body)))) - (eq (qcar (qcar (qcdr (qcdr body)))) 'capsule) - (member (qcar (qcar (qcdr body))) '(|List| |Vector|)) - (equal (FindRep (qcdr (qcar (qcdr (qcdr body))))) (second body))) + (and (consp body) (eq (qfirst body) '|add|) + (consp (qrest body)) + (consp (qsecond body)) + (consp (qcddr body)) + (eq (qcdddr body) nil) + (consp (qthird body)) + (eq (qcaaddr body) 'capsule) + (member (qcaadr body) '(|List| |Vector|)) + (equal (FindRep (qcdaddr body)) (second body))) (setq |$e| (|augModemapsFromCategoryRep| '$ (second body) (cdaddr body) target |$e|)) (setq |$e| (|augModemapsFromCategory| '$ '$ target |$e|)))) @@ -8205,9 +8205,9 @@ where item has form ($lisplib (setq |$lisplibKind| (if (and (consp |$functorTarget|) - (eq (qcar |$functorTarget|) 'category) - (consp (qcdr |$functorTarget|)) - (nequal (qcar (qcdr |$functorTarget|)) '|domain|)) + (eq (qfirst |$functorTarget|) 'category) + (consp (qrest |$functorTarget|)) + (nequal (qsecond |$functorTarget|) '|domain|)) '|package| '|domain|)) (setq |$lisplibForm| form) @@ -8385,14 +8385,14 @@ where item has form (list (|bootStrapError| |$functorForm| /editfile) mode env) (progn (setq tt (|compOrCroak| form mode env)) - (if (and (consp form) (member (qcar form) '(|add| capsule))) + (if (and (consp form) (member (qfirst form) '(|add| capsule))) tt (progn (setq |$NRTaddForm| - (if (and (consp form) (eq (qcar form) '|SubDomain|) - (consp (qcdr form)) (consp (qcdr (qcdr form))) - (eq (qcdr (qcdr (qcdr form))) nil)) - (qcar (qcdr form)) + (if (and (consp form) (eq (qfirst form) '|SubDomain|) + (consp (qrest form)) (consp (qcddr form)) + (eq (qcdddr form) nil)) + (qsecond form) form)) tt)))))) @@ -8469,7 +8469,7 @@ where item has form (unless (cdr cvl) (if (and (null (|member| (caar cvl) |$formalArgList|)) (consp (|getmode| (caar cvl) |$env|)) - (eq (qcar (|getmode| (caar cvl) |$env|)) '|Mapping|)) + (eq (qfirst (|getmode| (caar cvl) |$env|)) '|Mapping|)) (push (list (caar cvl) (cadar cvl)) loc) (push (list (caar cvl) (cadar cvl)) exp)))) (when loc @@ -8511,7 +8511,7 @@ where item has form (if ss (progn (loop for u in ss do (push (rest u) |$ConditionalOperators|)) - (if (and (consp s) (eq (qcar s) '|Join|)) + (if (and (consp s) (eq (qfirst s) '|Join|)) (progn (if (setq u (assq 'category ss)) (msubst (append u ss) u s) @@ -8522,52 +8522,52 @@ where item has form (fn (a s) (declare (special |$CategoryFrame|)) (if (|isCategoryForm| s |$CategoryFrame|) - (if (and (consp s) (eq (qcar s) '|Join|)) + (if (and (consp s) (eq (qfirst s) '|Join|)) (|genDomainViewList0| a (rest s)) (list (|genDomainView| a s '|getDomainView|))) (list a))) (findExtras (a target) (cond - ((and (consp target) (eq (qcar target) '|Join|)) + ((and (consp target) (eq (qfirst target) '|Join|)) (reduce #'|union| - (loop for x in (qcdr target) + (loop for x in (qrest target) collect (findExtras a x)))) - ((and (consp target) (eq (qcar target) 'category)) + ((and (consp target) (eq (qfirst target) 'category)) (reduce #'|union| - (loop for x in (qcdr (qcdr target)) + (loop for x in (qcddr target) collect (findExtras1 a x)))))) (findExtras1 (a x) (cond - ((and (consp x) (or (eq (qcar x) 'and)) (eq (qcar x) 'or)) + ((and (consp x) (or (eq (qfirst x) 'and)) (eq (qfirst x) 'or)) (reduce #'|union| (loop for y in (rest x) collect (findExtras1 a y)))) - ((and (consp x) (eq (qcar x) 'if) - (consp (qcdr x)) (consp (qcdr (qcdr x))) - (consp (qcdr (qcdr (qcdr x)))) - (eq (qcdr (qcdr (qcdr (qcdr x)))) nil)) + ((and (consp x) (eq (qfirst x) 'if) + (consp (qrest x)) (consp (qcddr x)) + (consp (qcdddr x)) + (eq (qcddddr x) nil)) (|union| (findExtrasP a (second x)) (|union| (findExtras1 a (third x)) (findExtras1 a (fourth x))))))) (findExtrasP (a x) (cond - ((and (consp x) (or (eq (qcar x) 'and)) (eq (qcar x) 'or)) + ((and (consp x) (or (eq (qfirst x) 'and)) (eq (qfirst x) 'or)) (reduce #'|union| (loop for y in (rest x) collect (findExtrasP a y)))) - ((and (consp x) (eq (qcar x) '|has|) - (consp (qcdr x)) (consp (qcdr (qcdr x))) - (consp (qcdr (qcdr (qcdr x)))) - (eq (qcdr (qcdr (qcdr (qcdr x)))) nil)) + ((and (consp x) (eq (qfirst x) '|has|) + (consp (qrest x)) (consp (qcddr x)) + (consp (qcdddr x)) + (eq (qcddddr x) nil)) (|union| (findExtrasP a (second x)) (|union| (findExtras1 a (third x)) (findExtras1 a (fourth x))))) - ((and (consp x) (eq (qcar x) '|has|) - (consp (qcdr x)) (equal (qcar (qcdr x)) a) - (consp (qcdr (qcdr x))) - (eq (qcdr (qcdr (qcdr x))) nil) - (consp (qcar (qcdr (qcdr x)))) - (eq (qcar (qcar (qcdr (qcdr x)))) 'signature)) + ((and (consp x) (eq (qfirst x) '|has|) + (consp (qrest x)) (equal (qsecond x) a) + (consp (qcddr x)) + (eq (qcdddr x) nil) + (consp (qthird x)) + (eq (qcaaddr x) 'signature)) (list (third x))))) ) @@ -8601,7 +8601,7 @@ where item has form (declare (special |$EmptyEnvironment|) (ignore firsttime)) (cond ((null catlist) nil) - ((and (consp catlist) (eq (qcdr catlist) nil) + ((and (consp catlist) (eq (qrest catlist) nil) (null (|isCategoryForm| (first catlist) |$EmptyEnvironment|))) nil) (t @@ -8625,13 +8625,13 @@ where item has form (let (code cd) (declare (special |$getDomainCode| |$e|)) (cond - ((and (consp c) (eq (qcar c) 'category) (consp (qcdr c))) + ((and (consp c) (eq (qfirst c) 'category) (consp (qrest c))) (|genDomainOps| name name c)) (t (setq code - (if (and (consp c) (eq (qcar c) '|SubsetCategory|) - (consp (qcdr c)) (consp (qcdr (qcdr c))) - (eq (qcdr (qcdr (qcdr c))) nil)) + (if (and (consp c) (eq (qfirst c) '|SubsetCategory|) + (consp (qrest c)) (consp (qcddr c)) + (eq (qcdddr c) nil)) (second c) c)) (setq |$e| (|augModemapsFromCategory| name nil c |$e|)) @@ -8712,20 +8712,20 @@ where item has form (setq u (assq (first opSig) oplist)) (setq tmp1 (|assoc| (second opSig) u)) (cond - ((and (consp tmp1) (consp (qcdr tmp1)) - (consp (qcdr (qcdr tmp1))) (consp (qcdr (qcdr (qcdr tmp1)))) - (eq (qcdr (qcdr (qcdr (qcdr tmp1)))) nil) - (eq (qcar (qcdr (qcdr (qcdr tmp1)))) 'elt)) + ((and (consp tmp1) (consp (qrest tmp1)) + (consp (qcddr tmp1)) (consp (qcdddr tmp1)) + (eq (qcddddr tmp1) nil) + (eq (qfourth tmp1) 'elt)) (setelt ops i (elt dom (second tmp1)))) (t (setq noplist (sublis substargs u)) (setq tmp1 (|AssocBarGensym| (msubst (elt dom 0) '$ (second opSig)) noplist)) (cond - ((and (consp tmp1) (consp (qcdr tmp1)) (consp (qcdr (qcdr tmp1))) - (consp (qcdr (qcdr (qcdr tmp1)))) - (eq (qcdr (qcdr (qcdr (qcdr tmp1)))) nil) - (eq (qcar (qcdr (qcdr (qcdr tmp1)))) 'elt)) + ((and (consp tmp1) (consp (qrest tmp1)) (consp (qcddr tmp1)) + (consp (qcdddr tmp1)) + (eq (qcddddr tmp1) nil) + (eq (qfourth tmp1) 'elt)) (setelt ops i (elt dom (second tmp1)))) (t (setelt ops i (cons |Undef| (cons (list (elt dom 0) i) opSig)))))))) @@ -8766,21 +8766,21 @@ where item has form (declare (special |$sigAlist|)) (cond ((atom x) x) - ((and (consp x) (eq (qcar x) '|:|) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) '|:|) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (setq |$sigAlist| (cons (cons (second x) (transformType (third x))) |$sigAlist|)) x) - ((and (consp x) (eq (qcar x) '|Record|)) x) + ((and (consp x) (eq (qfirst x) '|Record|)) x) (t (cons (first x) (loop for y in (rest x) collect (transformType y)))))) (removeSuchthat (x) (declare (special |$predAlist|)) - (if (and (consp x) (eq (qcar x) '|\||) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + (if (and (consp x) (eq (qfirst x) '|\||) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (progn (setq |$predAlist| (cons (cons (second x) (third x)) |$predAlist|)) (second x)) @@ -8908,11 +8908,11 @@ where item has form (labels ( (fn (x g) (cond - ((and (consp x) (eq (qcar x) 'throw) (consp (qcdr x)) - (equal (qcar (qcdr x)) g)) + ((and (consp x) (eq (qfirst x) 'throw) (consp (qrest x)) + (equal (qsecond x) g)) (|rplac| (car x) 'return) (|rplac| (cdr x) - (replaceThrowByReturn (qcdr (qcdr x)) g))) + (replaceThrowByReturn (qcddr x) g))) ((atom x) nil) (t (replaceThrowByReturn (car x) g) @@ -8921,11 +8921,11 @@ where item has form (fn x g) x) (removeTopLevelCatch (body) - (if (and (consp body) (eq (qcar body) 'catch) (consp (qcdr body)) - (consp (qcdr (qcdr body))) (eq (qcdr (qcdr (qcdr body))) nil)) + (if (and (consp body) (eq (qfirst body) 'catch) (consp (qrest body)) + (consp (qcddr body)) (eq (qcdddr body) nil)) (removeTopLevelCatch (replaceThrowByReturn - (qcar (qcdr (qcdr body))) (qcar (qcdr body)))) + (qthird body) (qsecond body))) body))) (let (defp name slamOrLam args body bodyp) (declare (special |$reportOptimization|)) @@ -8965,12 +8965,12 @@ where item has form ((atom x) nil) ((eq (setq y (car x)) 'quote) nil) ((eq y 'closedfn) nil) - ((and (consp y) (consp (qcar y)) (eq (qcar (qcar y)) 'xlam) - (consp (qcdr (qcar y))) (consp (qcdr (qcdr (qcar y)))) - (eq (qcdr (qcdr (qcdr (qcar y)))) nil)) - (setq argl (qcar (qcdr (qcar y)))) - (setq body (qcar (qcdr (qcdr (qcar y))))) - (setq a (qcdr y)) + ((and (consp y) (consp (qfirst y)) (eq (qcaar y) 'xlam) + (consp (qcdar y)) (consp (qcddar y)) + (eq (qcdddar y) nil)) + (setq argl (qcadar y)) + (setq body (qcaddar y)) + (setq a (qrest y)) (|optimize| (cdr x)) (cond ((eq argl '|ignore|) (rplac (car x) body)) @@ -9014,12 +9014,12 @@ where item has form \begin{chunk}{defun optXLAMCond} (defun |optXLAMCond| (x) (cond - ((and (consp x) (eq (qcar x) 'cond) (consp (qcdr x)) - (consp (qcar (qcdr x))) (consp (qcdr (qcar (qcdr x)))) - (eq (qcdr (qcdr (qcar (qcdr x)))) nil)) - (if (|optPredicateIfTrue| (qcar (qcar (qcdr x)))) - (qcar (qcdr (qcar (qcdr x)))) - (cons 'cond (cons (qcar (qcdr x)) (|optCONDtail| (qcdr (qcdr x))))))) + ((and (consp x) (eq (qfirst x) 'cond) (consp (qrest x)) + (consp (qsecond x)) (consp (qcdadr x)) + (eq (qcddadr x) nil)) + (if (|optPredicateIfTrue| (qcaadr x)) + (qcadadr x) + (cons 'cond (cons (qsecond x) (|optCONDtail| (qcddr x)))))) ((atom x) x) (t (rplac (car x) (|optXLAMCond| (car x))) @@ -9060,9 +9060,9 @@ simple kind of compile-time type evaluation. (defun |optPredicateIfTrue| (p) (declare (special |$BasicPredicates|)) (cond - ((and (consp p) (eq (qcar p) 'quote)) T) - ((and (consp p) (consp (qcdr p)) (eq (qcdr (qcdr p)) nil) - (member (qcar p) |$BasicPredicates|) (funcall (qcar p) (qcar (qcdr p)))) + ((and (consp p) (eq (qfirst p) 'quote)) T) + ((and (consp p) (consp (qrest p)) (eq (qcddr p) nil) + (member (qfirst p) |$BasicPredicates|) (funcall (qfirst p) (qsecond p))) t) (t nil))) @@ -9081,10 +9081,10 @@ simple kind of compile-time type evaluation. (cond ((eq b '|noBranch|) (list 'cond (list (list 'null a ) c))) ((eq c '|noBranch|) (list 'cond (list a b))) - ((and (consp c) (eq (qcar c) 'if)) + ((and (consp c) (eq (qfirst c) 'if)) (cons 'cond (cons (list a b) (cdr (|optIF2COND| c))))) - ((and (consp c) (eq (qcar c) 'cond)) - (cons 'cond (cons (list a b) (qcdr c)))) + ((and (consp c) (eq (qfirst c) 'cond)) + (cons 'cond (cons (list a b) (qrest c)))) (t (list 'cond (list a b) (list |$true| c)))))) @@ -9167,19 +9167,19 @@ optPackageCall. (setq a (cdr tmp1)) (cond ((atom fn) (rplac (cdr x) a) (rplac (car x) fn)) - ((and (consp fn) (eq (qcar fn) 'pac)) (|optPackageCall| x fn a)) - ((and (consp fn) (eq (qcar fn) '|applyFun|) - (consp (qcdr fn)) (eq (qcdr (qcdr fn)) nil)) - (setq name (qcar (qcdr fn))) + ((and (consp fn) (eq (qfirst fn) 'pac)) (|optPackageCall| x fn a)) + ((and (consp fn) (eq (qfirst fn) '|applyFun|) + (consp (qrest fn)) (eq (qcddr fn) nil)) + (setq name (qsecond fn)) (rplac (car x) 'spadcall) (rplac (cdr x) (append a (cons name nil))) x) - ((and (consp fn) (consp (qcdr fn)) (consp (qcdr (qcdr fn))) - (eq (qcdr (qcdr (qcdr fn))) nil) - (member (qcar fn) '(elt qrefelt const))) - (setq q (qcar fn)) - (setq r (qcar (qcdr fn))) - (setq n (qcar (qcdr (qcdr fn)))) + ((and (consp fn) (consp (qrest fn)) (consp (qcddr fn)) + (eq (qcdddr fn) nil) + (member (qfirst fn) '(elt qrefelt const))) + (setq q (qfirst fn)) + (setq r (qsecond fn)) + (setq n (qthird fn)) (cond ((and (null |$bootStrapMode|) (setq w (|optCallSpecially| q x n r))) w) @@ -9227,9 +9227,9 @@ optPackageCall. (when z (setq zp (car z)) (setq z (cdr x)) - (if (and (consp zp) (eq (qcar zp) 'let) (consp (qcdr zp)) - (equal (qcar (qcdr zp)) a) (consp (qcdr (qcdr zp)))) - (qcar (qcdr (qcdr zp))) + (if (and (consp zp) (eq (qfirst zp) 'let) (consp (qrest zp)) + (equal (qsecond zp) a) (consp (qcddr zp))) + (qthird zp) (lookup a z)))))) (let (tmp1 op y prop yy) (declare (special |$specialCaseKeyList| |$getDomainCode| |$e| @@ -9283,9 +9283,9 @@ optPackageCall. ((setq fn (getl (|compileTimeBindingOf| (car (elt yval n))) '|SPADreplace|)) (|rplac| (cdr x) (cdar x)) (|rplac| (car x) fn) - (when (and (consp fn) (eq (qcar fn) 'xlam)) + (when (and (consp fn) (eq (qfirst fn) 'xlam)) (setq x (car (|optimize| (list x))))) - (if (and (consp x) (eq (qcar x) 'equal) (progn (setq args (qcdr x)) t)) + (if (and (consp x) (eq (qfirst x) 'equal) (progn (setq args (qrest x)) t)) (rplacw x (def-equal args)) x)) (t @@ -9327,15 +9327,15 @@ optPackageCall. \begin{chunk}{defun optCallEval} (defun |optCallEval| (u) (cond - ((and (consp u) (eq (qcar u) '|List|)) + ((and (consp u) (eq (qfirst u) '|List|)) (|List| (|Integer|))) - ((and (consp u) (eq (qcar u) '|Vector|)) + ((and (consp u) (eq (qfirst u) '|Vector|)) (|Vector| (|Integer|))) - ((and (consp u) (eq (qcar u) '|PrimitiveArray|)) + ((and (consp u) (eq (qfirst u) '|PrimitiveArray|)) (|PrimitiveArray| (|Integer|))) - ((and (consp u) (eq (qcar u) '|FactoredForm|)) + ((and (consp u) (eq (qfirst u) '|FactoredForm|)) (|FactoredForm| (|Integer|))) - ((and (consp u) (eq (qcar u) '|Matrix|)) + ((and (consp u) (eq (qfirst u) '|Matrix|)) (|Matrix| (|Integer|))) (t (|eval| u)))) @@ -9354,29 +9354,29 @@ optPackageCall. (defun |optSEQ| (arg) (labels ( (tryToRemoveSEQ (z) - (if (and (consp z) (eq (qcar z) 'seq) (consp (qcdr z)) - (eq (qcdr (qcdr z)) nil) (consp (qcar (qcdr z))) - (consp (qcdr (qcar (qcdr z)))) - (eq (qcdr (qcdr (qcar (qcdr z)))) nil) - (member (qcar (qcar (qcdr z))) '(exit return throw))) - (qcar (qcdr (qcar (qcdr z)))) + (if (and (consp z) (eq (qfirst z) 'seq) (consp (qrest z)) + (eq (qcddr z) nil) (consp (qsecond z)) + (consp (qcdadr z)) + (eq (qcddadr z) nil) + (member (qcaadr z) '(exit return throw))) + (qcadadr z) z)) (SEQToCOND (z) (let (transform before aft) (setq transform (loop for x in z while - (and (consp x) (eq (qcar x) 'cond) (consp (qcdr x)) - (eq (qcdr (qcdr x)) nil) (consp (qcar (qcdr x))) - (consp (qcdr (qcar (qcdr x)))) - (eq (qcdr (qcdr (qcar (qcdr x)))) nil) - (consp (qcar (qcdr (qcar (qcdr x))))) - (eq (qcar (qcar (qcdr (qcar (qcdr x))))) 'exit) - (consp (qcdr (qcar (qcdr (qcar (qcdr x)))))) - (eq (qcdr (qcdr (qcar (qcdr (qcar (qcdr x)))))) nil)) + (and (consp x) (eq (qfirst x) 'cond) (consp (qrest x)) + (eq (qcddr x) nil) (consp (qsecond x)) + (consp (qcdadr x)) + (eq (qcddadr x) nil) + (consp (qcadadr x)) + (eq (qfirst (qcadadr x)) 'exit) + (consp (qrest (qcadadr x))) + (eq (qcddr (qcadadr x)) nil)) collect - (list (qcar (qcar (qcdr x))) - (qcar (qcdr (qcar (qcdr (qcar (qcdr x))))))))) + (list (qcaadr x) + (qsecond (qcadadr x))))) (setq before (take (|#| transform) z)) (setq aft (|after| z before)) (cond @@ -9390,13 +9390,13 @@ optPackageCall. (let (g x r) (cond ((null z) nil) - ((and (consp z) (consp (qcar z)) (eq (qcar (qcar z)) 'let) - (consp (qcdr (qcar z))) (consp (qcdr (qcdr (qcar z)))) - (gensymp (qcar (qcdr (qcar z)))) - (> 2 (|numOfOccurencesOf| (qcar (qcdr (qcar z))) (qcdr z)))) - (setq g (qcar (qcdr (qcar z)))) - (setq x (qcar (qcdr (qcdr (qcar z))))) - (setq r (qcdr z)) + ((and (consp z) (consp (qfirst z)) (eq (qcaar z) 'let) + (consp (qcdar z)) (consp (qcddar z)) + (gensymp (qcadar z)) + (> 2 (|numOfOccurencesOf| (qcadar z) (qrest z)))) + (setq g (qcadar z)) + (setq x (qcaddar z)) + (setq r (qrest z)) (getRidOfTemps (msubst x g r))) ((eq (car z) '|/throwAway|) (getRidOfTemps (cdr z))) @@ -9418,10 +9418,10 @@ optPackageCall. (defun |optEQ| (u) (let (z r) (cond - ((and (consp u) (eq (qcar u) 'eq) (consp (qcdr u)) - (consp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) - (setq z (qcar (qcdr u))) - (setq r (qcar (qcdr (qcdr u)))) + ((and (consp u) (eq (qfirst u) 'eq) (consp (qrest u)) + (consp (qcddr u)) (eq (qcdddr u) nil)) + (setq z (qsecond u)) + (setq r (qthird u)) ; That undoes some weird work in Boolean to do with the definition of true (if (and (numberp z) (numberp r)) (list 'quote (eq z r)) @@ -9442,9 +9442,9 @@ optPackageCall. (defun |optMINUS| (u) (let (v) (cond - ((and (consp u) (eq (qcar u) 'minus) (consp (qcdr u)) - (eq (qcdr (qcdr u)) nil)) - (setq v (qcar (qcdr u))) + ((and (consp u) (eq (qfirst u) 'minus) (consp (qrest u)) + (eq (qcddr u) nil)) + (setq v (qsecond u)) (cond ((numberp v) (- v)) (t u))) (t u)))) @@ -9462,9 +9462,9 @@ optPackageCall. (defun |optQSMINUS| (u) (let (v) (cond - ((and (consp u) (eq (qcar u) 'qsminus) (consp (qcdr u)) - (eq (qcdr (qcdr u)) nil)) - (setq v (qcar (qcdr u))) + ((and (consp u) (eq (qfirst u) 'qsminus) (consp (qrest u)) + (eq (qcddr u) nil)) + (setq v (qsecond u)) (cond ((numberp v) (- v)) (t u))) (t u)))) @@ -9482,9 +9482,9 @@ optPackageCall. (defun |opt-| (u) (let (v) (cond - ((and (consp u) (eq (qcar u) '-) (consp (qcdr u)) - (eq (qcdr (qcdr u)) NIL)) - (setq v (qcar (qcdr u))) + ((and (consp u) (eq (qfirst u) '-) (consp (qrest u)) + (eq (qcddr u) NIL)) + (setq v (qsecond u)) (cond ((numberp v) (- v)) (t u))) (t u)))) @@ -9502,11 +9502,11 @@ optPackageCall. (defun |optLESSP| (u) (let (a b) (cond - ((and (consp u) (eq (qcar u) 'lessp) (consp (qcdr u)) - (consp (qcdr (qcdr u))) - (eq (qcdr (qcdr (qcdr u))) nil)) - (setq a (qcar (qcdr u))) - (setq b (qcar (qcdr (qcdr u)))) + ((and (consp u) (eq (qfirst u) 'lessp) (consp (qrest u)) + (consp (qcddr u)) + (eq (qcdddr u) nil)) + (setq a (qsecond u)) + (setq b (qthird u)) (if (eql b 0) (list 'minusp a) (list '> b a))) @@ -9535,20 +9535,20 @@ optPackageCall. ((and (consp argl) (progn (setq tmp1 (reverse argl)) t) (consp tmp1)) - (setq fun (qcar tmp1)) - (setq argl (qcdr tmp1)) + (setq fun (qfirst tmp1)) + (setq argl (qrest tmp1)) (setq argl (nreverse argl)) (cond ((and (consp fun) - (or (eq (qcar fun) 'elt) (eq (qcar fun) 'lispelt)) + (or (eq (qfirst fun) 'elt) (eq (qfirst fun) 'lispelt)) (progn - (and (consp (qcdr fun)) + (and (consp (qrest fun)) (progn - (setq dom (qcar (qcdr fun))) - (and (consp (qcdr (qcdr fun))) - (eq (qcdr (qcdr (qcdr fun))) nil) + (setq dom (qsecond fun)) + (and (consp (qcddr fun)) + (eq (qcdddr fun) nil) (progn - (setq slot (qcar (qcdr (qcdr fun)))) + (setq slot (qthird fun)) t)))))) (|optCall| (cons '|call| (cons (list 'elt dom slot) argl)))) (t form))) @@ -9589,17 +9589,17 @@ optPackageCall. (changeThrowToExit (s g) (cond ((or (atom s) (member (car s) '(quote seq repeat collect))) nil) - ((and (consp s) (eq (qcar s) 'throw) (consp (qcdr s)) - (equal (qcar (qcdr s)) g)) + ((and (consp s) (eq (qfirst s) 'throw) (consp (qrest s)) + (equal (qsecond s) g)) (|rplac| (car s) 'exit) - (|rplac| (cdr s) (qcdr (qcdr s)))) + (|rplac| (cdr s) (qcddr s))) (t (changeThrowToExit (car s) g) (changeThrowToExit (cdr s) g)))) (hasNoThrows (a g) (cond - ((and (consp a) (eq (qcar a) 'throw) (consp (qcdr a)) - (equal (qcar (qcdr a)) g)) + ((and (consp a) (eq (qfirst a) 'throw) (consp (qrest a)) + (equal (qsecond a) g)) nil) ((atom a) t) (t @@ -9609,10 +9609,10 @@ optPackageCall. (let (u) (cond ((or (atom s) (eq (car s) 'quote)) nil) - ((and (consp s) (eq (qcar s) 'throw) (consp (qcdr s)) - (equal (qcar (qcdr s)) g) (consp (qcdr (qcdr s))) - (eq (qcdr (qcdr (qcdr s))) nil)) - (setq u (qcar (qcdr (qcdr s)))) + ((and (consp s) (eq (qfirst s) 'throw) (consp (qrest s)) + (equal (qsecond s) g) (consp (qcddr s)) + (eq (qcdddr s) nil)) + (setq u (qthird s)) (changeThrowToGo u g) (|rplac| (car s) 'progn) (|rplac| (cdr s) (list (list 'let (cadr g) u) (list 'go (cadr g))))) @@ -9628,15 +9628,15 @@ optPackageCall. ((atom a) a) (t (cond - ((and (consp a) (eq (qcar a) 'seq) (consp (qcdr a)) - (progn (setq tmp2 (reverse (qcdr a))) t) - (consp tmp2) (consp (qcar tmp2)) (eq (qcar (qcar tmp2)) 'throw) - (consp (qcdr (qcar tmp2))) - (equal (qcar (qcdr (qcar tmp2))) g) - (consp (qcdr (qcdr (qcar tmp2)))) - (eq (qcdr (qcdr (qcdr (qcar tmp2)))) nil)) - (setq u (qcar (qcdr (qcdr (qcar tmp2))))) - (setq s (qcdr tmp2)) + ((and (consp a) (eq (qfirst a) 'seq) (consp (qrest a)) + (progn (setq tmp2 (reverse (qrest a))) t) + (consp tmp2) (consp (qfirst tmp2)) (eq (qcaar tmp2) 'throw) + (consp (qcdar tmp2)) + (equal (qcadar tmp2) g) + (consp (qcddar tmp2)) + (eq (qcdddar tmp2) nil)) + (setq u (qcaddar tmp2)) + (setq s (qrest tmp2)) (setq s (nreverse s)) (changeThrowToExit s g) (|rplac| (cdr a) (append s (list (list 'exit u)))) @@ -9674,47 +9674,47 @@ optPackageCall. (let (z p1 p2 c3 c1 c2 a result) (setq z (cdr x)) (when - (and (consp z) (consp (qcdr z)) (eq (qcdr (qcdr z)) nil) - (consp (qcar (qcdr z))) (consp (qcdr (qcar (qcdr z)))) - (eq (qcdr (qcdr (qcar (qcdr z)))) nil) - (|TruthP| (qcar (qcar (qcdr z)))) - (consp (qcar (qcdr (qcar (qcdr z))))) - (eq (qcar (qcar (qcdr (qcar (qcdr z))))) 'cond)) - (rplacd (cdr x) (qcdr (qcar (qcdr (qcar (qcdr z))))))) + (and (consp z) (consp (qrest z)) (eq (qcddr z) nil) + (consp (qsecond z)) (consp (qcdadr z)) + (eq (qrest (qcdadr z)) nil) + (|TruthP| (qcaadr z)) + (consp (qcadadr z)) + (eq (qfirst (qcadadr z)) 'cond)) + (rplacd (cdr x) (qrest (qcadadr z)))) (cond - ((and (consp z) (consp (qcar z)) (consp (qcdr z)) (consp (qcar (qcdr z)))) - (setq p1 (qcar (qcar z))) - (setq c1 (qcdr (qcar z))) - (setq p2 (qcar (qcar (qcdr z)))) - (setq c2 (qcdr (qcar (qcdr z)))) + ((and (consp z) (consp (qfirst z)) (consp (qrest z)) (consp (qsecond z))) + (setq p1 (qcaar z)) + (setq c1 (qcdar z)) + (setq p2 (qcaadr z)) + (setq c2 (qcdadr z)) (when - (or (and (consp p1) (eq (qcar p1) 'null) (consp (qcdr p1)) - (eq (qcdr (qcdr p1)) nil) - (equal (qcar (qcdr p1)) p2)) - (and (consp p2) (eq (qcar p2) 'null) (consp (qcdr p2)) - (eq (qcdr (qcdr p2)) nil) - (equal (qcar (qcdr p2)) p1))) + (or (and (consp p1) (eq (qfirst p1) 'null) (consp (qrest p1)) + (eq (qcddr p1) nil) + (equal (qsecond p1) p2)) + (and (consp p2) (eq (qfirst p2) 'null) (consp (qrest p2)) + (eq (qcddr p2) nil) + (equal (qsecond p2) p1))) (setq z (list (cons p1 c1) (cons ''t c2))) (rplacd x z)) (when - (and (consp c1) (eq (qcdr c1) nil) (equal (qcar c1) 'nil) + (and (consp c1) (eq (qrest c1) nil) (equal (qfirst c1) 'nil) (equal p2 ''t) (equal (car c2) ''t)) - (if (and (consp p1) (eq (qcar p1) 'null) (consp (qcdr p1)) - (eq (qcdr (qcdr p1)) nil)) - (setq result (qcar (qcdr p1))) + (if (and (consp p1) (eq (qfirst p1) 'null) (consp (qrest p1)) + (eq (qcddr p1) nil)) + (setq result (qsecond p1)) (setq result (list 'null p1)))))) (if result result (cond - ((and (consp z) (consp (qcar z)) (consp (qcdr z)) (consp (qcar (qcdr z))) - (consp (qcdr (qcdr z))) (eq (qcdr (qcdr (qcdr z))) nil) - (consp (qcar (qcdr (qcdr z)))) - (|TruthP| (qcar (qcar (qcdr (qcdr z)))))) - (setq p1 (qcar (qcar z))) - (setq c1 (qcdr (qcar z))) - (setq p2 (qcar (qcar (qcdr z)))) - (setq c2 (qcdr (qcar (qcdr z)))) - (setq c3 (qcdr (qcar (qcdr (qcdr z))))) + ((and (consp z) (consp (qfirst z)) (consp (qrest z)) (consp (qsecond z)) + (consp (qcddr z)) (eq (qcdddr z) nil) + (consp (qthird z)) + (|TruthP| (qcaaddr z))) + (setq p1 (qcaar z)) + (setq c1 (qcdar z)) + (setq p2 (qcaadr z)) + (setq c2 (qcdadr z)) + (setq c3 (qcdaddr z)) (cond ((|EqualBarGensym| c1 c3) (list 'cond @@ -9726,16 +9726,16 @@ optPackageCall. (do ((y z (cdr y))) ((atom y) nil) (do () - ((null (and (consp y) (consp (qcar y)) (consp (qcdr (qcar y))) - (eq (qcdr (qcdr (qcar y))) nil) (consp (qcdr y)) - (consp (qcar (qcdr y))) (consp (qcdr (qcar (qcdr y)))) - (eq (qcdr (qcdr (qcar (qcdr y)))) nil) - (|EqualBarGensym| (qcar (qcdr (qcar y))) - (qcar (qcdr (qcar (qcdr y))))))) + ((null (and (consp y) (consp (qfirst y)) (consp (qcdar y)) + (eq (qcddar y) nil) (consp (qrest y)) + (consp (qsecond y)) (consp (qcdadr y)) + (eq (qcddadr y) nil) + (|EqualBarGensym| (qcadar y) + (qcadadr y)))) nil) - (setq a (list 'or (qcar (qcar y)) (qcar (qcar (qcdr y))))) + (setq a (list 'or (qcaar y) (qcaadr y))) (rplac (car (car y)) a) - (rplac (cdr y) (qcdr (qcdr y))))) + (rplac (cdr y) (qcddr y)))) x))))) \end{chunk} @@ -9758,8 +9758,8 @@ optPackageCall. (progn (setq |$GensymAssoc| (cons (cons x y) |$GensymAssoc|)) t))) - ((null x) (and (consp y) (eq (qcdr y) nil) (gensymp (qcar y)))) - ((null y) (and (consp x) (eq (qcdr x) nil) (gensymp (qcar x)))) + ((null x) (and (consp y) (eq (qrest y) nil) (gensymp (qfirst y)))) + ((null y) (and (consp x) (eq (qrest x) nil) (gensymp (qfirst x)))) ((or (atom x) (atom y)) nil) (t (and (fn (car x) (car y)) @@ -9785,7 +9785,7 @@ optPackageCall. (let (u) (setq u (cdr arg)) (cond - ((and (consp u) (eq (qcdr u) nil)) (list 'list (qcar u))) + ((and (consp u) (eq (qrest u) nil)) (list 'list (qfirst u))) ((eql (|#| u) 2) (cons 'cons u)) (t (cons 'vector u))))) @@ -9908,8 +9908,8 @@ optPackageCall. ((|domainMember| domain (|getDomainsInScope| env)) env) ((and (progn (setq tmp1 (|getmode| name env)) - (and (consp tmp1) (eq (qcar tmp1) '|Mapping|) - (consp (qcdr tmp1)))) + (and (consp tmp1) (eq (qfirst tmp1) '|Mapping|) + (consp (qrest tmp1)))) (|isCategoryForm| (second tmp1) env)) (|addNewDomain| domain env)) ((or (|isFunctor| name) (|constructor?| name)) @@ -9929,7 +9929,7 @@ optPackageCall. (defun |unknownTypeError| (name) (let (op) (setq name - (if (and (consp name) (setq op (qcar name))) + (if (and (consp name) (setq op (qfirst name))) op name)) (|stackSemanticError| (list '|%b| name '|%d| '|is not a known type|) nil))) @@ -10063,8 +10063,8 @@ The way XLAMs work: (setq env (|addNewDomain| (car u) env))) (when (setq innerDom (|listOrVectorElementMode| name)) (setq env (|addDomain| innerDom env))) - (when (and (consp name) (eq (qcar name) '|Union|)) - (dolist (d (|stripUnionTags| (qcdr name))) + (when (and (consp name) (eq (qfirst name) '|Union|)) + (dolist (d (|stripUnionTags| (qrest name))) (setq env (|addDomain| d env)))) (|augModemapsFromDomain1| name functorForm env))))) @@ -10139,10 +10139,10 @@ The way XLAMs work: (setq op (first item)) (setq sig (second item)) (setq opcode (third item)) - (when (and (consp opcode) (consp (qcdr opcode)) - (consp (qcdr (qcdr opcode))) - (eq (qcdr (qcdr (qcdr opcode))) nil) - (eq (qcar opcode) 'elt)) + (when (and (consp opcode) (consp (qrest opcode)) + (consp (qcddr opcode)) + (eq (qcdddr opcode) nil) + (eq (qfirst opcode) 'elt)) (setq nsig (msubst '$$$ name sig)) (setq nsig (msubst '$ '$$$ (msubst '$$ '$ nsig))) (setq opcode (list (first opcode) (second opcode) nsig))) @@ -10200,8 +10200,8 @@ The way XLAMs work: (defun |getModemapList| (op numOfArgs env) (let (result) (cond - ((and (consp op) (eq (qcar op) '|elt|) (consp (qcdr op)) - (consp (qcdr (qcdr op))) (eq (qcdr (qcdr (qcdr op))) nil)) + ((and (consp op) (eq (qfirst op) '|elt|) (consp (qrest op)) + (consp (qcddr op)) (eq (qcdddr op) nil)) (|getModemapListFromDomain| (third op) numOfArgs (second op) env)) (t (dolist (term (|get| op '|modemap| env) (nreverse0 result)) @@ -10270,8 +10270,8 @@ add flag identifiers as literals in the environment (cond ((and (eq op '|elt|) (consp sig)) (setq tmp1 (reverse sig)) - (setq sel (qcar tmp1)) - (setq lt (nreverse (qcdr tmp1))) + (setq sel (qfirst tmp1)) + (setq lt (nreverse (qrest tmp1))) (cond ((stringp sel) (setq id (intern sel)) @@ -10282,9 +10282,9 @@ add flag identifiers as literals in the environment (t (|addModemap1| op mc sig pred fn env)))) ((and (eq op '|setelt|) (consp sig)) (setq tmp1 (reverse sig)) - (setq v (qcar tmp1)) - (setq sel (qcar (qcdr tmp1))) - (setq lt (nreverse (qcdr (qcdr tmp1)))) + (setq v (qfirst tmp1)) + (setq sel (qsecond tmp1)) + (setq lt (nreverse (qcddr tmp1))) (cond ((stringp sel) (setq id (intern sel)) (if |$insideCapsuleFunctionIfTrue| @@ -10316,12 +10316,12 @@ add flag identifiers as literals in the environment (cond ((|member| entry curModemapList) curModemapList) ((and (setq oldMap (|assoc| map curModemapList)) - (consp oldMap) (consp (qcdr oldMap)) - (consp (qcar (qcdr oldMap))) - (consp (qcdr (qcar (qcdr oldMap)))) - (eq (qcdr (qcdr (qcar (qcdr oldMap)))) nil) - (equal (qcar (qcdr (qcar (qcdr oldMap)))) fn)) - (setq opred (qcar (qcar (qcdr oldMap)))) + (consp oldMap) (consp (qrest oldMap)) + (consp (qsecond oldMap)) + (consp (qcdadr oldMap)) + (eq (qcddadr oldMap) nil) + (equal (qcadadr oldMap) fn)) + (setq opred (qcaadr oldMap)) (cond (|$forceAdd| (|mergeModemap| entry curModemapList env)) ((eq opred t) curModemapList) @@ -10406,7 +10406,7 @@ add flag identifiers as literals in the environment (cond ((null x) nil) ((eq x t) t) - ((and (consp x) (eq (qcar x) 'quote)) t) + ((and (consp x) (eq (qfirst x) 'quote)) t) (t nil))) \end{chunk} @@ -10530,8 +10530,8 @@ add flag identifiers as literals in the environment (redefined (opname u) (let (op z result) (when (consp u) - (setq op (qcar u)) - (setq z (qcdr u)) + (setq op (qfirst u)) + (setq z (qrest u)) (cond ((eq op 'def) (equal opname (caar z))) ((member op '(progn seq)) (redefinedList opname z)) @@ -10619,7 +10619,7 @@ add flag identifiers as literals in the environment (declare (special |$functorForm|)) (cond ((and (consp |$functorForm|) - (eq (qcar |$functorForm|) '|CategoryDefaults|) + (eq (qfirst |$functorForm|) '|CategoryDefaults|) (eq mc '$)) env) ((or (eq op '|elt|) (eq op '|setelt|)) @@ -10714,7 +10714,7 @@ in the body of the add. (cond ((eq |$bootStrapMode| t) (cond - ((and (consp |$addForm|) (eq (qcar |$addForm|) '|@Tuple|)) + ((and (consp |$addForm|) (eq (qfirst |$addForm|) '|@Tuple|)) (setq code nil)) (t (setq tmp3 (|comp| |$addForm| mode env)) @@ -10733,9 +10733,9 @@ in the body of the add. (t (setq |$addFormLhs| |$addForm|) (cond - ((and (consp |$addForm|) (eq (qcar |$addForm|) '|SubDomain|) - (consp (qcdr |$addForm|)) (consp (qcdr (qcdr |$addForm|))) - (eq (qcdr (qcdr (qcdr |$addForm|))) nil)) + ((and (consp |$addForm|) (eq (qfirst |$addForm|) '|SubDomain|) + (consp (qrest |$addForm|)) (consp (qcddr |$addForm|)) + (eq (qcdddr |$addForm|) nil)) (setq domainForm (second |$addForm|)) (setq predicate (third |$addForm|)) (setq |$packagesUsed| (cons domainForm |$packagesUsed|)) @@ -10748,13 +10748,13 @@ in the body of the add. (setq env (third tmp3)) tmp3) (t (setq |$packagesUsed| - (if (and (consp |$addForm|) (eq (qcar |$addForm|) '|@Tuple|)) - (append (qcdr |$addForm|) |$packagesUsed|) + (if (and (consp |$addForm|) (eq (qfirst |$addForm|) '|@Tuple|)) + (append (qrest |$addForm|) |$packagesUsed|) (cons |$addForm| |$packagesUsed|))) (setq |$NRTaddForm| |$addForm|) (setq tmp3 (cond - ((and (consp |$addForm|) (eq (qcar |$addForm|) '|@Tuple|)) + ((and (consp |$addForm|) (eq (qfirst |$addForm|) '|@Tuple|)) (setq |$NRTaddForm| (cons '|@Tuple| (dolist (x (cdr |$addForm|) (nreverse0 tmp4)) @@ -10846,8 +10846,8 @@ in the body of the add. \begin{chunk}{defun processFunctor} (defun |processFunctor| (form signature data localParList e) (cond - ((and (consp form) (eq (qcdr form) nil) - (eq (qcar form) '|CategoryDefaults|)) + ((and (consp form) (eq (qrest form) nil) + (eq (qfirst form) '|CategoryDefaults|)) (|error| '|CategoryDefaults is a reserved name|)) (t (|buildFunctor| form signature data localParList e)))) @@ -10959,16 +10959,16 @@ Since we can't be sure we take the least disruptive course of action. |$functorLocalParameters| |$NonMentionableDomainNames|)) (setq $genno 0) (cond - ((and (consp item) (eq (qcar item) 'seq) (consp (qcdr item)) - (progn (setq tmp6 (reverse (qcdr item))) t) - (consp tmp6) (consp (qcar tmp6)) - (eq (qcar (qcar tmp6)) '|exit|) - (consp (qcdr (qcar tmp6))) - (equal (qcar (qcdr (qcar tmp6))) 1) - (consp (qcdr (qcdr (qcar tmp6)))) - (eq (qcdr (qcdr (qcdr (qcar tmp6)))) nil)) - (setq x (qcar (qcdr (qcdr (qcar tmp6))))) - (setq z (qcdr tmp6)) + ((and (consp item) (eq (qfirst item) 'seq) (consp (qrest item)) + (progn (setq tmp6 (reverse (qrest item))) t) + (consp tmp6) (consp (qfirst tmp6)) + (eq (qcaar tmp6) '|exit|) + (consp (qcdar tmp6)) + (equal (qcadar tmp6) 1) + (consp (qcddar tmp6)) + (eq (qcdddar tmp6) nil)) + (setq x (qcaddar tmp6)) + (setq z (qrest tmp6)) (setq z (nreverse z)) (rplaca item 'progn) (rplaca (lastnode item) x) @@ -10980,35 +10980,35 @@ Since we can't be sure we take the least disruptive course of action. (rplaca item (car u)) (rplacd item (cdr u)) (|doIt| item |$predl|)) - ((and (consp item) (eq (qcar item) 'let) (consp (qcdr item)) - (consp (qcdr (qcdr item)))) - (setq lhs (qcar (qcdr item))) - (setq rhs (qcar (qcdr (qcdr item)))) + ((and (consp item) (eq (qfirst item) 'let) (consp (qrest item)) + (consp (qcddr item))) + (setq lhs (qsecond item)) + (setq rhs (qthird item)) (cond ((null (progn (setq tmp2 (|compOrCroak| item |$EmptyMode| |$e|)) (and (consp tmp2) (progn - (setq code (qcar tmp2)) - (and (consp (qcdr tmp2)) + (setq code (qfirst tmp2)) + (and (consp (qrest tmp2)) (progn - (and (consp (qcdr (qcdr tmp2))) - (eq (qcdr (qcdr (qcdr tmp2))) nil) + (and (consp (qcddr tmp2)) + (eq (qcdddr tmp2) nil) (PROGN - (setq |$e| (qcar (qcdr (qcdr tmp2)))) + (setq |$e| (qthird tmp2)) t)))))))) (|stackSemanticError| (cons '|cannot compile assigned value to| (|bright| lhs)) nil)) - ((null (and (consp code) (eq (qcar code) 'let) + ((null (and (consp code) (eq (qfirst code) 'let) (progn - (and (consp (qcdr code)) + (and (consp (qrest code)) (progn - (setq lhsp (qcar (qcdr code))) - (and (consp (qcdr (qcdr code))))))) - (atom (qcar (qcdr code))))) + (setq lhsp (qsecond code)) + (and (consp (qcddr code)))))) + (atom (qsecond code)))) (cond - ((and (consp code) (eq (qcar code) 'progn)) + ((and (consp code) (eq (qfirst code) 'progn)) (|stackSemanticError| (list '|multiple assignment | item '| not allowed|) nil)) @@ -11023,15 +11023,15 @@ Since we can't be sure we take the least disruptive course of action. (setq |$functorLocalParameters| (append |$functorLocalParameters| (list lhs))))) (cond - ((and (consp code) (eq (qcar code) 'let) + ((and (consp code) (eq (qfirst code) 'let) (progn - (setq tmp2 (qcdr code)) + (setq tmp2 (qrest code)) (and (consp tmp2) (progn - (setq tmp6 (qcdr tmp2)) + (setq tmp6 (qrest tmp2)) (and (consp tmp6) (progn - (setq rhsp (qcar tmp6)) + (setq rhsp (qfirst tmp6)) t))))) (|isDomainForm| rhsp |$e|)) (cond @@ -11051,35 +11051,35 @@ Since we can't be sure we take the least disruptive course of action. (sublis |$LocalDomainAlist| (elt (|get| lhs '|value| |$e|) 0))) |$LocalDomainAlist|)))) (cond - ((and (consp code) (eq (qcar code) 'let)) + ((and (consp code) (eq (qfirst code) 'let)) (rplaca item (if |$QuickCode| 'qsetrefv 'setelt)) (setq rhsCode rhsp) (rplacd item (list '$ (|NRTgetLocalIndexClear| lhs) rhsCode))) (t (rplaca item (car code)) (rplacd item (cdr code))))))) - ((and (consp item) (eq (qcar item) '|:|) (consp (qcdr item)) - (consp (qcdr (qcdr item))) (eq (qcdr (qcdr (qcdr item))) nil)) + ((and (consp item) (eq (qfirst item) '|:|) (consp (qrest item)) + (consp (qcddr item)) (eq (qcdddr item) nil)) (setq tmp1 (|compOrCroak| item |$EmptyMode| |$e|)) (setq |$e| (caddr tmp1)) tmp1) - ((and (consp item) (eq (qcar item) '|import|)) - (loop for dom in (qcdr item) + ((and (consp item) (eq (qfirst item) '|import|)) + (loop for dom in (qrest item) do (|sayBrightly| (cons " importing " (|formatUnabbreviated| dom)))) (setq tmp1 (|compOrCroak| item |$EmptyMode| |$e|)) (setq |$e| (caddr tmp1)) (rplaca item 'progn) (rplacd item nil)) - ((and (consp item) (eq (qcar item) 'if)) + ((and (consp item) (eq (qfirst item) 'if)) (|doItIf| item |$predl| |$e|)) - ((and (consp item) (eq (qcar item) '|where|) (consp (qcdr item))) + ((and (consp item) (eq (qfirst item) '|where|) (consp (qrest item))) (|compOrCroak| item |$EmptyMode| |$e|)) - ((and (consp item) (eq (qcar item) 'mdef)) + ((and (consp item) (eq (qfirst item) 'mdef)) (setq tmp1 (|compOrCroak| item |$EmptyMode| |$e|)) (setq |$e| (caddr tmp1)) tmp1) - ((and (consp item) (eq (qcar item) 'def) (consp (qcdr item)) - (consp (qcar (qcdr item)))) - (setq op (qcar (qcar (qcdr item)))) + ((and (consp item) (eq (qfirst item) 'def) (consp (qrest item)) + (consp (qsecond item))) + (setq op (qcaadr item)) (cond ((setq body (|isMacro| item |$e|)) (setq |$e| (|put| op '|macro| body |$e|))) @@ -11138,8 +11138,8 @@ Since we can't be sure we take the least disruptive course of action. (loop for v in |$getDomainCode| do (setq result (or result - (and (consp v) (consp (qcdr v)) - (equal (qcar (qcdr v)) u))))) + (and (consp v) (consp (qrest v)) + (equal (qsecond v) u))))) result)) ; Now we have to add code to compile all the elements of ; functorLocalParameters that were added during the conditional compilation @@ -11183,22 +11183,22 @@ Since we can't be sure we take the least disruptive course of action. (defun |isMacro| (x env) (let (op args signature body) (when - (and (consp x) (eq (qcar x) 'def) (consp (qcdr x)) - (consp (qcar (qcdr x))) (consp (qcdr (qcdr x))) - (consp (qcdr (qcdr (qcdr x)))) - (consp (qcdr (qcdr (qcdr (qcdr x))))) - (eq (qcdr (qcdr (qcdr (qcdr (qcdr x))))) nil)) - (setq op (qcar (qcar (qcdr x)))) - (setq args (qcdr (qcar (qcdr x)))) - (setq signature (qcar (qcdr (qcdr x)))) - (setq body (qcar (qcdr (qcdr (qcdr (qcdr x)))))) + (and (consp x) (eq (qfirst x) 'def) (consp (qrest x)) + (consp (qsecond x)) (consp (qcddr x)) + (consp (qcdddr x)) + (consp (qcddddr x)) + (eq (qrest (qcddddr x)) nil)) + (setq op (qcaadr x)) + (setq args (qcdadr x)) + (setq signature (qthird x)) + (setq body (qfirst (qcddddr x))) (when (and (null (|get| op '|modemap| env)) (null args) (null (|get| op '|mode| env)) (consp signature) - (eq (qcdr signature) nil) - (null (qcar signature))) + (eq (qrest signature) nil) + (null (qfirst signature))) body)))) \end{chunk} @@ -11252,9 +11252,9 @@ An angry JHD - August 15th., 1984 (dolist (modemap (|getModemapList| '|case| 2 ep) (nreverse0 tmp5)) (setq map (first modemap)) (when - (and (consp map) (consp (qcdr map)) (consp (qcdr (qcdr map))) - (consp (qcdr (qcdr (qcdr map)))) - (eq (qcdr (qcdr (qcdr (qcdr map)))) nil) + (and (consp map) (consp (qrest map)) (consp (qcddr map)) + (consp (qcdddr map)) + (eq (qcddddr map) nil) (|modeEqual| (fourth map) mode) (|modeEqual| (third map) mp)) (push (second modemap) tmp5)))) @@ -11339,10 +11339,10 @@ An angry JHD - August 15th., 1984 (equal (setq mode (|resolve| mode (list '|Category|))) (list '|Category|)) (consp form) - (eq (qcar form) 'category) - (consp (qcdr form))) + (eq (qfirst form) 'category) + (consp (qrest form))) (setq domainOrPackage (second form)) - (setq z (qcdr (qcdr form))) + (setq z (qcddr form)) (setq |$sigList| nil) (setq |$atList| nil) (dolist (x z) (|compCategoryItem| x nil)) @@ -11368,30 +11368,30 @@ An angry JHD - August 15th., 1984 (cond ((null x) nil) ; 1. if x is a conditional expression, recurse; otherwise, form the predicate - ((and (consp x) (eq (qcar x) 'cond) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil) - (consp (qcar (qcdr x))) - (consp (qcdr (qcar (qcdr x)))) - (eq (qcdr (qcdr (qcar (qcdr x)))) nil)) - (setq p (qcar (qcar (qcdr x)))) - (setq e (qcar (qcdr (qcar (qcdr x))))) + ((and (consp x) (eq (qfirst x) 'cond) + (consp (qrest x)) (eq (qcddr x) nil) + (consp (qsecond x)) + (consp (qcdadr x)) + (eq (qcddadr x) nil)) + (setq p (qcaadr x)) + (setq e (qcadadr x)) (setq predlp (cons p predl)) (cond - ((and (consp e) (eq (qcar e) 'progn)) - (setq z (qcdr e)) + ((and (consp e) (eq (qfirst e) 'progn)) + (setq z (qrest e)) (dolist (y z) (|compCategoryItem| y predlp))) (t (|compCategoryItem| e predlp)))) - ((and (consp x) (eq (qcar x) 'if) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (consp (qcdr (qcdr (qcdr x)))) - (eq (qcdr (qcdr (qcdr (qcdr x)))) nil)) - (setq a (qcar (qcdr x))) - (setq b (qcar (qcdr (qcdr x)))) - (setq c (qcar (qcdr (qcdr (qcdr x))))) + ((and (consp x) (eq (qfirst x) 'if) (consp (qrest x)) + (consp (qcddr x)) (consp (qcdddr x)) + (eq (qcddddr x) nil)) + (setq a (qsecond x)) + (setq b (qthird x)) + (setq c (qfourth x)) (setq predlp (cons a predl)) (unless (eq b '|noBranch|) (cond - ((and (consp b) (eq (qcar b) 'progn)) - (setq z (qcdr b)) + ((and (consp b) (eq (qfirst b) 'progn)) + (setq z (qrest b)) (dolist (y z) (|compCategoryItem| y predlp))) (t (|compCategoryItem| b predlp)))) (cond @@ -11399,21 +11399,21 @@ An angry JHD - August 15th., 1984 (t (setq predlp (cons (list '|not| a) predl)) (cond - ((and (consp c) (eq (qcar c) 'progn)) - (setq z (qcdr c)) + ((and (consp c) (eq (qfirst c) 'progn)) + (setq z (qrest c)) (dolist (y z) (|compCategoryItem| y predlp))) (t (|compCategoryItem| c predlp)))))) (t (setq pred (if predl (mkpf predl 'and) t)) (cond ; 2. if attribute, push it and return - ((and (consp x) (eq (qcar x) 'attribute) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil)) - (setq y (qcar (qcdr x))) + ((and (consp x) (eq (qfirst x) 'attribute) + (consp (qrest x)) (eq (qcddr x) nil)) + (setq y (qsecond x)) (push (mkq (list y pred)) |$atList|)) ; 3. it may be a list, with PROGN as the CAR, and some information as the CDR - ((and (consp x) (eq (qcar x) 'progn)) - (setq z (qcdr x)) + ((and (consp x) (eq (qfirst x) 'progn)) + (setq z (qrest x)) (dolist (u z) (|compCategoryItem| u predl))) (t ; 4. otherwise, x gives a signature for a single operator name or a list of @@ -11482,8 +11482,8 @@ An angry JHD - August 15th., 1984 (defun |mustInstantiate| (d) (declare (special |$DummyFunctorNames|)) (and (consp d) - (null (or (member (qcar d) |$DummyFunctorNames|) - (getl (qcar d) '|makeFunctionList|))))) + (null (or (member (qfirst d) |$DummyFunctorNames|) + (getl (qfirst d) '|makeFunctionList|))))) \end{chunk} @@ -11552,13 +11552,13 @@ An angry JHD - August 15th., 1984 argt) ((or (|isDomainForm| argt env) (|isCategoryForm| argt env)) argt) - ((and (consp argt) (eq (qcar argt) '|Mapping|) + ((and (consp argt) (eq (qfirst argt) '|Mapping|) (progn - (setq tmp2 (qcdr argt)) + (setq tmp2 (qrest argt)) (and (consp tmp2) (progn - (setq mprime (qcar tmp2)) - (setq r (qcdr tmp2)) + (setq mprime (qfirst tmp2)) + (setq r (qrest tmp2)) t)))) argt) (t @@ -11574,27 +11574,27 @@ An angry JHD - August 15th., 1984 (cond ((and (consp argf) (progn - (setq op (qcar argf)) - (setq argl (qcdr argf)) + (setq op (qfirst argf)) + (setq argl (qrest argf)) t) - (null (and (consp argt) (eq (qcar argt) '|Mapping|)))) + (null (and (consp argt) (eq (qfirst argt) '|Mapping|)))) (setq newTarget (eqsubstlist (take (|#| argl) |$FormalMapVariableList|) (dolist (x argl (nreverse0 g2)) (setq g2 (cons (cond - ((and (consp x) (eq (qcar x) '|:|) + ((and (consp x) (eq (qfirst x) '|:|) (progn - (setq tmp2 (qcdr x)) + (setq tmp2 (qrest x)) (and (consp tmp2) (progn - (setq a (qcar tmp2)) - (setq tmp3 (qcdr tmp2)) + (setq a (qfirst tmp2)) + (setq tmp3 (qrest tmp2)) (and (consp tmp3) - (eq (qcdr tmp3) nil) + (eq (qrest tmp3) nil) (progn - (setq mode (qcar tmp3)) + (setq mode (qfirst tmp3)) t)))))) a) (t x)) @@ -11607,17 +11607,17 @@ An angry JHD - August 15th., 1984 (setq g5 (cons (cond - ((and (consp x) (eq (qcar x) '|:|) + ((and (consp x) (eq (qfirst x) '|:|) (progn - (setq tmp2 (qcdr x)) + (setq tmp2 (qrest x)) (and (consp tmp2) (progn - (setq a (qcar tmp2)) - (setq tmp3 (qcdr tmp2)) + (setq a (qfirst tmp2)) + (setq tmp3 (qrest tmp2)) (and (consp tmp3) - (eq (qcdr tmp3) nil) + (eq (qrest tmp3) nil) (progn - (setq mode (qcar tmp3)) + (setq mode (qfirst tmp3)) t)))))) mode) (t @@ -11632,12 +11632,12 @@ An angry JHD - August 15th., 1984 (setq tmp2 (|makeCategoryForm| argt env)) (and (consp tmp2) (progn - (setq catform (qcar tmp2)) - (setq tmp3 (qcdr tmp2)) + (setq catform (qfirst tmp2)) + (setq tmp3 (qrest tmp2)) (and (consp tmp3) - (eq (qcdr tmp3) nil) + (eq (qrest tmp3) nil) (progn - (setq env (qcar tmp3)) + (setq env (qfirst tmp3)) t)))))) (setq env (|put| argf '|value| (list (|genSomeVariable|) argt |$noEnv|) @@ -11702,7 +11702,7 @@ An angry JHD - August 15th., 1984 (setq env (third yt)) (setq td (cond - ((and (consp my) (eq (qcar my) '|List|) (consp (qcdr my))) + ((and (consp my) (eq (qfirst my) '|List|) (consp (qrest my))) (setq mp (second my)) (when (setq mr (list '|List| (|resolve| mp mx))) (when (setq ytp (|convert| yt mr)) @@ -11710,7 +11710,7 @@ An angry JHD - August 15th., 1984 (setq x (first tmp1)) (setq env (third tmp1)) (cond - ((and (consp (car ytp)) (eq (qcar (car ytp)) 'list)) + ((and (consp (car ytp)) (eq (qfirst (car ytp)) 'list)) (list (cons 'list (cons x (cdr (car ytp)))) mr env)) (t (list (list 'cons x (car ytp)) mr env))))))) @@ -11880,7 +11880,7 @@ An angry JHD - August 15th., 1984 (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|)) + (null (member (qfirst rhs) |$ConstructorNames|)) (setq sig (|getSignatureFromMode| lhs env))) (|compDefine1| (list 'def lhs (cons (car sig) (cdr signature)) specialCases rhs) @@ -12000,8 +12000,8 @@ An angry JHD - August 15th., 1984 (let (tmp1 signature) (declare (special |$FormalMapVariableList|)) (setq tmp1 (|getmode| (|opOf| form) env)) - (when (and (consp tmp1) (eq (qcar tmp1) '|Mapping|)) - (setq signature (qcdr tmp1)) + (when (and (consp tmp1) (eq (qfirst tmp1) '|Mapping|)) + (setq signature (qrest tmp1)) (if (nequal (|#| form) (|#| signature)) (|stackAndThrow| (list '|Wrong number of arguments: | form)) (eqsubstlist (cdr form) @@ -12170,7 +12170,7 @@ An angry JHD - August 15th., 1984 ((and (null (|member| |$op| |$formalArgList|)) (progn (setq tmp2 (|getmode| |$op| e)) - (and (consp tmp2) (eq (qcar tmp2) '|Mapping|)))) + (and (consp tmp2) (eq (qfirst tmp2) '|Mapping|)))) '|local|) (t '|exported|))) ; 6a skip if compiling only certain items but not this one @@ -12229,12 +12229,12 @@ An angry JHD - August 15th., 1984 (isEltArgumentIn (Rlist x) (cond ((atom x) nil) - ((and (consp x) (eq (qcar x) 'elt) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) 'elt) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (or (member (second x) Rlist) (isEltArgumentIn Rlist (cdr x)))) - ((and (consp x) (eq (qcar x) 'qrefelt) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) 'qrefelt) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (or (member (second x) Rlist) (isEltArgumentIn Rlist (cdr x)))) (t @@ -12314,12 +12314,12 @@ An angry JHD - August 15th., 1984 (fn (clist) (let (n untypedCondition typedCondition) (cond - ((and (consp clist) (consp (qcar clist)) (consp (qcdr (qcar clist))) - (consp (qcdr (qcdr (qcar clist)))) - (eq (qcdr (qcdr (qcdr (qcar clist)))) nil)) - (setq n (qcar (qcar clist))) - (setq untypedCondition (qcar (qcdr (qcar clist)))) - (setq typedCondition (qcar (qcdr (qcdr (qcar clist))))) + ((and (consp clist) (consp (qfirst clist)) (consp (qcdar clist)) + (consp (qcddar clist)) + (eq (qcdddar clist) nil)) + (setq n (qcaar clist)) + (setq untypedCondition (qcadar clist)) + (setq typedCondition (qcaddar clist)) (list 'cond (list typedCondition (fn (cdr clist))) (list |$true| @@ -12374,8 +12374,8 @@ An angry JHD - August 15th., 1984 do (incf i) collect (cond - ((and (consp x) (eq (qcar x) '|SubDomain|) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) '|SubDomain|) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (cond ((setq pair (|assoc| i |$argumentConditionList|)) (rplac (cadr pair) (mkpf (list (third x) (cadr pair)) 'and)) @@ -12402,8 +12402,8 @@ An angry JHD - August 15th., 1984 do (incf i) collect (cond - ((and (consp x) (eq (qcar x) '|\||) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) '|\||) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (setq condition (msubst '|#1| (second x) (third x))) (setq |$argumentConditionList| (cons (list i (second x) condition) |$argumentConditionList|)) @@ -12448,8 +12448,8 @@ is still more than one complain else return the only signature. (cond ((progn (setq tmp1 (setq u (|getmode| op |$e|))) - (and (consp tmp1) (eq (qcar tmp1) '|Mapping|))) - (qcdr tmp1)) + (and (consp tmp1) (eq (qfirst tmp1) '|Mapping|))) + (qrest tmp1)) (t (say "************* USER ERROR **********") (say "available signatures for " op ": ") @@ -12591,9 +12591,9 @@ is still more than one complain else return the only signature. (setq anOp (third form)) (setq aDomain (second form)) (cond - ((null (and (consp form) (eq (qcar form) '|elt|) - (consp (qcdr form)) (consp (qcdr (qcdr form))) - (eq (qcdr (qcdr (qcdr form))) nil))) + ((null (and (consp form) (eq (qfirst form) '|elt|) + (consp (qrest form)) (consp (qcddr form)) + (eq (qcdddr form) nil))) (|compForm| form mode env)) ((eq aDomain '|Lisp|) (list (cond @@ -12624,7 +12624,7 @@ is still more than one complain else return the only signature. (setq pred (caadr modemap)) (setq val (cadadr modemap)) (unless (and (nequal (|#| sig) 2) - (null (and (consp val) (eq (qcar val) '|elt|)))) + (null (and (consp val) (eq (qfirst val) '|elt|)))) (setq val (|genDeltaEntry| (cons (|opOf| anOp) modemap))) (|convert| (list (list '|call| val) (second sig) env) mode)))) (t @@ -12723,16 +12723,16 @@ is still more than one complain else return the only signature. (setq a (car tmp1)) (setq a (sublislis formals argl a)) (cond - ((and (consp b) (eq (qcar b) 'attribute) (consp (qcdr b)) - (eq (qcdr (qcdr b)) nil)) - (list '|HasAttribute| a (list 'quote (qcar (qcdr b))))) - ((and (consp b) (eq (qcar b) 'signature) (consp (qcdr b)) - (consp (qcdr (qcdr b))) (EQ (QCDR (qcdr (qcdr b))) NIL)) + ((and (consp b) (eq (qfirst b) 'attribute) (consp (qrest b)) + (eq (qcddr b) nil)) + (list '|HasAttribute| a (list 'quote (qsecond b)))) + ((and (consp b) (eq (qfirst b) 'signature) (consp (qrest b)) + (consp (qcddr b)) (eq (qcdddr b) NIL)) (list '|HasSignature| a (|mkList| - (list (MKQ (qcar (qcdr b))) + (list (MKQ (qsecond b)) (|mkList| - (loop for type in (qcar (qcdr (qcdr b))) + (loop for type in (qthird b) collect (|mkDomainConstructor| type))))))) ((|isDomainForm| b |$EmptyEnvironment|) (list 'equal a b)) @@ -12820,13 +12820,13 @@ is still more than one complain else return the only signature. (findThrow (gs expr level exitCount ValueFlag) (cond ((atom expr) nil) - ((and (consp expr) (eq (qcar expr) 'throw) (consp (qcdr expr)) - (equal (qcar (qcdr expr)) gs) (consp (qcdr (qcdr expr))) - (eq (qcdr (qcdr (qcdr expr))) nil)) + ((and (consp expr) (eq (qfirst expr) 'throw) (consp (qrest expr)) + (equal (qsecond expr) gs) (consp (qcddr expr)) + (eq (qcdddr expr) nil)) t) - ((and (consp expr) (eq (qcar expr) 'seq)) + ((and (consp expr) (eq (qfirst expr) 'seq)) (let (result) - (loop for u in (qcdr expr) + (loop for u in (qrest expr) do (setq result (or result (findThrow gs u (1+ level) exitCount ValueFlag)))) @@ -12844,8 +12844,8 @@ is still more than one complain else return the only signature. ((eq (setq op (car expr)) 'quote) (and ValueFlag (equal level exitCount))) ((eq op '|TAGGEDexit|) (cond - ((and (consp expr) (consp (qcdr expr)) (consp (qcdr (qcdr expr))) - (eq (qcdr (qcdr (qcdr expr))) nil)) + ((and (consp expr) (consp (qrest expr)) (consp (qcddr expr)) + (eq (qcdddr expr) nil)) (|canReturn| (car (third expr)) level (second expr) (equal (second expr) level))))) ((and (equal level exitCount) (null ValueFlag)) @@ -12883,9 +12883,9 @@ is still more than one complain else return the only signature. inner)))) outer)))) ((eq op 'if) - (and (consp expr) (consp (qcdr expr)) (consp (qcdr (qcdr expr))) - (consp (qcdr (qcdr (qcdr expr)))) - (eq (qcdr (qcdr (qcdr (qcdr expr)))) nil)) + (and (consp expr) (consp (qrest expr)) (consp (qcddr expr)) + (consp (qcdddr expr)) + (eq (qcddddr expr) nil)) (cond ((null (|canReturn| (second expr) 0 0 t)) (say "IF statement can not cause consequents to be executed") @@ -12899,8 +12899,8 @@ is still more than one complain else return the only signature. do (setq result (and result (|canReturn| u level exitCount ValueFlag)))) result)) - ((and (consp op) (eq (qcar op) 'xlam) (consp (qcdr op)) - (consp (qcdr (qcdr op))) (eq (qcdr (qcdr (qcdr op))) nil)) + ((and (consp op) (eq (qfirst op) 'xlam) (consp (qrest op)) + (consp (qcddr op)) (eq (qcdddr op) nil)) (let ((result t)) (loop for u in expr do (setq result @@ -12945,16 +12945,16 @@ is still more than one complain else return the only signature. (let (id currentProplist tt newProplist x m) (declare (special |$EmptyMode| |$EmptyEnvironment|)) (cond - ((and (consp a) (eq (qcar a) '|has|) (CONSP (qcdr a)) - (consp (qcdr (qcdr a))) (eq (qcdr (qcdr (qcdr a))) nil)) + ((and (consp a) (eq (qfirst a) '|has|) (CONSP (qrest a)) + (consp (qcddr a)) (eq (qcdddr a) nil)) (if (and (identp (second a)) (|isDomainForm| (third a) |$EmptyEnvironment|)) (|put| (second a) '|specialCase| (third a) env) env)) - ((and (consp a) (eq (qcar a) '|is|) (consp (qcdr a)) - (consp (qcdr (qcdr a))) (eq (qcdr (qcdr (qcdr a))) nil)) - (setq id (qcar (qcdr a))) - (setq m (qcar (qcdr (qcdr a)))) + ((and (consp a) (eq (qfirst a) '|is|) (consp (qrest a)) + (consp (qcddr a)) (eq (qcdddr a) nil)) + (setq id (qsecond a)) + (setq m (qthird a)) (cond ((and (identp id) (|isDomainForm| m |$EmptyEnvironment|)) (setq env (|put| id '|specialCase| m env)) @@ -12967,11 +12967,11 @@ is still more than one complain else return the only signature. (cons m (cdr (|removeEnv| tt))))) (|addBinding| id newProplist env))) (t env))) - ((and (consp a) (eq (qcar a) '|case|) (consp (qcdr a)) - (consp (qcdr (qcdr a))) (eq (qcdr (qcdr (qcdr a))) nil) - (identp (qcar (qcdr a)))) - (setq x (qcar (qcdr a))) - (setq m (qcar (qcdr (qcdr a)))) + ((and (consp a) (eq (qfirst a) '|case|) (consp (qrest a)) + (consp (qcddr a)) (eq (qcdddr a) nil) + (identp (qsecond a))) + (setq x (qsecond a)) + (setq m (qthird a)) (|put| x '|condition| (cons a (|get| x '|condition| env)) env)) (t env)))) @@ -13006,23 +13006,23 @@ is still more than one complain else return the only signature. ((and (identp x) (|isDomainForm| m |$EmptyEnvironment|)) (|put| x '|specialCase| m env)) (t env))) - ((and (consp a) (eq (qcar a) '|case|) (consp (qcdr a)) - (consp (qcdr (qcdr a))) (eq (qcdr (qcdr (qcdr a))) nil) - (identp (qcar (qcdr a)))) - (setq x (qcar (qcdr a))) - (setq m (qcar (qcdr (qcdr a)))) + ((and (consp a) (eq (qfirst a) '|case|) (consp (qrest a)) + (consp (qcddr a)) (eq (qcdddr a) nil) + (identp (qsecond a))) + (setq x (qsecond a)) + (setq m (qthird a)) (setq tmp1 (|get| x '|condition| env)) (cond - ((and tmp1 (consp tmp1) (eq (qcdr tmp1) nil) (consp (qcar tmp1)) - (eq (qcar (qcar tmp1)) 'or) (|member| a (qcdr (qcar tmp1)))) - (setq oldpred (qcdr (qcar tmp1))) + ((and tmp1 (consp tmp1) (eq (qrest tmp1) nil) (consp (qfirst tmp1)) + (eq (qcaar tmp1) 'or) (|member| a (qcdar tmp1))) + (setq oldpred (qcdar tmp1)) (|put| x '|condition| (list (mkpf (|delete| a oldpred) 'or)) env)) (t (setq tmp1 (|getUnionMode| x env)) - (setq zz (|delete| m (qcdr tmp1))) + (setq zz (|delete| m (qrest tmp1))) (loop for u in zz - when (and (consp u) (eq (qcar u) '|:|) - (consp (qcdr u)) (equal (qcar (qcdr u)) m)) + when (and (consp u) (eq (qfirst u) '|:|) + (consp (qrest u)) (equal (qsecond u) m)) do (setq zz (|delete| u zz))) (setq newpred (mkpf (loop for mp in zz collect (list '|case| x mp)) 'or)) @@ -13050,16 +13050,16 @@ is still more than one complain else return the only signature. (defun |isUnionMode| (m env) (let (mp v tmp1) (cond - ((and (consp m) (eq (qcar m) '|Union|)) m) + ((and (consp m) (eq (qfirst m) '|Union|)) m) ((progn (setq tmp1 (setq mp (|getmode| m env))) - (and (consp tmp1) (eq (qcar tmp1) '|Mapping|) - (consp (qcdr tmp1)) (eq (qcdr (qcdr tmp1)) nil) - (consp (qcar (qcdr tmp1))) - (eq (qcar (qcar (qcdr tmp1))) '|UnionCategory|))) + (and (consp tmp1) (eq (qfirst tmp1) '|Mapping|) + (consp (qrest tmp1)) (eq (qcddr tmp1) nil) + (consp (qsecond tmp1)) + (eq (qcaadr tmp1) '|UnionCategory|))) (second mp)) ((setq v (|get| (if (eq m '$) '|Rep| m) '|value| env)) - (when (and (consp (car v)) (eq (qcar (car v)) '|Union|)) (car v)))))) + (when (and (consp (car v)) (eq (qfirst (car v)) '|Union|)) (car v)))))) \end{chunk} @@ -13140,8 +13140,8 @@ is still more than one complain else return the only signature. (cond ((atom y) (when (|isDomainForm| y env) (list y))) - ((and (consp y) (eq (qcar y) 'length) - (consp (qcdr y)) (eq (qcdr (qcdr y)) nil)) + ((and (consp y) (eq (qfirst y) 'length) + (consp (qrest y)) (eq (qcddr y) nil)) (list y (second y))) (t (list y)))) ) (let (argl catList pl tmp3 tmp4 tmp5 body parameters catListp td) @@ -13167,13 +13167,13 @@ is still more than one complain else return the only signature. (setq tmp5 (append tmp5 (getParms y env)))) parameters)) x) - ((and (consp x) (eq (qcar x) '|DomainSubstitutionMacro|) - (consp (qcdr x)) (consp (qcdr (qcdr x))) - (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) '|DomainSubstitutionMacro|) + (consp (qrest x)) (consp (qcddr x)) + (eq (qcdddr x) nil)) (setq pl (second x)) (setq body (third x)) (setq parameters (|union| pl parameters)) body) - ((and (consp x) (eq (qcar x) '|mkCategory|)) + ((and (consp x) (eq (qfirst x) '|mkCategory|)) x) ((and (atom x) (equal (|getmode| x env) |$Category|)) x) @@ -13218,20 +13218,20 @@ is still more than one complain else return the only signature. (setq vl (second form)) (setq body (third form)) (cond - ((and (consp vl) (eq (qcar vl) '|:|) + ((and (consp vl) (eq (qfirst vl) '|:|) (progn - (setq tmp1 (qcdr vl)) + (setq tmp1 (qrest vl)) (and (consp tmp1) (progn - (setq args (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) + (setq args (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) - (eq (qcdr tmp2) nil) + (eq (qrest tmp2) nil) (progn - (setq target (qcar tmp2)) + (setq target (qfirst tmp2)) t)))))) - (when (and (consp args) (eq (qcar args) '|@Tuple|)) - (setq args (qcdr args))) + (when (and (consp args) (eq (qfirst args) '|@Tuple|)) + (setq args (qrest args))) (cond ((listp args) (setq tmp3 (|argsToSig| args)) @@ -13304,13 +13304,13 @@ is still more than one complain else return the only signature. (setq rhs (fifth form)) (setq prhs (cond - ((and (consp rhs) (eq (qcar rhs) 'category)) + ((and (consp rhs) (eq (qfirst rhs) 'category)) (list "-- the constructor category")) - ((and (consp rhs) (eq (qcar rhs) '|Join|)) + ((and (consp rhs) (eq (qfirst rhs) '|Join|)) (list "-- the constructor category")) - ((and (consp rhs) (eq (qcar rhs) 'capsule)) + ((and (consp rhs) (eq (qfirst rhs) 'capsule)) (list "-- the constructor capsule")) - ((and (consp rhs) (eq (qcar rhs) '|add|)) + ((and (consp rhs) (eq (qfirst rhs) '|add|)) (list "-- the constructor capsule")) (t (|formatUnabbreviated| rhs)))) (|sayBrightly| @@ -13695,9 +13695,9 @@ is still more than one complain else return the only signature. (declare (special |$finalEnv|)) (cond ((atom x) nil) - ((and (consp x) (eq (qcar x) 'quote)) nil) - ((and (consp x) (equal (qcar x) opFlag) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) 'quote)) nil) + ((and (consp x) (equal (qfirst x) opFlag) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (|rplac| (caaddr x) (|replaceExitEtc| (caaddr x) tag opFlag opMode)) (cond ((eql (second x) 0) @@ -13710,9 +13710,9 @@ is still more than one complain else return the only signature. (|rplac| (caddr x) (car (|convertOrCroak| (caddr x) opMode)))) (t (|rplac| (cadr x) (1- (cadr x)))))) - ((and (consp x) (consp (qcdr x)) (consp (qcdr (qcdr x))) - (eq (qcdr (qcdr (qcdr x))) nil) - (member (qcar x) '(|TAGGEDreturn| |TAGGEDexit|))) + ((and (consp x) (consp (qrest x)) (consp (qcddr x)) + (eq (qcdddr x) nil) + (member (qfirst x) '(|TAGGEDreturn| |TAGGEDexit|))) (|rplac| (car (caddr x)) (|replaceExitEtc| (car (caddr x)) tag opFlag opMode))) (t @@ -13783,15 +13783,15 @@ is still more than one complain else return the only signature. (declare (special |$EmptyMode|)) (cond ((identp form) (|setqSingle| form val mode env)) - ((and (consp form) (eq (qcar form) '|:|) (consp (qcdr form)) - (consp (qcdr (qcdr form))) (eq (qcdr (qcdr (qcdr form))) nil)) + ((and (consp form) (eq (qfirst form) '|:|) (consp (qrest form)) + (consp (qcddr form)) (eq (qcdddr form) nil)) (setq x (second form)) (setq y (third form)) (setq ep (third (|compMakeDeclaration| form |$EmptyMode| env))) (|compSetq| (list 'let x val) mode ep)) ((consp form) - (setq op (qcar form)) - (setq z (qcdr form)) + (setq op (qfirst form)) + (setq z (qrest form)) (cond ((eq op 'cons) (|setqMultiple| (|uncons| form) val mode env)) ((eq op '|@Tuple|) (|setqMultiple| z val mode env)) @@ -13805,8 +13805,8 @@ is still more than one complain else return the only signature. (defun |uncons| (x) (cond ((atom x) x) - ((and (consp x) (eq (qcar x) 'cons) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) 'cons) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (cons (second x) (|uncons| (third x)))))) \end{chunk} @@ -13836,25 +13836,25 @@ is still more than one complain else return the only signature. (let (tmp1 z) (declare (special |$EmptyMode|)) (cond - ((and (consp tt) (eq (qcar tt) '|Record|) - (progn (setq z (qcdr tt)) t)) + ((and (consp tt) (eq (qfirst tt) '|Record|) + (progn (setq z (qrest tt)) t)) (loop for item in z collect (cons (second item) (third item)))) ((progn (setq tmp1 (|comp| tt |$EmptyMode| env)) - (and (consp tmp1) (CONSP (qcdr tmp1)) (CONSP (qcar (qcdr tmp1))) - (eq (qcar (qcar (qcdr tmp1))) '|RecordCategory|) - (consp (qcdr (qcdr tmp1))) (eq (qcdr (qcdr (qcdr tmp1))) nil))) + (and (consp tmp1) (consp (qrest tmp1)) (consp (qsecond tmp1)) + (eq (qcaadr tmp1) '|RecordCategory|) + (consp (qcddr tmp1)) (eq (qcdddr tmp1) nil))) (loop for item in z collect (cons (second item) (third item)))) (t (|stackMessage| (list '|no multiple assigns to mode: | tt))))))) (let (g m1 tt x mp selectorModePairs tmp2 assignList) (declare (special |$noEnv| |$EmptyMode| |$NoValueMode|)) (cond - ((and (consp val) (eq (qcar val) 'cons) (equal m |$NoValueMode|)) + ((and (consp val) (eq (qfirst val) 'cons) (equal m |$NoValueMode|)) (|setqMultipleExplicit| nameList (|uncons| val) m env)) - ((and (consp val) (eq (qcar val) '|@Tuple|) (equal m |$NoValueMode|)) - (|setqMultipleExplicit| nameList (qcdr val) m env)) + ((and (consp val) (eq (qfirst val) '|@Tuple|) (equal m |$NoValueMode|)) + (|setqMultipleExplicit| nameList (qrest val) m env)) ; 1 create a gensym, %add to local environment, compile and assign rhs (t (setq g (|genVariable|)) @@ -13871,8 +13871,8 @@ is still more than one complain else return the only signature. (setq mp (second tmp2)) (setq env (third tmp2)) (cond - ((and (consp m1) (eq (qcar m1) '|List|) (consp (qcdr m1)) - (eq (qcdr (qcdr m1)) nil)) + ((and (consp m1) (eq (qfirst m1) '|List|) (consp (qrest m1)) + (eq (qcddr m1) nil)) (loop for y in nameList do (setq env (|put| y '|value| (list (|genSomeVariable|) (second m1) |$noEnv|) @@ -14079,8 +14079,8 @@ is still more than one complain else return the only signature. (declare (special |$Expression|)) (cond ((|comp| (list '|::| x |$Expression|) |$Expression| env)) - ((and (consp x) (eq (qcar x) '|construct|)) - (setq argl (qcdr x)) + ((and (consp x) (eq (qfirst x) '|construct|)) + (setq argl (qrest x)) (list (cons 'list (let (result tmp1) (loop for x in argl @@ -14094,7 +14094,7 @@ is still more than one complain else return the only signature. (nreverse0 result))) |$Expression| env)) ((and (setq v (|get| x '|value| env)) - (consp (cadr v)) (eq (qcar (cadr v)) '|Union|)) + (consp (cadr v)) (eq (qfirst (cadr v)) '|Union|)) (list (list '|coerceUn2E| x (cadr v)) |$Expression| env)) (t (list x |$Expression| env))))) @@ -14127,8 +14127,8 @@ is still more than one complain else return the only signature. (or (member (kar d) |$SpecialDomainNames|) (|isFunctor| d) (and (progn (setq tmp1 (|getmode| d env)) - (and (consp tmp1) (eq (qcar tmp1) '|Mapping|) (consp (qcdr tmp1)))) - (|isCategoryForm| (qcar (qcdr tmp1)) env)) + (and (consp tmp1) (eq (qfirst tmp1) '|Mapping|) (consp (qrest tmp1)))) + (|isCategoryForm| (qsecond tmp1) env)) (|isCategoryForm| (|getmode| d env) env) (|isDomainConstructorForm| d env)))) @@ -14146,12 +14146,12 @@ is still more than one complain else return the only signature. (declare (special |$FormalMapVariableList|)) (when (and (consp d) - (setq u (|get| (qcar d) '|value| env)) + (setq u (|get| (qfirst d) '|value| env)) (consp u) - (consp (qcdr u)) - (consp (qcar (qcdr u))) - (eq (qcar (qcar (qcdr u))) '|Mapping|) - (consp (qcdr (qcar (qcdr u))))) + (consp (qrest u)) + (consp (qsecond u)) + (eq (qcaadr u) '|Mapping|) + (consp (qcdadr u))) (|isCategoryForm| (eqsubstlist (rest d) |$FormalMapVariableList| (cadadr u)) env)))) @@ -14481,8 +14481,8 @@ of basic objects may not be the same. (cond ((or (|isSubset| m mp env) (and (eq m '|Rep|) (eq mp '$))) (list x mp env)) - ((and (consp m) (eq (qcar m) '|SubDomain|) - (consp (qcdr m)) (equal (qcar (qcdr m)) mp)) + ((and (consp m) (eq (qfirst m) '|SubDomain|) + (consp (qrest m)) (equal (qsecond m) mp)) (list x mp env)) ((and (setq pred (lassoc (|opOf| mp) (|get| (|opOf| m) '|SubDomain| env))) (integerp x) (|eval| (msubst x '|#1| pred))) @@ -14518,26 +14518,26 @@ of basic objects may not be the same. (and (or (progn (setq tmp1 (|get| mp '|value| |$e|)) (and (consp tmp1) - (progn (setq mpp (qcar tmp1)) t))) + (progn (setq mpp (qfirst tmp1)) t))) (progn (setq tmp1 (|getmode| mp |$e|)) (and (consp tmp1) - (eq (qcar tmp1) '|Mapping|) - (and (consp (qcdr tmp1)) - (eq (qcdr (qcdr tmp1)) nil) - (progn (setq mpp (qcar (qcdr tmp1))) t))))) + (eq (qfirst tmp1) '|Mapping|) + (and (consp (qrest tmp1)) + (eq (qcddr tmp1) nil) + (progn (setq mpp (qsecond tmp1)) t))))) (|modeEqual| mpp m)) (and (or (progn (setq tmp1 (|get| m '|value| |$e|)) (and (consp tmp1) - (progn (setq mpp (qcar tmp1)) t))) + (progn (setq mpp (qfirst tmp1)) t))) (progn (setq tmp1 (|getmode| m |$e|)) (and (consp tmp1) - (eq (qcar tmp1) '|Mapping|) - (and (consp (qcdr tmp1)) - (eq (qcdr (qcdr tmp1)) nil) - (progn (setq mpp (qcar (qcdr tmp1))) t))))) + (eq (qfirst tmp1) '|Mapping|) + (and (consp (qrest tmp1)) + (eq (qcddr tmp1) nil) + (progn (setq mpp (qsecond tmp1)) t))))) (|modeEqual| mpp mp))) (list (car tt) m (third tt))) ((and (stringp (car tt)) (equal (car tt) m)) @@ -14574,15 +14574,15 @@ of basic objects may not be the same. ((setq tp (|autoCoerceByModemap| tt m)) tp) ((and (progn (setq tmp1 (|isUnionMode| mp e)) - (and (consp tmp1) (eq (qcar tmp1) '|Union|) + (and (consp tmp1) (eq (qfirst tmp1) '|Union|) (progn - (setq z (qcdr tmp1)) t))) + (setq z (qrest tmp1)) t))) (setq ta (|hasType| x e)) (|member| ta z) (setq tp (|autoCoerceByModemap| tt ta)) (setq tpp (|coerce| tp m))) tpp) - ((and (consp mp) (eq (qcar mp) '|Record|) (equal m |$Expression|)) + ((and (consp mp) (eq (qfirst mp) '|Record|) (equal m |$Expression|)) (list (list '|coerceRe2E| x (list 'elt (copy mp) 0)) m e)) (t nil)))) @@ -14596,10 +14596,10 @@ of basic objects may not be the same. (fn (x) (cond ((null x) nil) - ((and (consp x) (consp (qcar x)) (eq (qcar (qcar x)) '|case|) - (consp (qcdr (qcar x))) (consp (qcdr (qcdr (qcar x)))) - (eq (qcdr (qcdr (qcdr (qcar x)))) nil)) - (qcar (qcdr (qcdr (qcar x))))) + ((and (consp x) (consp (qfirst x)) (eq (qcaar x) '|case|) + (consp (qcdar x)) (consp (qcddar x)) + (eq (qcdddar x) nil)) + (qcaddar x)) (t (fn (cdr x)))))) (fn (|get| x '|condition| e)))) @@ -14683,11 +14683,11 @@ of basic objects may not be the same. (cond ((setq td (|compCoerce1| newform newmode env)) (|coerce| td mode)) - ((and (consp tmp1) (eq (qcar tmp1) '|Mapping|) - (consp (qcdr tmp1)) (eq (qcdr (qcdr tmp1)) nil) - (consp (qcar (qcdr tmp1))) - (eq (qcar (qcar (qcdr tmp1))) '|UnionCategory|)) - (setq z (qcdr (qcar (qcdr tmp1)))) + ((and (consp tmp1) (eq (qfirst tmp1) '|Mapping|) + (consp (qrest tmp1)) (eq (qcddr tmp1) nil) + (consp (qsecond tmp1)) + (eq (qcaadr tmp1) '|UnionCategory|)) + (setq z (qcdadr tmp1)) (when (setq td (dolist (mode1 z tmp4) @@ -14743,9 +14743,9 @@ of basic objects may not be the same. (setq map (first modemap)) (setq cexpr (second modemap)) when - (and (consp map) (consp (qcdr map)) - (consp (qcdr (qcdr map))) - (eq (qcdr (qcdr (qcdr map))) nil) + (and (consp map) (consp (qrest map)) + (consp (qcddr map)) + (eq (qcdddr map) nil) (or (|modeEqual| (second map) mp) (|isSubset| (second map) mp env)) (or (|modeEqual| (third map) m) (|isSubset| m (third map) env))) collect modemap)) @@ -14778,8 +14778,8 @@ of basic objects may not be the same. (setq map (first modemap)) (setq cexpr (second modemap)) when - (and (consp map) (consp (qcdr map)) (consp (qcdr (qcdr map))) - (eq (qcdr (qcdr (qcdr map))) nil) + (and (consp map) (consp (qrest map)) (consp (qcddr map)) + (eq (qcdddr map) nil) (|modeEqual| (second map) target) (|modeEqual| (third map) source)) collect cexpr)) @@ -14792,18 +14792,18 @@ of basic objects may not be the same. result)) (when fn (cond - ((and (consp source) (eq (qcar source) '|Union|) - (|member| target (qcdr source))) + ((and (consp source) (eq (qfirst source) '|Union|) + (|member| target (qrest source))) (cond ((and (setq y (|get| x '|condition| e)) (let (result) (loop for u in y do (setq result (or result - (and (consp u) (eq (qcar u) '|case|) (consp (qcdr u)) - (consp (qcdr (qcdr u))) - (eq (qcdr (qcdr (qcdr u))) nil) - (equal (qcar (qcdr (qcdr u))) target))))) + (and (consp u) (eq (qfirst u) '|case|) (consp (qrest u)) + (consp (qcddr u)) + (eq (qcdddr u) nil) + (equal (qthird u) target))))) result)) (list (list '|call| fn x) target e)) ((eq x '|$fromCoerceable$|) nil) @@ -14847,15 +14847,15 @@ of basic objects may not be the same. (defun |mkUnion| (a b) (declare (special |$Rep|)) (cond - ((and (eq b '$) (consp |$Rep|) (eq (qcar |$Rep|) '|Union|)) - (qcdr |$Rep|)) - ((and (consp a) (eq (qcar a) '|Union|)) + ((and (eq b '$) (consp |$Rep|) (eq (qfirst |$Rep|) '|Union|)) + (qrest |$Rep|)) + ((and (consp a) (eq (qfirst a) '|Union|)) (cond - ((and (consp b) (eq (qcar b) '|Union|)) - (cons '|Union| (|union| (qcdr a) (qcdr b)))) - (t (cons '|Union| (|union| (list b) (qcdr a)))))) - ((and (consp b) (eq (qcar b) '|Union|)) - (cons '|Union| (|union| (list a) (qcdr b)))) + ((and (consp b) (eq (qfirst b) '|Union|)) + (cons '|Union| (|union| (qrest a) (qrest b)))) + (t (cons '|Union| (|union| (list b) (qrest a)))))) + ((and (consp b) (eq (qfirst b) '|Union|)) + (cons '|Union| (|union| (list a) (qrest b)))) (t (list '|Union| a b)))) \end{chunk} @@ -14868,9 +14868,9 @@ This orders Unions (cond ((or (atom x) (atom y)) (equal x y)) ((nequal (|#| x) (|#| y)) nil) - ((and (consp x) (eq (qcar x) '|Union|) (consp y) (eq (qcar y) '|Union|)) - (setq xl (qcdr x)) - (setq yl (qcdr y)) + ((and (consp x) (eq (qfirst x) '|Union|) (consp y) (eq (qfirst y) '|Union|)) + (setq xl (qrest x)) + (setq yl (qrest y)) (loop for a in xl do (loop for b in yl do (when (|modeEqual| a b) @@ -14898,11 +14898,11 @@ This orders Unions ((atom m1) (when (setq mp (car (|get| m1 '|value| env))) (|modeEqual| mp m))) - ((and (consp m1) (consp m) (equal (qcar m) (qcar m1)) - (equal (|#| (qcdr m1)) (|#| (qcdr m)))) - (setq op (qcar m1)) - (setq z1 (qcdr m1)) - (setq z2 (qcdr m)) + ((and (consp m1) (consp m) (equal (qfirst m) (qfirst m1)) + (equal (|#| (qrest m1)) (|#| (qrest m)))) + (setq op (qfirst m1)) + (setq z1 (qrest m1)) + (setq z2 (qrest m)) (let ((result t)) (loop for xm1 in z1 for xm2 in z2 do (setq result (and result (|modeEqualSubst| xm1 xm2 env)))) @@ -14947,26 +14947,26 @@ This orders Unions (setq x y) (setq u (|postTran| x)) (when - (and (consp u) (eq (qcar u) '|@Tuple|) + (and (consp u) (eq (qfirst u) '|@Tuple|) (progn - (setq tmp1 (qcdr u)) + (setq tmp1 (qrest u)) (and (consp tmp1) (progn (setq tmp2 (reverse tmp1)) t) (consp tmp2) (progn - (setq tmp3 (qcar tmp2)) + (setq tmp3 (qfirst tmp2)) (and (consp tmp3) - (eq (qcar tmp3) '|:|) + (eq (qfirst tmp3) '|:|) (progn - (setq tmp4 (qcdr tmp3)) + (setq tmp4 (qrest tmp3)) (and (consp tmp4) (progn - (setq y (qcar tmp4)) - (setq tmp5 (qcdr tmp4)) + (setq y (qfirst tmp4)) + (setq tmp5 (qrest tmp4)) (and (consp tmp5) - (eq (qcdr tmp5) nil) - (progn (setq tt (qcar tmp5)) t))))))) - (progn (setq l (qcdr tmp2)) t) + (eq (qrest tmp5) nil) + (progn (setq tt (qfirst tmp5)) t))))))) + (progn (setq l (qrest tmp2)) t) (progn (setq l (nreverse l)) t))) (dolist (x l t) (unless (identp x) (return nil)))) (setq u (list '|:| (cons 'listof (append l (list y))) tt))) @@ -14995,18 +14995,18 @@ This orders Unions (cond ((and (atom op) (setq f (getl op '|postTran|))) (funcall f x)) - ((and (consp op) (eq (qcar op) '|elt|) + ((and (consp op) (eq (qfirst op) '|elt|) (progn - (setq tmp1 (qcdr op)) + (setq tmp1 (qrest op)) (and (consp tmp1) (progn - (setq a (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) + (setq a (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) - (eq (qcdr tmp2) nil) - (progn (setq b (qcar tmp2)) t)))))) + (eq (qrest tmp2) nil) + (progn (setq b (qfirst tmp2)) t)))))) (cons (|postTran| op) (cdr (|postTran| (cons b (cdr x)))))) - ((and (consp op) (eq (qcar op) '|Scripts|)) + ((and (consp op) (eq (qfirst op) '|Scripts|)) (|postScriptsForm| op (dolist (y (rest x) tmp3) (setq tmp3 (append tmp3 (|unTuple| (|postTran| y))))))) @@ -15071,21 +15071,21 @@ This orders Unions (defun |postTranScripts| (a) (labels ( (fn (x) - (if (and (consp x) (eq (qcar x) '|@Tuple|)) - (qcdr x) + (if (and (consp x) (eq (qfirst x) '|@Tuple|)) + (qrest x) (list x)))) (let (tmp1 tmp2 tmp3) (cond - ((and (consp a) (eq (qcar a) '|PrefixSC|) + ((and (consp a) (eq (qfirst a) '|PrefixSC|) (progn - (setq tmp1 (qcdr a)) - (and (consp tmp1) (eq (qcdr tmp1) nil)))) - (|postTranScripts| (qcar tmp1))) - ((and (consp a) (eq (qcar a) '|;|)) - (dolist (y (qcdr a) tmp2) + (setq tmp1 (qrest a)) + (and (consp tmp1) (eq (qrest tmp1) nil)))) + (|postTranScripts| (qfirst tmp1))) + ((and (consp a) (eq (qfirst a) '|;|)) + (dolist (y (qrest a) tmp2) (setq tmp2 (append tmp2 (|postTranScripts| y))))) - ((and (consp a) (eq (qcar a) '|,|)) - (dolist (y (qcdr a) tmp3) + ((and (consp a) (eq (qfirst a) '|,|)) + (dolist (y (qrest a) tmp3) (setq tmp3 (append tmp3 (fn (|postTran| y)))))) (t (list (|postTran| a))))))) @@ -15110,10 +15110,10 @@ This orders Unions (defun |postcheck| (x) (cond ((atom x) nil) - ((and (consp x) (eq (qcar x) 'def) (consp (qcdr x))) - (|setDefOp| (qcar (qcdr x))) - (|postcheck| (qcdr (qcdr x)))) - ((and (consp x) (eq (qcar x) 'quote)) nil) + ((and (consp x) (eq (qfirst x) 'def) (consp (qrest x))) + (|setDefOp| (qsecond x)) + (|postcheck| (qcddr x))) + ((and (consp x) (eq (qfirst x) 'quote)) nil) (t (|postcheck| (car x)) (|postcheck| (cdr x))))) \end{chunk} @@ -15163,18 +15163,18 @@ This orders Unions (when (or (getl op '|Led|) (getl op '|Nud|) (eq op 'in)) (exit op)) (setq numOfArgs (cond - ((and (consp arglp) (eq (qcdr arglp) nil) (consp (qcar arglp)) - (eq (qcar (qcar arglp)) '|@Tuple|)) - (|#| (qcdr (qcar arglp)))) + ((and (consp arglp) (eq (qrest arglp) nil) (consp (qfirst arglp)) + (eq (qcaar arglp) '|@Tuple|)) + (|#| (qcdar arglp))) (t 1))) (internl '* (princ-to-string numOfArgs) (pname op)))) (cons opp arglp)) - ((and (consp op) (eq (qcar op) '|Scripts|)) + ((and (consp op) (eq (qfirst op) '|Scripts|)) (append (|postTran| op) (|postTranList| argl))) (t (setq u (|postTranList| u)) (cond - ((and (consp u) (consp (qcar u)) (eq (qcar (qcar u)) '|@Tuple|)) + ((and (consp u) (consp (qfirst u)) (eq (qcaar u) '|@Tuple|)) (|postError| (cons " " (append (|bright| u) @@ -15182,9 +15182,9 @@ This orders Unions " Did you misuse infix dot?")))))) u))) (cond - ((and (consp x) (consp (qcdr x)) (eq (qcdr (qcdr x)) nil) - (consp (qcar (qcdr x))) (eq (qcar (qcar (qcdr x))) '|@Tuple|)) - (cons (car x) (qcdr (qcar (qcdr x))))) + ((and (consp x) (consp (qrest x)) (eq (qcddr x) nil) + (consp (qsecond x)) (eq (qcaadr x) '|@Tuple|)) + (cons (car x) (qcdadr x))) (t x))))) \end{chunk} @@ -15259,7 +15259,7 @@ of the symbol being parsed. The original list read: (defun |postCapsule| (x) (let (op) (cond - ((null (and (consp x) (progn (setq op (qcar x)) t))) + ((null (and (consp x) (progn (setq op (qfirst x)) t))) (|checkWarning| (list "Apparent indentation error following add"))) ((or (integerp op) (eq op '==)) (list 'capsule (|postBlockItem| x))) @@ -15288,21 +15288,21 @@ of the symbol being parsed. The original list read: (let ((tmp1 t) tmp2 y tt z) (setq x (|postTran| x)) (if - (and (consp x) (eq (qcar x) '|@Tuple|) + (and (consp x) (eq (qfirst x) '|@Tuple|) (progn - (and (consp (qcdr x)) - (progn (setq tmp2 (reverse (qcdr x))) t) + (and (consp (qrest x)) + (progn (setq tmp2 (reverse (qrest x))) t) (consp tmp2) (progn - (and (consp (qcar tmp2)) (eq (qcar (qcar tmp2)) '|:|) + (and (consp (qfirst tmp2)) (eq (qcaar tmp2) '|:|) (progn - (and (consp (qcdr (qcar tmp2))) + (and (consp (qcdar tmp2)) (progn - (setq y (qcar (qcdr (qcar tmp2)))) - (and (consp (qcdr (qcdr (qcar tmp2)))) - (eq (qcdr (qcdr (qcdr (qcar tmp2)))) nil) - (progn (setq tt (qcar (qcdr (qcdr (qcar tmp2))))) t))))))) - (progn (setq z (qcdr tmp2)) t) + (setq y (qcadar tmp2)) + (and (consp (qcddar tmp2)) + (eq (qcdddar tmp2) nil) + (progn (setq tt (qcaddar tmp2)) t))))))) + (progn (setq z (qrest tmp2)) t) (progn (setq z (nreverse z)) T))) (do ((tmp6 nil (null tmp1)) (tmp7 z (cdr tmp7)) (x nil)) ((or tmp6 (atom tmp7)) tmp1) @@ -15336,10 +15336,10 @@ of the symbol being parsed. The original list read: (defun |postType| (typ) (let (source target) (cond - ((and (consp typ) (eq (qcar typ) '->) (consp (qcdr typ)) - (consp (qcdr (qcdr typ))) (eq (qcdr (qcdr (qcdr typ))) nil)) - (setq source (qcar (qcdr typ))) - (setq target (qcar (qcdr (qcdr typ)))) + ((and (consp typ) (eq (qfirst typ) '->) (consp (qrest typ)) + (consp (qcddr typ)) (eq (qcdddr typ) nil)) + (setq source (qsecond typ)) + (setq target (qthird typ)) (cond ((eq source '|constant|) (list (list (|postTran| target)) '|constant|)) @@ -15347,9 +15347,9 @@ of the symbol being parsed. The original list read: (list (cons '|Mapping| (cons (|postTran| target) (|unTuple| (|postTran| source)))))))) - ((and (consp typ) (eq (qcar typ) '->) - (consp (qcdr typ)) (eq (qcdr (qcdr typ)) nil)) - (list (list '|Mapping| (|postTran| (qcar (qcdr typ)))))) + ((and (consp typ) (eq (qfirst typ) '->) + (consp (qrest typ)) (eq (qcddr typ) nil)) + (list (list '|Mapping| (|postTran| (qsecond typ))))) (t (list (|postTran| typ)))))) \end{chunk} @@ -15441,21 +15441,21 @@ of the symbol being parsed. The original list read: (defun |postCollect,finish| (op itl y) (let (tmp2 tmp5 newBody) (cond - ((and (consp y) (eq (qcar y) '|:|) - (consp (qcdr y)) (eq (qcdr (qcdr y)) nil)) - (list 'reduce '|append| 0 (cons op (append itl (list (qcar (qcdr y))))))) - ((and (consp y) (eq (qcar y) '|Tuple|)) + ((and (consp y) (eq (qfirst y) '|:|) + (consp (qrest y)) (eq (qcddr y) nil)) + (list 'reduce '|append| 0 (cons op (append itl (list (qsecond y)))))) + ((and (consp y) (eq (qfirst y) '|Tuple|)) (setq newBody (cond - ((dolist (x (qcdr y) tmp2) + ((dolist (x (qrest y) tmp2) (setq tmp2 - (or tmp2 (and (consp x) (eq (qcar x) '|:|) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil))))) - (|postMakeCons| (qcdr y))) - ((dolist (x (qcdr y) tmp5) - (setq tmp5 (or tmp5 (and (consp x) (eq (qcar x) 'segment))))) - (|tuple2List| (qcdr y))) - (t (cons '|construct| (|postTranList| (qcdr y)))))) + (or tmp2 (and (consp x) (eq (qfirst x) '|:|) + (consp (qrest x)) (eq (qcddr x) nil))))) + (|postMakeCons| (qrest y))) + ((dolist (x (qrest y) tmp5) + (setq tmp5 (or tmp5 (and (consp x) (eq (qfirst x) 'segment))))) + (|tuple2List| (qrest y))) + (t (cons '|construct| (|postTranList| (qrest y)))))) (list 'reduce '|append| 0 (cons op (append itl (list newBody))))) (t (cons op (append itl (list y))))))) @@ -15469,10 +15469,10 @@ of the symbol being parsed. The original list read: (let (a b) (cond ((null args) '|nil|) - ((and (consp args) (consp (qcar args)) (eq (qcar (qcar args)) '|:|) - (consp (qcdr (qcar args))) (eq (qcdr (qcdr (qcar args))) nil)) - (setq a (qcar (qcdr (qcar args)))) - (setq b (qcdr args)) + ((and (consp args) (consp (qfirst args)) (eq (qcaar args) '|:|) + (consp (qcdar args)) (eq (qcddar args) nil)) + (setq a (qcadar args)) + (setq b (qrest args)) (if b (list '|append| (|postTran| a) (|postMakeCons| b)) (|postTran| a))) @@ -15500,19 +15500,19 @@ of the symbol being parsed. The original list read: (setq x (car tmp3)) (setq m (nreverse (cdr tmp3))) (cond - ((and (consp x) (consp (qcar x)) (eq (qcar (qcar x)) '|elt|) - (consp (qcdr (qcar x))) (consp (qcdr (qcdr (qcar x)))) - (eq (qcdr (qcdr (qcdr (qcar x)))) nil) - (eq (qcar (qcdr (qcdr (qcar x)))) '|construct|)) + ((and (consp x) (consp (qfirst x)) (eq (qcaar x) '|elt|) + (consp (qcdar x)) (consp (qcddar x)) + (eq (qcdddar x) nil) + (eq (qcaddar x) '|construct|)) (|postCollect| - (cons (list '|elt| (qcar (qcdr (qcar x))) 'collect) - (append m (list (cons '|construct| (qcdr x))))))) + (cons (list '|elt| (qcadar x) 'collect) + (append m (list (cons '|construct| (qrest x))))))) (t (setq itl (|postIteratorList| m)) (setq x - (if (and (consp x) (eq (qcar x) '|construct|) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil)) - (qcar (qcdr x)) + (if (and (consp x) (eq (qfirst x) '|construct|) + (consp (qrest x)) (eq (qcddr x) nil)) + (qsecond x) x)) (|postCollect,finish| constructOp itl (|postTran| x)))))) @@ -15527,18 +15527,18 @@ of the symbol being parsed. The original list read: (let (z p y u a b) (cond ((consp args) - (setq p (|postTran| (qcar args))) - (setq z (qcdr args)) + (setq p (|postTran| (qfirst args))) + (setq z (qrest args)) (cond - ((and (consp p) (eq (qcar p) 'in) (consp (qcdr p)) - (consp (qcdr (qcdr p))) (eq (qcdr (qcdr (qcdr p))) nil)) - (setq y (qcar (qcdr p))) - (setq u (qcar (qcdr (qcdr p)))) + ((and (consp p) (eq (qfirst p) 'in) (consp (qrest p)) + (consp (qcddr p)) (eq (qcdddr p) nil)) + (setq y (qsecond p)) + (setq u (qthird p)) (cond - ((and (consp u) (eq (qcar u) '|\||) (consp (qcdr u)) - (consp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) - (setq a (qcar (qcdr u))) - (setq b (qcar (qcdr (qcdr u)))) + ((and (consp u) (eq (qfirst u) '|\||) (consp (qrest u)) + (consp (qcddr u)) (eq (qcdddr u) nil)) + (setq a (qsecond u)) + (setq b (qthird u)) (cons (list 'in y (|postInSeq| a)) (cons (list '|\|| b) (|postIteratorList| z)))) @@ -15561,11 +15561,11 @@ of the symbol being parsed. The original list read: \begin{chunk}{defun postColon} (defun |postColon| (u) (cond - ((and (consp u) (eq (qcar u) '|:|) - (consp (qcdr u)) (eq (qcdr (qcdr u)) nil)) - (list '|:| (|postTran| (qcar (qcdr u))))) - ((and (consp u) (eq (qcar u) '|:|) (consp (qcdr u)) - (consp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) + ((and (consp u) (eq (qfirst u) '|:|) + (consp (qrest u)) (eq (qcddr u) nil)) + (list '|:| (|postTran| (qsecond u)))) + ((and (consp u) (eq (qfirst u) '|:|) (consp (qrest u)) + (consp (qcddr u)) (eq (qcdddr u) nil)) (cons '|:| (cons (|postTran| (second u)) (|postType| (third u))))))) \end{chunk} @@ -15582,8 +15582,8 @@ of the symbol being parsed. The original list read: \usesdollar{postColonColon}{boot} \begin{chunk}{defun postColonColon} (defun |postColonColon| (u) - (if (and $boot (consp u) (eq (qcar u) '|::|) (consp (qcdr u)) - (consp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil)) + (if (and $boot (consp u) (eq (qfirst u) '|::|) (consp (qrest u)) + (consp (qcddr u)) (eq (qcdddr u) nil)) (intern (princ-to-string (third u)) (second u)) (|postForm| u))) @@ -15619,10 +15619,10 @@ of the symbol being parsed. The original list read: (defun |postFlatten| (x op) (let (a b) (cond - ((and (consp x) (equal (qcar x) op) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) - (setq a (qcar (qcdr x))) - (setq b (qcar (qcdr (qcdr x)))) + ((and (consp x) (equal (qfirst x) op) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) + (setq a (qsecond x)) + (setq b (qthird x)) (append (|postFlatten| a op) (|postFlatten| b op))) (t (list x))))) @@ -15646,29 +15646,29 @@ of the symbol being parsed. The original list read: (defun |postConstruct| (u) (let (b a tmp4 tmp7) (cond - ((and (consp u) (eq (qcar u) '|construct|) - (consp (qcdr u)) (eq (qcdr (qcdr u)) nil)) - (setq b (qcar (qcdr u))) + ((and (consp u) (eq (qfirst u) '|construct|) + (consp (qrest u)) (eq (qcddr u) nil)) + (setq b (qsecond u)) (setq a - (if (and (consp b) (eq (qcar b) '|,|)) + (if (and (consp b) (eq (qfirst b) '|,|)) (|comma2Tuple| b) b)) (cond - ((and (consp a) (eq (qcar a) 'segment) (consp (qcdr a)) - (consp (qcdr (qcdr a))) (eq (qcdr (qcdr (qcdr a))) nil)) + ((and (consp a) (eq (qfirst a) 'segment) (consp (qrest a)) + (consp (qcddr a)) (eq (qcdddr a) nil)) (list '|construct| (|postTranSegment| (second a) (third a)))) - ((and (consp a) (eq (qcar a) '|@Tuple|)) + ((and (consp a) (eq (qfirst a) '|@Tuple|)) (cond - ((dolist (x (qcdr a) tmp4) + ((dolist (x (qrest a) tmp4) (setq tmp4 (or tmp4 - (and (consp x) (eq (qcar x) '|:|) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil))))) - (|postMakeCons| (qcdr a))) - ((dolist (x (qcdr a) tmp7) - (setq tmp7 (or tmp7 (and (consp x) (eq (qcar x) 'segment))))) - (|tuple2List| (qcdr a))) - (t (cons '|construct| (|postTranList| (qcdr a)))))) + (and (consp x) (eq (qfirst x) '|:|) + (consp (qrest x)) (eq (qcddr x) nil))))) + (|postMakeCons| (qrest a))) + ((dolist (x (qrest a) tmp7) + (setq tmp7 (or tmp7 (and (consp x) (eq (qfirst x) 'segment))))) + (|tuple2List| (qrest a))) + (t (cons '|construct| (|postTranList| (qrest a)))))) (t (list '|construct| (|postTran| a))))) (t u)))) @@ -15710,8 +15710,8 @@ of the symbol being parsed. The original list read: (setq defOp (first arg)) (setq lhs (second arg)) (setq rhs (third arg)) - (if (and (consp lhs) (eq (qcar lhs) '|macro|) - (consp (qcdr lhs)) (eq (qcdr (qcdr lhs)) nil)) + (if (and (consp lhs) (eq (qfirst lhs) '|macro|) + (consp (qrest lhs)) (eq (qcddr lhs) nil)) (|postMDef| (list '==> (second lhs) rhs)) (progn (unless $boot (|recordHeaderDocumentation| nil)) @@ -15721,7 +15721,7 @@ of the symbol being parsed. The original list read: (setq |$maxSignatureLineNumber| 0)) (setq lhs (|postTran| lhs)) (setq tmp1 - (if (and (consp lhs) (eq (qcar lhs) '|:|)) (cdr lhs) (list lhs nil))) + (if (and (consp lhs) (eq (qfirst lhs) '|:|)) (cdr lhs) (list lhs nil))) (setq form (first tmp1)) (setq targetType (second tmp1)) (when (and (null |$InteractiveMode|) (atom form)) (setq form (list form))) @@ -15732,8 +15732,8 @@ of the symbol being parsed. The original list read: (setq tmp1 (dolist (x form (nreverse0 tmp4)) (push - (if (and (consp x) (eq (qcar x) '|:|) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + (if (and (consp x) (eq (qfirst x) '|:|) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (second x) x) tmp4))) @@ -15744,8 +15744,8 @@ of the symbol being parsed. The original list read: (unless (atom form) (dolist (x (cdr form) (nreverse0 tmp6)) (push - (when (and (consp x) (eq (qcar x) '|:|) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + (when (and (consp x) (eq (qfirst x) '|:|) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (third x)) tmp6)))) (setq typeList (cons targetType argTypeList)) @@ -15763,14 +15763,14 @@ of the symbol being parsed. The original list read: (let (a b) (cond ((null args) args) - ((and (consp args) (consp (qcar args)) (eq (qcar (qcar args)) '|:|) - (consp (qcdr (qcar args))) (eq (qcdr (qcdr (qcar args))) nil)) - (setq a (qcar (qcdr (qcar args)))) - (setq b (qcdr args)) + ((and (consp args) (consp (qfirst args)) (eq (qcaar args) '|:|) + (consp (qcdar args)) (eq (qcddar args) nil)) + (setq a (qcadar args)) + (setq b (qrest args)) (cond (b (|postError| (list " Argument" a "of indefinite length must be last"))) - ((or (atom a) (and (consp a) (eq (qcar a) 'quote))) + ((or (atom a) (and (consp a) (eq (qfirst a) 'quote))) a) (t (|postError| @@ -15810,10 +15810,10 @@ of the symbol being parsed. The original list read: \begin{chunk}{defun postIf} (defun |postIf| (arg) (let (tmp1) - (if (null (and (consp arg) (eq (qcar arg) '|if|))) + (if (null (and (consp arg) (eq (qfirst arg) '|if|))) arg (cons 'if - (dolist (x (qcdr arg) (nreverse0 tmp1)) + (dolist (x (qrest arg) (nreverse0 tmp1)) (push (if (and (null (setq x (|postTran| x))) (null $boot)) '|noBranch| x) tmp1)))))) @@ -15833,8 +15833,8 @@ of the symbol being parsed. The original list read: \calls{postin}{postInSeq} \begin{chunk}{defun postin} (defun |postin| (arg) - (if (null (and (consp arg) (eq (qcar arg) '|in|) (consp (qcdr arg)) - (consp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil))) + (if (null (and (consp arg) (eq (qfirst arg) '|in|) (consp (qrest arg)) + (consp (qcddr arg)) (eq (qcdddr arg) nil))) (|systemErrorHere| "postin") (list '|in| (|postTran| (second arg)) (|postInSeq| (third arg))))) @@ -15847,11 +15847,11 @@ of the symbol being parsed. The original list read: \begin{chunk}{defun postInSeq} (defun |postInSeq| (seq) (cond - ((and (consp seq) (eq (qcar seq) 'segment) (consp (qcdr seq)) - (consp (qcdr (qcdr seq))) (eq (qcdr (qcdr (qcdr seq))) nil)) + ((and (consp seq) (eq (qfirst seq) 'segment) (consp (qrest seq)) + (consp (qcddr seq)) (eq (qcdddr seq) nil)) (|postTranSegment| (second seq) (third seq))) - ((and (consp seq) (eq (qcar seq) '|@Tuple|)) - (|tuple2List| (qcdr seq))) + ((and (consp seq) (eq (qfirst seq) '|@Tuple|)) + (|tuple2List| (qrest seq))) (t (|postTran| seq)))) \end{chunk} @@ -15869,8 +15869,8 @@ of the symbol being parsed. The original list read: \calls{postIn}{postInSeq} \begin{chunk}{defun postIn} (defun |postIn| (arg) - (if (null (and (consp arg) (eq (qcar arg) 'in) (consp (qcdr arg)) - (consp (qcdr (qcdr arg))) (eq (qcdr (qcdr (qcdr arg))) nil))) + (if (null (and (consp arg) (eq (qfirst arg) 'in) (consp (qrest arg)) + (consp (qcddr arg)) (eq (qcdddr arg) nil))) (|systemErrorHere| "postIn") (list 'in (|postTran| (second arg)) (|postInSeq| (third arg))))) @@ -15891,10 +15891,10 @@ of the symbol being parsed. The original list read: (let (a l al) (setq a (|postTran| (cadr arg))) (setq l (|postTranList| (cddr arg))) - (when (and (consp l) (eq (qcdr l) nil) (consp (qcar l)) - (member (qcar (qcar l)) '(attribute signature))) - (setq l (list (list 'category (qcar l))))) - (setq al (if (and (consp a) (eq (qcar a) '|@Tuple|)) (qcdr a) (list a))) + (when (and (consp l) (eq (qrest l) nil) (consp (qfirst l)) + (member (qcaar l) '(attribute signature))) + (setq l (list (list 'category (qfirst l))))) + (setq al (if (and (consp a) (eq (qfirst a) '|@Tuple|)) (qrest a) (list a))) (cons '|Join| (append al l)))) \end{chunk} @@ -15911,8 +15911,8 @@ of the symbol being parsed. The original list read: \calls{postMapping}{unTuple} \begin{chunk}{defun postMapping} (defun |postMapping| (u) - (if (null (and (consp u) (eq (qcar u) '->) (consp (qcdr u)) - (consp (qcdr (qcdr u))) (eq (qcdr (qcdr (qcdr u))) nil))) + (if (null (and (consp u) (eq (qfirst u) '->) (consp (qrest u)) + (consp (qcddr u)) (eq (qcdddr u) nil))) u (cons '|Mapping| (cons (|postTran| (third u)) @@ -15948,21 +15948,21 @@ of the symbol being parsed. The original list read: (t (setq lhs (|postTran| lhs)) (setq tmp1 - (if (and (consp lhs) (eq (qcar lhs) '|:|)) (cdr lhs) (list lhs nil))) + (if (and (consp lhs) (eq (qfirst lhs) '|:|)) (cdr lhs) (list lhs nil))) (setq form (first tmp1)) (setq targetType (second tmp1)) (setq form (if (atom form) (list form) form)) (setq newLhs (dolist (x form (nreverse0 tmp4)) (push - (if (and (consp x) (eq (qcar x) '|:|) (consp (qcdr x))) (second x) x) + (if (and (consp x) (eq (qfirst x) '|:|) (consp (qrest x))) (second x) x) tmp4))) (setq typeList (cons targetType - (dolist (x (qcdr form) (nreverse0 tmp5)) + (dolist (x (qrest form) (nreverse0 tmp5)) (push - (when (and (consp x) (eq (qcar x) '|:|) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + (when (and (consp x) (eq (qfirst x) '|:|) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (third x)) tmp5)))) (list 'mdef newLhs typeList @@ -16016,7 +16016,7 @@ of the symbol being parsed. The original list read: (let (op expr g) (setq op (second arg)) (setq expr (third arg)) - (if (or |$InteractiveMode| (and (consp expr) (eq (qcar expr) 'collect))) + (if (or |$InteractiveMode| (and (consp expr) (eq (qfirst expr) 'collect))) (list 'reduce op 0 (|postTran| expr)) (|postReduce| (list '|Reduce| op @@ -16086,10 +16086,10 @@ of the symbol being parsed. The original list read: (defun |postFlattenLeft| (x op) (let (a b) (cond - ((and (consp x) (equal (qcar x) op) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) - (setq a (qcar (qcdr x))) - (setq b (qcar (qcdr (qcdr x)))) + ((and (consp x) (equal (qfirst x) op) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) + (setq a (qsecond x)) + (setq b (qthird x)) (append (|postFlattenLeft| a op) (list b))) (t (list x))))) @@ -16111,7 +16111,7 @@ of the symbol being parsed. The original list read: (let (sig sig1 op) (setq op (second arg)) (setq sig (third arg)) - (when (and (consp sig) (eq (qcar sig) '->)) + (when (and (consp sig) (eq (qfirst sig) '->)) (setq sig1 (|postType| sig)) (setq op (|postAtom| (if (stringp op) (setq op (intern op)) op))) (cons 'signature @@ -16122,8 +16122,8 @@ of the symbol being parsed. The original list read: \defun{removeSuperfluousMapping}{removeSuperfluousMapping} \begin{chunk}{defun removeSuperfluousMapping} (defun |removeSuperfluousMapping| (sig1) - (if (and (consp sig1) (consp (qcar sig1)) (eq (qcar (qcar sig1)) '|Mapping|)) - (cons (cdr (qcar sig1)) (qcdr sig1)) + (if (and (consp sig1) (consp (qfirst sig1)) (eq (qcaar sig1) '|Mapping|)) + (cons (cdr (qfirst sig1)) (qrest sig1)) sig1)) \end{chunk} @@ -16134,10 +16134,10 @@ of the symbol being parsed. The original list read: (defun |killColons| (x) (cond ((atom x) x) - ((and (consp x) (eq (qcar x) '|Record|)) x) - ((and (consp x) (eq (qcar x) '|Union|)) x) - ((and (consp x) (eq (qcar x) '|:|) (consp (qcdr x)) - (consp (qcdr (qcdr x))) (eq (qcdr (qcdr (qcdr x))) nil)) + ((and (consp x) (eq (qfirst x) '|Record|)) x) + ((and (consp x) (eq (qfirst x) '|Union|)) x) + ((and (consp x) (eq (qfirst x) '|:|) (consp (qrest x)) + (consp (qcddr x)) (eq (qcdddr x) nil)) (|killColons| (third x))) (t (cons (|killColons| (car x)) (|killColons| (cdr x)))))) @@ -16172,9 +16172,9 @@ of the symbol being parsed. The original list read: \begin{chunk}{defun postTuple} (defun |postTuple| (arg) (cond - ((and (consp arg) (eq (qcdr arg) nil) (eq (qcar arg) '|@Tuple|)) + ((and (consp arg) (eq (qrest arg) nil) (eq (qfirst arg) '|@Tuple|)) arg) - ((and (consp arg) (eq (qcar arg) '|@Tuple|) (consp (qcdr arg))) + ((and (consp arg) (eq (qfirst arg) '|@Tuple|) (consp (qrest arg))) (cons '|@Tuple| (|postTranList| (cdr arg)))))) \end{chunk} @@ -16213,7 +16213,7 @@ of the symbol being parsed. The original list read: (defun |postWhere| (arg) (let (b x) (setq b (third arg)) - (setq x (if (and (consp b) (eq (qcar b) '|Block|)) (qcdr b) (list b))) + (setq x (if (and (consp b) (eq (qfirst b) '|Block|)) (qrest b) (list b))) (cons '|where| (cons (|postTran| (second arg)) (|postTranList| x))))) \end{chunk} @@ -16235,10 +16235,10 @@ of the symbol being parsed. The original list read: (setq |$insidePostCategoryIfTrue| t) (setq a (|postTran| (second arg))) (cond - ((and (consp a) (member (qcar a) '(signature attribute if))) + ((and (consp a) (member (qfirst a) '(signature attribute if))) (list 'category a)) - ((and (consp a) (eq (qcar a) 'progn)) - (cons 'category (qcdr a))) + ((and (consp a) (eq (qfirst a) 'progn)) + (cons 'category (qrest a))) (t a)))) \end{chunk} @@ -16252,9 +16252,9 @@ of the symbol being parsed. The original list read: (defun |setDefOp| (f) (let (tmp1) (declare (special |$defOp| |$topOp|)) - (when (and (consp f) (eq (qcar f) '|:|) - (consp (setq tmp1 (qcdr f)))) - (setq f (qcar tmp1))) + (when (and (consp f) (eq (qfirst f) '|:|) + (consp (setq tmp1 (qrest f)))) + (setq f (qfirst tmp1))) (unless (atom f) (setq f (car f))) (if |$topOp| (setq |$defOp| f) @@ -16304,18 +16304,18 @@ of the symbol being parsed. The original list read: (cond ((and (consp argl) (progn - (setq f (qcar argl)) - (setq tmp1 (qcdr argl)) + (setq f (qfirst argl)) + (setq tmp1 (qrest argl)) (and (consp tmp1) - (eq (qcdr tmp1) nil) + (eq (qrest tmp1) nil) (progn - (setq y (qcar tmp1)) + (setq y (qfirst tmp1)) t)))) (cond ((and (consp y) (progn - (setq opprime (qcar y)) - (setq yprime (qcdr y)) + (setq opprime (qfirst y)) + (setq yprime (qrest y)) t) (eq opprime '!)) (|aplTran1| (cons op (cons op (cons f yprime))))) @@ -16331,8 +16331,8 @@ of the symbol being parsed. The original list read: (setq tmp1 (|hasAplExtension| argl)) (and (consp tmp1) (progn - (setq arglAssoc (qcar tmp1)) - (setq futureArgl (qcdr tmp1)) + (setq arglAssoc (qfirst tmp1)) + (setq futureArgl (qrest tmp1)) t))) (cons '|reshape| (cons @@ -16375,14 +16375,14 @@ of the symbol being parsed. The original list read: (let (tmp2 tmp3 y z g arglAssoc u) (when (dolist (x argl tmp2) - (setq tmp2 (or tmp2 (and (consp x) (eq (qcar x) '!))))) + (setq tmp2 (or tmp2 (and (consp x) (eq (qfirst x) '!))))) (setq u (dolist (x argl (nreverse0 tmp3)) (push - (if (and (consp x) (eq (qcar x) '!) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil)) + (if (and (consp x) (eq (qfirst x) '!) + (consp (qrest x)) (eq (qcddr x) nil)) (progn - (setq y (qcar (qcdr x))) + (setq y (qsecond x)) (setq z (|deepestExpression| y)) (setq arglAssoc (cons (cons (setq g (genvar)) (|aplTran1| z)) arglAssoc)) @@ -16397,9 +16397,9 @@ of the symbol being parsed. The original list read: \calls{deepestExpression}{deepestExpression} \begin{chunk}{defun deepestExpression} (defun |deepestExpression| (x) - (if (and (consp x) (eq (qcar x) '!) - (consp (qcdr x)) (eq (qcdr (qcdr x)) nil)) - (|deepestExpression| (qcar (qcdr x))) + (if (and (consp x) (eq (qfirst x) '!) + (consp (qrest x)) (eq (qcddr x) nil)) + (|deepestExpression| (qsecond x)) x)) \end{chunk} @@ -16411,8 +16411,8 @@ of the symbol being parsed. The original list read: (let (tmp2) (cond ((atom u) (eq u '!)) - ((and (consp u) (equal (qcar u) 'quote) - (consp (qcdr u)) (eq (qcdr (qcdr u)) nil)) + ((and (consp u) (equal (qfirst u) 'quote) + (consp (qrest u)) (eq (qcddr u) nil)) nil) (t (dolist (x u tmp2) @@ -16445,16 +16445,16 @@ of the symbol being parsed. The original list read: (labels ( (fn (a) (let ((tmp1 0)) - (if (and (consp a) (eq (qcar a) '|,|)) - (dolist (x (qcdr a) tmp1) (setq tmp1 (+ tmp1 (fn x)))) + (if (and (consp a) (eq (qfirst a) '|,|)) + (dolist (x (qrest a) tmp1) (setq tmp1 (+ tmp1 (fn x)))) 1)))) (cond - ((and (consp a) (eq (qcar a) '|PrefixSC|) - (consp (qcdr a)) (eq (qcdr (qcdr a)) nil)) - (strconc (princ-to-string 0) (|decodeScripts| (qcar (qcdr a))))) - ((and (consp a) (eq (qcar a) '|;|)) - (apply 'strconc (loop for x in (qcdr a) collect (|decodeScripts| x)))) - ((and (consp a) (eq (qcar a) '|,|)) + ((and (consp a) (eq (qfirst a) '|PrefixSC|) + (consp (qrest a)) (eq (qcddr a) nil)) + (strconc (princ-to-string 0) (|decodeScripts| (qsecond a)))) + ((and (consp a) (eq (qfirst a) '|;|)) + (apply 'strconc (loop for x in (qrest a) collect (|decodeScripts| x)))) + ((and (consp a) (eq (qfirst a) '|,|)) (princ-to-string (fn a))) (t (princ-to-string 1))))) @@ -16527,8 +16527,8 @@ of the symbol being parsed. The original list read: \defun{unTuple}{unTuple} \begin{chunk}{defun unTuple} (defun |unTuple| (x) - (if (and (consp x) (eq (qcar x) '|@Tuple|)) - (qcdr x) + (if (and (consp x) (eq (qfirst x) '|@Tuple|)) + (qrest x) (list x))) \end{chunk} @@ -18857,14 +18857,14 @@ Stack of results of reduced productions. (let (tmp3) (setq x (|parseTran| x)) (cond - ((and (consp x) (eq (qcar x) '|Record|)) + ((and (consp x) (eq (qfirst x) '|Record|)) (cond - ((do ((z nil tmp3) (tmp4 (qcdr x) (cdr tmp4)) (y nil)) + ((do ((z nil tmp3) (tmp4 (qrest x) (cdr tmp4)) (y nil)) ((or z (atom tmp4)) tmp3) (setq y (car tmp4)) (cond - ((null (and (consp y) (eq (qcar y) '|:|) (consp (qcdr y)) - (consp (qcdr (qcdr y))) (eq (qcdr (qcdr (qcdr y))) nil))) + ((null (and (consp y) (eq (qfirst y) '|:|) (consp (qrest y)) + (consp (qcddr y)) (eq (qcdddr y) nil))) (setq tmp3 (or tmp3 y))))) (|postError| (list " Constructor" x "has missing label" ))) (t x))) @@ -19022,26 +19022,26 @@ Stack of results of reduced productions. (let (u p q) (declare (special |$InteractiveMode| $boot)) (when (consp arg) - (setq u (|tuple2List| (qcdr arg))) + (setq u (|tuple2List| (qrest arg))) (cond - ((and (consp (qcar arg)) (eq (qcar (qcar arg)) 'segment) - (consp (qcdr (qcar arg))) - (consp (qcdr (qcdr (qcar arg)))) - (eq (qcdr (qcdr (qcdr (qcar arg)))) nil)) - (setq p (qcar (qcdr (qcar arg)))) - (setq q (qcar (qcdr (qcdr (qcar arg))))) + ((and (consp (qfirst arg)) (eq (qcaar arg) 'segment) + (consp (qcdar arg)) + (consp (qcddar arg)) + (eq (qcdddar arg) nil)) + (setq p (qcadar arg)) + (setq q (qcaddar arg)) (cond ((null u) (list '|construct| (|postTranSegment| p q))) ((and |$InteractiveMode| (null $boot)) (cons '|append| (cons (list '|construct| (|postTranSegment| p q)) - (list (|tuple2List| (qcdr arg)))))) + (list (|tuple2List| (qrest arg)))))) (t (cons '|nconc| (cons (list '|construct| (|postTranSegment| p q)) - (list (|tuple2List| (qcdr arg)))))))) - ((null u) (list '|construct| (|postTran| (qcar arg)))) - (t (list '|cons| (|postTran| (qcar arg)) (|tuple2List| (qcdr arg)))))))) + (list (|tuple2List| (qrest arg)))))))) + ((null u) (list '|construct| (|postTran| (qfirst arg)))) + (t (list '|cons| (|postTran| (qfirst arg)) (|tuple2List| (qrest arg)))))))) \end{chunk} @@ -20495,14 +20495,14 @@ And the {\bf s-process} function which returns a parsed version of the input. (dolist (v (cdr u)) (hput |$envHashTable| (cons (car u) (cons (car v) nil)) t))) (cond - ((or (and (consp form) (eq (qcar form) 'def)) - (and (consp form) (eq (qcar form) '|where|) + ((or (and (consp form) (eq (qfirst form) 'def)) + (and (consp form) (eq (qfirst form) '|where|) (progn - (setq t1 (qcdr form)) + (setq t1 (qrest form)) (and (consp t1) (progn - (setq t2 (qcar t1)) - (and (consp t2) (eq (qcar t2) 'def))))))) + (setq t2 (qfirst t1)) + (and (consp t2) (eq (qfirst t2) 'def))))))) (setq t3 (|compOrCroak| form mode env)) (setq val (car t3)) (setq newmode (second t3)) @@ -20731,13 +20731,13 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq |$e| (|addDomain| mode |$e|)) (setq env |$e|) (cond - ((and (consp mode) (eq (qcar mode) '|Mapping|)) + ((and (consp mode) (eq (qfirst mode) '|Mapping|)) (|compWithMappingMode| form mode env)) - ((and (consp mode) (eq (qcar mode) 'quote) + ((and (consp mode) (eq (qfirst mode) 'quote) (progn - (setq tmp1 (qcdr mode)) - (and (consp tmp1) (eq (qcdr tmp1) nil) - (progn (setq a (qcar tmp1)) t)))) + (setq tmp1 (qrest mode)) + (and (consp tmp1) (eq (qrest tmp1) nil) + (progn (setq a (qfirst tmp1)) t)))) (when (equal form a) (list form mode |$e|))) ((stringp mode) (when (and (atom form) @@ -20750,25 +20750,25 @@ preferred to the underlying representation -- RDJ 9/12/83 ((and (progn (setq tmp1 (|getmode| op env)) (and (consp tmp1) - (eq (qcar tmp1) '|Mapping|) - (progn (setq ml (qcdr tmp1)) t))) + (eq (qfirst tmp1) '|Mapping|) + (progn (setq ml (qrest tmp1)) t))) (setq u (|applyMapping| form mode env ml))) u) - ((and (consp op) (eq (qcar op) 'kappa) + ((and (consp op) (eq (qfirst op) 'kappa) (progn - (setq tmp1 (qcdr op)) + (setq tmp1 (qrest op)) (and (consp tmp1) (progn - (setq sig (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) + (setq sig (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) (progn - (setq varlist (qcar tmp2)) - (setq tmp3 (qcdr tmp2)) + (setq varlist (qfirst tmp2)) + (setq tmp3 (qrest tmp2)) (and (consp tmp3) - (eq (qcdr tmp3) nil) + (eq (qrest tmp3) nil) (progn - (setq body (qcar tmp3)) + (setq body (qfirst tmp3)) t)))))))) (|compApply| sig varlist body (cdr form) mode env)) ((eq op '|:|) (|compColon| form mode env)) @@ -20781,16 +20781,16 @@ preferred to the underlying representation -- RDJ 9/12/83 (cond ((and (consp tt) (progn - (setq xprime (qcar tt)) - (setq tmp1 (qcdr tt)) + (setq xprime (qfirst tt)) + (setq tmp1 (qrest tt)) (and (consp tmp1) (progn - (setq mprime (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) + (setq mprime (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) - (eq (qcdr tmp2) nil) + (eq (qrest tmp2) nil) (progn - (setq eprime (qcar tmp2)) + (setq eprime (qfirst tmp2)) t))))) (null (|member| mprime (|getDomainsInScope| eprime)))) (list xprime mprime (|addDomain| mprime eprime))) @@ -20881,20 +20881,20 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq tmp1 (|modeIsAggregateOf| '|List| mode env)) (and (consp tmp1) (progn - (setq tmp2 (qcdr tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) - (eq (qcdr tmp2) nil) + (eq (qrest tmp2) nil) (progn - (setq r (qcar tmp2)) t))))) + (setq r (qfirst tmp2)) t))))) (|compList| form (list '|List| r) env)) ((progn (setq tmp1 (|modeIsAggregateOf| '|Vector| mode env)) (and (consp tmp1) (progn - (setq tmp2 (qcdr tmp1)) - (and (consp tmp2) (eq (qcdr tmp2) nil) + (setq tmp2 (qrest tmp1)) + (and (consp tmp2) (eq (qrest tmp2) nil) (progn - (setq r (qcar tmp2)) t))))) + (setq r (qfirst tmp2)) t))))) (|compVector| form (list '|Vector| r) env)))) (when td (|convert| td mode))) (t @@ -21087,17 +21087,17 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq env (third tmp2)) (push (car tmp2) tmp4))) mode env)) - ((and (consp op) (eq (qcar op) '|elt|) + ((and (consp op) (eq (qfirst op) '|elt|) (progn - (setq tmp3 (qcdr op)) + (setq tmp3 (qrest op)) (and (consp tmp3) (progn - (setq domain (qcar tmp3)) - (setq tmp1 (qcdr tmp3)) + (setq domain (qfirst tmp3)) + (setq tmp1 (qrest tmp3)) (and (consp tmp1) - (eq (qcdr tmp1) nil) + (eq (qrest tmp1) nil) (progn - (setq opprime (qcar tmp1)) + (setq opprime (qfirst tmp1)) t)))))) (cond ((eq domain '|Lisp|) @@ -21113,7 +21113,7 @@ preferred to the underlying representation -- RDJ 9/12/83 ((and (eq opprime 'collect) (|coerceable| domain mode env)) (when (setq td (|comp| (cons opprime argl) domain env)) (|coerce| td mode))) - ((and (consp domain) (eq (qcar domain) '|Mapping|) + ((and (consp domain) (eq (qfirst domain) '|Mapping|) (setq ans (|compForm2| (cons opprime argl) mode (setq env (|augModemapsFromDomain1| domain domain env)) @@ -21121,7 +21121,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (nreverse0 tmp6)) (when (and (consp x) - (and (consp (qcar x)) (equal (qcar (qcar x)) domain))) + (and (consp (qfirst x)) (equal (qcaar x) domain))) (push x tmp6)))))) ans) ((setq ans @@ -21131,7 +21131,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (nreverse0 tmp5)) (when (and (consp x) - (and (consp (qcar x)) (equal (qcar (qcar x)) domain))) + (and (consp (qfirst x)) (equal (qcaar x) domain))) (push x tmp5))))) ans) ((and (eq opprime '|construct|) (|coerceable| domain mode env)) @@ -21168,12 +21168,12 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq op (car form)) (setq argl (cdr form)) (cond - ((and (consp op) (eq (qcar op) '|elt|) (CONSP (qcdr op)) - (consp (qcdr (qcdr op))) (eq (qcdr (qcdr (qcdr op))) nil)) + ((and (consp op) (eq (qfirst op) '|elt|) (CONSP (qrest op)) + (consp (qcddr op)) (eq (qcdddr op) nil)) (setq op1 (third op)) (setq domain (second op)) (loop for x in (|getFormModemaps| (cons op1 argl) env) - when (and (consp x) (consp (qcar x)) (equal (qcar (qcar x)) domain)) + when (and (consp x) (consp (qfirst x)) (equal (qcaar x) domain)) collect x)) ((null (atom op)) nil) (t @@ -21181,7 +21181,7 @@ preferred to the underlying representation -- RDJ 9/12/83 (when |$insideCategoryPackageIfTrue| (setq modemapList (loop for x in modemapList - when (and (consp x) (consp (qcar x)) (nequal (qcar (qcar x)) '$)) + when (and (consp x) (consp (qfirst x)) (nequal (qcaar x) '$)) collect x))))) (cond ((eq op '|elt|) @@ -21212,9 +21212,9 @@ preferred to the underlying representation -- RDJ 9/12/83 (cond ((setq z (loop for mm in mmList - when (and (consp mm) (consp (qcar mm)) (consp (qcdr (qcar mm))) - (consp (qcdr (qcdr (qcar mm)))) - (consp (qcdr (qcdr (qcdr (qcar mm))))) + when (and (consp mm) (consp (qfirst mm)) (consp (qcdar mm)) + (consp (qcddar mm)) + (consp (qcdddar mm)) (equal (fourth (first mm)) name)) collect mm)) z) @@ -21312,41 +21312,41 @@ preferred to the underlying representation -- RDJ 9/12/83 (cond ((and (consp u) (progn - (setq tmp6 (qcar u)) - (and (consp tmp6) (progn (setq dc (qcar tmp6)) t))) + (setq tmp6 (qfirst u)) + (and (consp tmp6) (progn (setq dc (qfirst tmp6)) t))) (progn - (setq tmp7 (qcdr u)) - (and (consp tmp7) (eq (qcdr tmp7) nil) + (setq tmp7 (qrest u)) + (and (consp tmp7) (eq (qrest tmp7) nil) (progn - (setq tmp1 (qcar tmp7)) + (setq tmp1 (qfirst tmp7)) (and (consp tmp1) (progn - (setq cond (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) - (and (consp tmp2) (eq (qcdr tmp2) nil) + (setq cond (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) + (and (consp tmp2) (eq (qrest tmp2) nil) (progn - (setq tmp3 (qcar tmp2)) - (and (consp tmp3) (eq (qcar tmp3) '|Subsumed|) + (setq tmp3 (qfirst tmp2)) + (and (consp tmp3) (eq (qfirst tmp3) '|Subsumed|) (progn - (setq tmp4 (qcdr tmp3)) + (setq tmp4 (qrest tmp3)) (and (consp tmp4) (progn - (setq tmp5 (qcdr tmp4)) + (setq tmp5 (qrest tmp4)) (and (consp tmp5) - (eq (qcdr tmp5) nil) + (eq (qrest tmp5) nil) (progn - (setq nsig (qcar tmp5)) + (setq nsig (qfirst tmp5)) t))))))))))))) (setq v (|assoc| (cons dc nsig) modemapList)) (consp v) (progn - (setq tmp6 (qcdr v)) - (and (consp tmp6) (eq (qcdr tmp6) nil) + (setq tmp6 (qrest v)) + (and (consp tmp6) (eq (qrest tmp6) nil) (progn - (setq tmp7 (qcar tmp6)) + (setq tmp7 (qfirst tmp6)) (and (consp tmp7) (progn - (setq ncond (qcar tmp7)) + (setq ncond (qfirst tmp7)) t)))))) (setq deleteList (cons u deleteList)) (unless (|PredImplies| ncond cond) @@ -21423,8 +21423,8 @@ preferred to the underlying representation -- RDJ 9/12/83 ((null b) t) ((null (car b)) (|compFormMatch,match| (cdr a) (cdr b))) ((and (equal (car a) (car b)) (ismatch (cdr a) (cdr b))))))) - (and (consp mm) (consp (qcar mm)) (consp (qcdr (qcar mm))) - (ismatch (qcdr (qcdr (qcar mm))) partialModeList)))) + (and (consp mm) (consp (qfirst mm)) (consp (qcdar mm)) + (ismatch (qcddar mm) partialModeList)))) \end{chunk} @@ -21451,14 +21451,14 @@ preferred to the underlying representation -- RDJ 9/12/83 (declare (special |$EmptyMode|)) (setq argl (cdr form)) (cond - ((and (consp form) (eq (qcar form) '|elt|) + ((and (consp form) (eq (qfirst form) '|elt|) (progn - (setq tmp1 (qcdr form)) + (setq tmp1 (qrest form)) (and (consp tmp1) (progn - (setq a (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) - (and (consp tmp2) (eq (qcdr tmp2) nil)))))) + (setq a (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) + (and (consp tmp2) (eq (qrest tmp2) nil)))))) (when (setq tmp3 (|comp| a |$EmptyMode| env)) (setq env (third tmp3)) (|compForm1| form mode env))) @@ -21530,21 +21530,21 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq tmp1 (|get| form '|modemap| |$CategoryFrame|)) (and (consp tmp1) (progn - (setq tmp2 (qcar tmp1)) + (setq tmp2 (qfirst tmp1)) (and (consp tmp2) (progn - (setq tmp3 (qcar tmp2)) + (setq tmp3 (qfirst tmp2)) (and (consp tmp3) (progn - (setq tmp4 (qcdr tmp3)) + (setq tmp4 (qrest tmp3)) (and (consp tmp4) (progn - (setq target (qcar tmp4)) - (setq argModeList (qcdr tmp4)) + (setq target (qfirst tmp4)) + (setq argModeList (qrest tmp4)) t))))) (progn - (setq tmp5 (qcdr tmp2)) - (and (consp tmp5) (eq (qcdr tmp5) nil))))))) + (setq tmp5 (qrest tmp2)) + (and (consp tmp5) (eq (qrest tmp5) nil))))))) (prog (t1) (setq t1 t) (return @@ -21570,27 +21570,27 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq oldstyle t) (cond ((and (consp form) - (eq (qcar form) '+->) + (eq (qfirst form) '+->) (progn - (setq tmp1 (qcdr form)) + (setq tmp1 (qrest form)) (and (consp tmp1) (progn - (setq vl (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) + (setq vl (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) - (eq (qcdr tmp2) nil) - (progn (setq nx (qcar tmp2)) t)))))) + (eq (qrest tmp2) nil) + (progn (setq nx (qfirst tmp2)) t)))))) (setq oldstyle nil) (cond - ((and (consp vl) (eq (qcar vl) '|:|)) + ((and (consp vl) (eq (qfirst vl) '|:|)) (setq ress (|compLambda| form mode oldE)) ress) (t (setq vl (cond ((and (consp vl) - (eq (qcar vl) '|@Tuple|) - (progn (setq vl1 (qcdr vl)) t)) + (eq (qfirst vl) '|@Tuple|) + (progn (setq vl1 (qrest vl)) t)) vl1) (t vl))) (setq vl @@ -21695,9 +21695,9 @@ preferred to the underlying representation -- RDJ 9/12/83 (cond ((and (consp body) (progn - (setq tmp1 (qcar body)) + (setq tmp1 (qfirst body)) (and (consp tmp1) - (eq (qcar tmp1) 'declare)))) + (eq (qfirst tmp1) 'declare)))) (setq body (cons (car body) (cons @@ -21741,17 +21741,17 @@ preferred to the underlying representation -- RDJ 9/12/83 (defun |extractCodeAndConstructTriple| (form mode oldE) (let (tmp1 a fn op env) (cond - ((and (consp form) (eq (qcar form) '|call|) + ((and (consp form) (eq (qfirst form) '|call|) (progn - (setq tmp1 (qcdr form)) + (setq tmp1 (qrest form)) (and (consp tmp1) - (progn (setq fn (qcar tmp1)) t)))) + (progn (setq fn (qfirst tmp1)) t)))) (cond - ((and (consp fn) (eq (qcar fn) '|applyFun|) + ((and (consp fn) (eq (qfirst fn) '|applyFun|) (progn - (setq tmp1 (qcdr fn)) - (and (consp tmp1) (eq (qcdr tmp1) nil) - (progn (setq a (qcar tmp1)) t)))) + (setq tmp1 (qrest fn)) + (and (consp tmp1) (eq (qrest tmp1) nil) + (progn (setq a (qfirst tmp1)) t)))) (setq fn a))) (list fn mode oldE)) (t @@ -21778,17 +21778,17 @@ preferred to the underlying representation -- RDJ 9/12/83 (defun |argsToSig| (args) (let (tmp1 v tmp2 tt sig1 arg1 bad) (cond - ((and (consp args) (eq (qcar args) '|:|) + ((and (consp args) (eq (qfirst args) '|:|) (progn - (setq tmp1 (qcdr args)) + (setq tmp1 (qrest args)) (and (consp tmp1) (progn - (setq v (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) + (setq v (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) (and (consp tmp2) - (eq (qcdr tmp2) nil) + (eq (qrest tmp2) nil) (progn - (setq tt (qcar tmp2)) + (setq tt (qfirst tmp2)) t)))))) (list (list v) (list tt))) (t @@ -21797,16 +21797,16 @@ preferred to the underlying representation -- RDJ 9/12/83 (setq bad nil) (dolist (arg args) (cond - ((and (consp arg) (eq (qcar arg) '|:|) + ((and (consp arg) (eq (qfirst arg) '|:|) (progn - (setq tmp1 (qcdr arg)) + (setq tmp1 (qrest arg)) (and (consp tmp1) (progn - (setq v (qcar tmp1)) - (setq tmp2 (qcdr tmp1)) - (and (consp tmp2) (eq (qcdr tmp2) nil) + (setq v (qfirst tmp1)) + (setq tmp2 (qrest tmp1)) + (and (consp tmp2) (eq (qrest tmp2) nil) (progn - (setq tt (qcar tmp2)) + (setq tt (qfirst tmp2)) t)))))) (setq sig1 (cons tt sig1)) (setq arg1 (cons v arg1))) diff --git a/changelog b/changelog index c755bf5..c8160c3 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +20110923 tpd src/axiom-website/patches.html 20110923.01.tpd.patch +20110923 tpd src/interp/vmlisp.lisp add qfirst, etc +20110923 src/interp/sys-pkg.lisp add qfirst, etc +20110923 tpd books/bookvol9 use qc(ad)r forms +20110923 tpd books/bookvol5 use qc(ad)r forms 20110916 tpd src/axiom-website/patches.html 20110916.01.tpd.patch 20110916 tpd src/interp/vmlisp.lisp remove pairp 20110916 tpd src/interp/topics.lisp remove pairp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 1c0fbea..af764a2 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3622,5 +3622,7 @@ books/bookvol10.3 add StochasticDifferential
books/bookvol10.3 upgrade GOPT
20110916.01.tpd.patch src/interp/vmlisp.lisp remove pairp
+20110923.01.tpd.patch +src/interp/vmlisp.lisp, bookvol5, bookvol9 use qc(ad)r forms diff --git a/src/interp/sys-pkg.lisp.pamphlet b/src/interp/sys-pkg.lisp.pamphlet index f3c1361..4ec4ec6 100644 --- a/src/interp/sys-pkg.lisp.pamphlet +++ b/src/interp/sys-pkg.lisp.pamphlet @@ -370,7 +370,8 @@ provides support for compiler code. VMLISP::$LISTFILE VMLISP::IVECP VMLISP::LIST2VEC VMLISP::|LAM,FILEACTQ| VMLISP::LISTOFQUOTES VMLISP::$ERASE VMLISP::QSDEC1 - VMLISP::QSSUB1 VMLISP::QCAR VMLISP::EVA1FUN VMLISP::IS-CONSOLE + VMLISP::QSSUB1 VMLISP::QCAR VMLISP::QFIRST + VMLISP::EVA1FUN VMLISP::IS-CONSOLE VMLISP::MAKESTRING VMLISP::CUROUTSTREAM VMLISP::QCDDDR VMLISP::QCDADAR VMLISP::MAKE-ABSOLUTE-FILENAME VMLISP::SUFFIX VMLISP::FUNARGP VMLISP::VM/ VMLISP::QRPLACA VMLISP::GGREATERP @@ -436,7 +437,7 @@ provides support for compiler code. VMLISP::QCAAR VMLISP::HCOUNT VMLISP::RCOPYITEMS VMLISP::QSMINUS VMLISP::EVA1 VMLISP::OPTIONLIST VMLISP::NUM2CHAR VMLISP::QENUM VMLISP::QEQQ - VMLISP::$TOTAL-GC-TIME VMLISP::CHARP VMLISP::QCADR + VMLISP::$TOTAL-GC-TIME VMLISP::CHARP VMLISP::QCADR VMLISP::QSECOND VMLISP::INTERSECTIONQ VMLISP::DSETQ VMLISP::FETCHCHAR VMLISP::STRCONC VMLISP::MACRO-MISSINGARGS VMLISP::RPACKFILE VMLISP::EXIT VMLISP::PLUS VMLISP::RKEYIDS @@ -625,15 +626,19 @@ provides support for compiler code. (lisp:import '(vmlisp::printexp)) (lisp:import '(vmlisp::qassq)) (lisp:import '(vmlisp::qcar)) +(lisp:import '(vmlisp::qfirst)) (lisp:import '(vmlisp::qcdr)) +(lisp:import '(vmlisp::qrest)) (lisp:import '(vmlisp::qcaar)) (lisp:import '(vmlisp::qcadr)) +(lisp:import '(vmlisp::qsecond)) (lisp:import '(vmlisp::qcdar)) (lisp:import '(vmlisp::qcddr)) (lisp:import '(vmlisp::qcaaar)) (lisp:import '(vmlisp::qcaadr)) (lisp:import '(vmlisp::qcadar)) (lisp:import '(vmlisp::qcaddr)) +(lisp:import '(vmlisp::qthird)) (lisp:import '(vmlisp::qcdaar)) (lisp:import '(vmlisp::qcdadr)) (lisp:import '(vmlisp::qcddar)) @@ -646,6 +651,7 @@ provides support for compiler code. (lisp:import '(vmlisp::qcadadr)) (lisp:import '(vmlisp::qcaddar)) (lisp:import '(vmlisp::qcadddr)) +(lisp:import '(vmlisp::qfourth)) (lisp:import '(vmlisp::qcdaaar)) (lisp:import '(vmlisp::qcdaadr)) (lisp:import '(vmlisp::qcdadar)) diff --git a/src/interp/vmlisp.lisp.pamphlet b/src/interp/vmlisp.lisp.pamphlet index 9b7f4f8..fe6123e 100644 --- a/src/interp/vmlisp.lisp.pamphlet +++ b/src/interp/vmlisp.lisp.pamphlet @@ -189,9 +189,14 @@ documentclass{article} (defmacro qcar (x) `(car (the cons ,x))) +(defmacro qfirst (x) + `(car (the cons ,x))) + (defmacro qcdr (x) `(cdr (the cons ,x))) +(defmacro qrest (x) + `(cdr (the cons ,x))) (defmacro qcaar (x) `(car (the cons (car (the cons ,x))))) @@ -199,6 +204,9 @@ documentclass{article} (defmacro qcadr (x) `(car (the cons (cdr (the cons ,x))))) +(defmacro qsecond (x) + `(car (the cons (cdr (the cons ,x))))) + (defmacro qcdar (x) `(cdr (the cons (car (the cons ,x))))) @@ -213,6 +221,8 @@ documentclass{article} `(car (the cons (cdr (the cons (car (the cons ,x))))))) (defmacro qcaddr (x) `(car (the cons (cdr (the cons (cdr (the cons ,x))))))) +(defmacro qthird (x) + `(car (the cons (cdr (the cons (cdr (the cons ,x))))))) (defmacro qcdaar (x) `(cdr (the cons (car (the cons (car (the cons ,x))))))) (defmacro qcdadr (x) @@ -238,6 +248,8 @@ documentclass{article} `(car (the cons (cdr (the cons (cdr (the cons (car (the cons ,x))))))))) (defmacro qcadddr (x) `(car (the cons (cdr (the cons (cdr (the cons (cdr (the cons ,x))))))))) +(defmacro qfourth (x) + `(car (the cons (cdr (the cons (cdr (the cons (cdr (the cons ,x))))))))) (defmacro qcdaaar (x) `(cdr (the cons (car (the cons (car (the cons (car (the cons ,x))))))))) (defmacro qcdaadr (x)