From 327b4fb2c149c02dd72f3d8f6070b6e0144828ee Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 2 Sep 2009 06:13:00 +0000 Subject: * boot/ast.boot: More cleanup. * boot/includer.boot: Likewise. * boot/parser.boot: Likewise. * boot/scanner.boot: Likewise. --- src/boot/strap/ast.clisp | 94 +++++++++++++++++++++++++---------------- src/boot/strap/includer.clisp | 10 ++--- src/boot/strap/parser.clisp | 52 +++++++++++++---------- src/boot/strap/pile.clisp | 2 +- src/boot/strap/translator.clisp | 3 +- 5 files changed, 96 insertions(+), 65 deletions(-) (limited to 'src/boot/strap') diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 64b6779a..79e71325 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -226,12 +226,12 @@ (COND ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|)) ((ATOM |x|) |x|) - ((EQCAR |x| 'QUOTE) |x|) + ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) |x|) ('T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|)))))) (DEFUN |bfTuple| (|x|) (CONS 'TUPLE |x|)) -(DEFUN |bfTupleP| (|x|) (EQCAR |x| 'TUPLE)) +(DEFUN |bfTupleP| (|x|) (AND (CONSP |x|) (EQ (CAR |x|) 'TUPLE))) (DEFUN |bfUntuple| (|bf|) (COND ((|bfTupleP| |bf|) (CDR |bf|)) ('T |bf|))) @@ -292,8 +292,10 @@ (DEFUN |bfFor| (|bflhs| U |step|) (COND - ((EQCAR U '|tails|) (|bfForTree| 'ON |bflhs| (CADR U))) - ((EQCAR U 'SEGMENT) (|bfSTEP| |bflhs| (CADR U) |step| (CADDR U))) + ((AND (CONSP U) (EQ (CAR U) '|tails|)) + (|bfForTree| 'ON |bflhs| (CADR U))) + ((AND (CONSP U) (EQ (CAR U) 'SEGMENT)) + (|bfSTEP| |bflhs| (CADR U) |step| (CADDR U))) ('T (|bfForTree| 'IN |bflhs| U)))) (DEFUN |bfForTree| (OP |lhs| |whole|) @@ -310,7 +312,8 @@ (SETQ |lhs| (COND ((|bfTupleP| |lhs|) (CADR |lhs|)) (#0# |lhs|))) (COND - ((EQCAR |lhs| 'L%T) (SETQ G (CADR |lhs|)) + ((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'L%T)) + (SETQ G (CADR |lhs|)) (APPEND (|bfINON| (LIST OP G |whole|)) (|bfSuchthat| (|bfIS| G (CADDR |lhs|))))) (#1# (SETQ G (|bfGenSymbol|)) @@ -398,7 +401,8 @@ (DEFUN |bfLp| (|iters| |body|) (COND - ((EQCAR |iters| 'ITERATORS) (|bfLp1| (CDR |iters|) |body|)) + ((AND (CONSP |iters|) (EQ (CAR |iters|) 'ITERATORS)) + (|bfLp1| (CDR |iters|) |body|)) ('T (|bfLpCross| (CDR |iters|) |body|)))) (DEFUN |bfLpCross| (|iters| |body|) @@ -431,7 +435,9 @@ (RETURN (PROGN (SETQ |a| - (COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|))) + (COND + ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE)) (CADR |op|)) + ('T |op|))) (SETQ |op| (|bfReName| |a|)) (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA))) (SETQ |g| (|bfGenSymbol|)) @@ -447,7 +453,7 @@ (|bfIN| |g1| |ny|)))) (|bfMKPROGN| (LIST (LIST 'L%T |g2| |y|) (|bfLp| |it| |body|)))) - (#0# (SETQ |init| (CAR |init|)) + ('T (SETQ |init| (CAR |init|)) (SETQ |it| (CONS 'ITERATORS (LIST (LIST (LIST (LIST |g|) (LIST |init|) NIL @@ -459,15 +465,17 @@ (PROG (|init| |a| |itl| |body|) (RETURN (COND - ((EQCAR |y| 'COLLECT) (SETQ |body| (ELT |y| 1)) - (SETQ |itl| (ELT |y| 2)) + ((AND (CONSP |y|) (EQ (CAR |y|) 'COLLECT)) + (SETQ |body| (ELT |y| 1)) (SETQ |itl| (ELT |y| 2)) (SETQ |a| - (COND ((EQCAR |op| 'QUOTE) (CADR |op|)) (#0='T |op|))) + (COND + ((AND (CONSP |op|) (EQ (CAR |op|) 'QUOTE)) + (CADR |op|)) + ('T |op|))) (SETQ |op| (|bfReName| |a|)) (SETQ |init| (OR (GET |a| 'SHOETHETA) (GET |op| 'SHOETHETA))) (|bfOpReduce| |op| |init| |body| |itl|)) - (#0# (SETQ |a| (|bfTupleConstruct| (ELT |y| 1))) - (|bfReduce| |op| |a|)))))) + ('T (|bfReduce| |op| (|bfTupleConstruct| (ELT |y| 1)))))))) (DEFUN |bfDCollect| (|y| |itl|) (LIST 'COLLECT |y| |itl|)) @@ -564,7 +572,7 @@ (PROG (|iters|) (RETURN (COND - ((EQCAR |itl| 'ITERATORS) + ((AND (CONSP |itl|) (EQ (CAR |itl|) 'ITERATORS)) (|bfLp1| (CONS |extrait| (CDR |itl|)) |body|)) ('T (SETQ |iters| (CDR |itl|)) (|bfLpCross| @@ -589,7 +597,7 @@ (|bfMKPROGN| (LIST (LIST 'SETQ |g| |y|) (LIST 'COND (LIST |g| (LIST 'RETURN |g|)))))) - ('T (LIST 'SETQ |g| (LIST |op| |g| |y|))))) + (#0='T (LIST 'SETQ |g| (LIST |op| |g| |y|))))) (COND ((NULL |init|) (SETQ |g1| (|bfGenSymbol|)) (SETQ |init| (LIST 'CAR |g1|)) (SETQ |y| (LIST 'CDR |g1|)) @@ -599,7 +607,7 @@ (|bfMKPROGN| (LIST (LIST 'L%T |g1| |y|) (|bfLp2| |extrait| |itl| |body|)))) - ('T (SETQ |init| (CAR |init|)) + (#0# (SETQ |init| (CAR |init|)) (SETQ |extrait| (LIST (LIST (LIST |g|) (LIST |init|) NIL NIL NIL (LIST |g|)))) @@ -639,7 +647,7 @@ (DEFUN |bfSUBLIS| (|p| |e|) (COND ((ATOM |e|) (|bfSUBLIS1| |p| |e|)) - ((EQCAR |e| 'QUOTE) |e|) + ((AND (CONSP |e|) (EQ (CAR |e|) 'QUOTE)) |e|) ('T (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|)))))) (DEFUN |bfSUBLIS1| (|p| |e|) @@ -713,18 +721,21 @@ ((AND (IDENTP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|))) (SETQ |rhs1| (|bfLET2| |lhs| |rhs|)) (COND - ((EQCAR |rhs1| 'L%T) (|bfMKPROGN| (LIST |rhs1| |rhs|))) - ((EQCAR |rhs1| 'PROGN) (APPEND |rhs1| (LIST |rhs|))) + ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'L%T)) + (|bfMKPROGN| (LIST |rhs1| |rhs|))) + ((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'PROGN)) + (APPEND |rhs1| (LIST |rhs|))) (#0='T (COND ((IDENTP (CAR |rhs1|)) (SETQ |rhs1| (CONS |rhs1| NIL)))) (|bfMKPROGN| (APPEND |rhs1| (CONS |rhs| NIL)))))) - ((AND (CONSP |rhs|) (EQCAR |rhs| 'L%T) + ((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T) (IDENTP (SETQ |name| (CADR |rhs|)))) (SETQ |l1| (|bfLET1| |name| (CADDR |rhs|))) (SETQ |l2| (|bfLET1| |lhs| |name|)) (COND - ((EQCAR |l2| 'PROGN) (|bfMKPROGN| (CONS |l1| (CDR |l2|)))) + ((AND (CONSP |l2|) (EQ (CAR |l2|) 'PROGN)) + (|bfMKPROGN| (CONS |l1| (CDR |l2|)))) (#0# (COND ((IDENTP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL)))) (|bfMKPROGN| (CONS |l1| (APPEND |l2| (CONS |name| NIL))))))) @@ -736,7 +747,7 @@ (SETQ |rhs1| (LIST 'L%T |g| |rhs|)) (SETQ |let1| (|bfLET1| |lhs| |g|)) (COND - ((EQCAR |let1| 'PROGN) + ((AND (CONSP |let1|) (EQ (CAR |let1|) 'PROGN)) (|bfMKPROGN| (CONS |rhs1| (CDR |let1|)))) (#0# (COND @@ -789,7 +800,7 @@ (PROGN (SETQ |var2| (CAR |ISTMP#2|)) #0#)))))) (COND ((OR (EQ |var1| 'DOT) - (AND (CONSP |var1|) (EQCAR |var1| 'QUOTE))) + (AND (CONSP |var1|) (EQ (CAR |var1|) 'QUOTE))) (|bfLET2| |var2| (|addCARorCDR| 'CDR |rhs|))) (#1# (SETQ |l1| (|bfLET2| |var1| (|addCARorCDR| 'CAR |rhs|))) @@ -882,7 +893,8 @@ (RETURN (COND ((NULL (CONSP |expr|)) (LIST |acc| |expr|)) - ((AND (EQ |acc| 'CAR) (EQCAR |expr| 'REVERSE)) + ((AND (EQ |acc| 'CAR) (CONSP |expr|) + (EQ (CAR |expr|) 'REVERSE)) (LIST 'CAR (CONS 'LAST (CDR |expr|)))) (#0='T (SETQ |funs| @@ -1100,7 +1112,9 @@ ('T (LIST 'NOT |x|)))))) (DEFUN |bfFlatten| (|op| |x|) - (COND ((EQCAR |x| |op|) (CDR |x|)) ('T (LIST |x|)))) + (COND + ((AND (CONSP |x|) (EQUAL (CAR |x|) |op|)) (CDR |x|)) + ('T (LIST |x|)))) (DEFUN |bfOR| (|l|) (COND @@ -1139,7 +1153,7 @@ (SETQ |bfVar#89| (CDR |bfVar#89|)))))))) (DEFUN |defQuoteId| (|x|) - (AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|)))) + (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (IDENTP (CADR |x|)))) (DEFUN |bfSmintable| (|x|) (OR (INTEGERP |x|) @@ -1319,7 +1333,7 @@ (PROGN (SETQ |a| (|shoeCompTran| (CADR |x|))) (COND - ((EQCAR |a| 'LAMBDA) + ((AND (CONSP |a|) (EQ (CAR |a|) 'LAMBDA)) (CONS 'DEFUN (CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|))))) ('T (CONS 'DEFMACRO @@ -1487,7 +1501,7 @@ ((NULL |x|) NIL) ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (LIST |x|)) ((ATOM |x|) NIL) - ((EQCAR |x| 'QUOTE) NIL) + ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) NIL) ('T (APPEND (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|)))))) (DEFUN |shoeATOMs| (|x|) @@ -1551,7 +1565,7 @@ (COND ((MEMQ |l| |$dollarVars|) |$dollarVars|) (#0# (CONS |l| |$dollarVars|))))))) - ((EQCAR |l| 'FLUID) + ((AND (CONSP |l|) (EQ (CAR |l|) 'FLUID)) (SETQ |$fluidVars| (COND ((MEMQ (CADR |l|) |$fluidVars|) |$fluidVars|) @@ -1640,7 +1654,9 @@ (RETURN (PROGN (SETQ |b1| - (COND ((EQCAR |b| 'PROGN) (CDR |b|)) ('T (LIST |b|)))) + (COND + ((AND (CONSP |b|) (EQ (CAR |b|) 'PROGN)) (CDR |b|)) + ('T (LIST |b|)))) (LIST 'COND (CONS |a| |b1|)))))) (DEFUN |bfIf| (|a| |b| |c|) @@ -1648,14 +1664,16 @@ (RETURN (PROGN (SETQ |b1| - (COND ((EQCAR |b| 'PROGN) (CDR |b|)) (#0='T (LIST |b|)))) + (COND + ((AND (CONSP |b|) (EQ (CAR |b|) 'PROGN)) (CDR |b|)) + (#0='T (LIST |b|)))) (COND - ((EQCAR |c| 'COND) + ((AND (CONSP |c|) (EQ (CAR |c|) 'COND)) (CONS 'COND (CONS (CONS |a| |b1|) (CDR |c|)))) ('T (SETQ |c1| (COND - ((EQCAR |c| 'PROGN) (CDR |c|)) + ((AND (CONSP |c|) (EQ (CAR |c|) 'PROGN)) (CDR |c|)) (#0# (LIST |c|)))) (LIST 'COND (CONS |a| |b1|) (CONS ''T |c1|)))))))) @@ -1689,7 +1707,7 @@ (#0='T (SETQ |f| (CAR |x|)) (COND ((ATOM |f|) (COND ((CDR |x|) NIL) ('T (LIST |f|)))) - ((EQCAR |f| 'PROGN) + ((AND (CONSP |f|) (EQ (CAR |f|) 'PROGN)) (COND ((CDR |x|) (LET ((|bfVar#111| NIL) (|bfVar#110| (CDR |f|)) @@ -1881,7 +1899,10 @@ (DEFUN |bfNameArgs| (|x| |y|) (PROGN - (SETQ |y| (COND ((EQCAR |y| 'TUPLE) (CDR |y|)) ('T (LIST |y|)))) + (SETQ |y| + (COND + ((AND (CONSP |y|) (EQ (CAR |y|) 'TUPLE)) (CDR |y|)) + ('T (LIST |y|)))) (CONS |x| |y|))) (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCreateDef|)) @@ -1890,7 +1911,8 @@ (PROG (|a| |f|) (RETURN (COND - ((NULL (CDR |x|)) (SETQ |f| (CAR |x|)) + ((AND (CONSP |x|) (EQ (CDR |x|) NIL) + (PROGN (SETQ |f| (CAR |x|)) 'T)) (LIST 'DEFCONSTANT |f| (LIST 'LIST (LIST 'QUOTE |f|)))) ('T (SETQ |a| diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp index 6146ddc7..94aee881 100644 --- a/src/boot/strap/includer.clisp +++ b/src/boot/strap/includer.clisp @@ -13,8 +13,6 @@ (DEFUN |char| (|x|) (CHAR (PNAME |x|) 0)) -(DEFUN EQCAR (|x| |y|) (AND (CONSP |x|) (EQ (CAR |x|) |y|))) - (DEFUN STRINGIMAGE (|x|) (WRITE-TO-STRING |x|)) (DEFUN |shoeCLOSE| (|stream|) (CLOSE |stream|)) @@ -134,17 +132,19 @@ (PROG (|st|) (RETURN (COND - ((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T) + ((OR (NULL |x|) (AND (CONSP |x|) (EQ (CAR |x|) '|nullstream|))) + T) ('T (LOOP (COND - ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL)) + ((NOT (AND (CONSP |x|) (EQ (CAR |x|) '|nonnullstream|))) + (RETURN NIL)) ('T (PROGN (SETQ |st| (APPLY (CADR |x|) (CDDR |x|))) (RPLACA |x| (CAR |st|)) (RPLACD |x| (CDR |st|)))))) - (EQCAR |x| '|nullstream|)))))) + (AND (CONSP |x|) (EQ (CAR |x|) '|nullstream|))))))) (DEFUN |bMap| (|f| |x|) (|bDelay| #'|bMap1| (LIST |f| |x|))) diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp index 15e77276..44e1a285 100644 --- a/src/boot/strap/parser.clisp +++ b/src/boot/strap/parser.clisp @@ -33,7 +33,8 @@ ('T (CAR |$inputStream|)))) (SETQ |$ttok| (|shoeTokPart| |$stok|)) (COND - ((AND (< 0 |$bpParenCount|) (EQCAR |$stok| 'KEY)) + ((AND (< 0 |$bpParenCount|) (CONSP |$stok|) + (EQ (CAR |$stok|) 'KEY)) (COND ((EQ |$ttok| 'SETTAB) (SETQ |$bpCount| (+ |$bpCount| 1)) (|bpNext|)) @@ -291,15 +292,17 @@ (DEFUN |bpEqPeek| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|))) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|))) (DEFUN |bpEqKey| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNext|))) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|) + (|bpNext|))) (DEFUN |bpEqKeyNextTok| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (EQCAR |$stok| 'KEY) (EQ |s| |$ttok|) (|bpNextToken|))) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|) + (|bpNextToken|))) (DEFUN |bpPileTrap| () (|bpMissing| 'BACKTAB)) @@ -391,15 +394,15 @@ (DECLARE (SPECIAL |$stok|)) (COND ((|bpEqPeek| 'COLON-COLON) (|bpNext|) - (AND (EQCAR |$stok| 'ID) (|bpPushId|) (|bpNext|) - (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|))))) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (|bpPushId|) + (|bpNext|) (|bpPush| (|bfColonColon| (|bpPop2|) (|bpPop1|))))) ('T NIL))) (DEFUN |bpName| () (DECLARE (SPECIAL |$stok|)) (COND - ((EQCAR |$stok| 'ID) (|bpPushId|) (|bpNext|) - (|bpAnyNo| #'|bpQualifiedName|)) + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID)) (|bpPushId|) + (|bpNext|) (|bpAnyNo| #'|bpQualifiedName|)) ('T NIL))) (DEFUN |bpConstTok| () @@ -407,10 +410,11 @@ (COND ((MEMQ (|shoeTokType| |$stok|) '(INTEGER FLOAT)) (|bpPush| |$ttok|) (|bpNext|)) - ((EQCAR |$stok| 'LISP) + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LISP)) (AND (|bpPush| (|%Lisp| |$ttok|)) (|bpNext|))) - ((EQCAR |$stok| 'LISPEXP) (AND (|bpPush| |$ttok|) (|bpNext|))) - ((EQCAR |$stok| 'LINE) + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LISPEXP)) + (AND (|bpPush| |$ttok|) (|bpNext|))) + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'LINE)) (AND (|bpPush| (LIST '+LINE |$ttok|)) (|bpNext|))) ((|bpEqPeek| 'QUOTE) (|bpNext|) (AND (OR (|bpSexp|) (|bpTrap|)) @@ -533,7 +537,8 @@ (DECLARE (SPECIAL |$ttok| |$stok|)) (RETURN (COND - ((AND (EQCAR |$stok| 'KEY) (NOT (|bpExceptions|))) + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) + (NOT (|bpExceptions|))) (SETQ |a| (GET |$ttok| 'SHOEINF)) (COND ((NULL |a|) (AND (|bpPush| |$ttok|) (|bpNext|))) @@ -542,7 +547,9 @@ (DEFUN |bpAnyId| () (DECLARE (SPECIAL |$ttok| |$stok|)) - (OR (AND (|bpEqKey| 'MINUS) (OR (EQCAR |$stok| 'INTEGER) (|bpTrap|)) + (OR (AND (|bpEqKey| 'MINUS) + (OR (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'INTEGER)) + (|bpTrap|)) (|bpPush| (- |$ttok|)) (|bpNext|)) (|bpSexpKey|) (AND (MEMQ (|shoeTokType| |$stok|) '(ID INTEGER STRING FLOAT)) @@ -573,13 +580,13 @@ (DEFUN |bpPrefixOperator| () (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEPRE) (|bpPushId|) - (|bpNext|))) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE) + (|bpPushId|) (|bpNext|))) (DEFUN |bpInfixOperator| () (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (EQCAR |$stok| 'KEY) (GET |$ttok| 'SHOEINF) (|bpPushId|) - (|bpNext|))) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEINF) + (|bpPushId|) (|bpNext|))) (DEFUN |bpSelector| () (AND (|bpEqKey| 'DOT) @@ -615,8 +622,8 @@ (DEFUN |bpInfKey| (|s|) (DECLARE (SPECIAL |$ttok| |$stok|)) - (AND (EQCAR |$stok| 'KEY) (MEMBER |$ttok| |s|) (|bpPushId|) - (|bpNext|))) + (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (MEMBER |$ttok| |s|) + (|bpPushId|) (|bpNext|))) (DEFUN |bpInfGeneric| (|s|) (AND (|bpInfKey| |s|) (OR (|bpEqKey| 'BACKSET) T))) @@ -662,8 +669,9 @@ (DEFUN |bpThetaName| () (DECLARE (SPECIAL |$ttok| |$stok|)) (COND - ((AND (EQCAR |$stok| 'ID) (GET |$ttok| 'SHOETHETA)) (|bpPushId|) - (|bpNext|)) + ((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) + (GET |$ttok| 'SHOETHETA)) + (|bpPushId|) (|bpNext|)) ('T NIL))) (DEFUN |bpReduceOperator| () @@ -1138,7 +1146,7 @@ (SETQ |b| (|bpPop1|)) (|bpPush| (COND - ((EQCAR |b| '+LINE) (LIST |b|)) + ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|)) ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T) (PROGN (SETQ |ISTMP#1| (CDR |b|)) diff --git a/src/boot/strap/pile.clisp b/src/boot/strap/pile.clisp index 4b624e7e..79b45cc0 100644 --- a/src/boot/strap/pile.clisp +++ b/src/boot/strap/pile.clisp @@ -119,7 +119,7 @@ (|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|))) (#0# (SETQ |d| (CADR |a|)) (SETQ |e| (|shoeTokPart| |d|)) (COND - ((AND (EQCAR |d| 'KEY) + ((AND (CONSP |d|) (EQ (CAR |d|) 'KEY) (OR (GET |e| 'SHOEINF) (EQ |e| 'COMMA) (EQ |e| 'SEMICOLON))) (|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|))) diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp index dfb850cb..341c0200 100644 --- a/src/boot/strap/translator.clisp +++ b/src/boot/strap/translator.clisp @@ -470,7 +470,8 @@ (PROGN (SETQ |a| (CAR |s|)) (COND - ((EQCAR |a| '+LINE) (|shoeFileLine| (CADR |a|) |st|)) + ((AND (CONSP |a|) (EQ (CAR |a|) '+LINE)) + (|shoeFileLine| (CADR |a|) |st|)) ('T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|))) (SETQ |s| (CDR |s|))))))))) -- cgit v1.2.3