aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap')
-rw-r--r--src/boot/strap/ast.clisp14
-rw-r--r--src/boot/strap/parser.clisp126
-rw-r--r--src/boot/strap/translator.clisp3
3 files changed, 81 insertions, 62 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index ec55fefc..f00bb570 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -148,6 +148,10 @@
(DEFUN |quote| (|x|) (LIST 'QUOTE |x|))
+(DEFUN |bfSpecificErrorHere| (|msg|)
+ (THROW :OPEN-AXIOM-CATCH-POINT
+ (CONS :OPEN-AXIOM-CATCH-POINT (CONS '(|BootSpecificError|) |msg|))))
+
(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfGenSymbol|))
(DEFUN |bfGenSymbol| ()
@@ -1042,7 +1046,7 @@
(COND ((NULL (CADDR |x|)) (LIST 'CONS (CADR |x|) |a|))
(T (SETQ |y| (|bfISReverse| (CADDR |x|) NIL))
(RPLACA (CDR (CDR |y|)) (LIST 'CONS (CADR |x|) |a|)) |y|)))
- (T (|bpSpecificErrorHere| "Error in bfISReverse") (|bpTrap|)))))
+ (T (|bfSpecificErrorHere| "Error in bfISReverse")))))
(DEFUN |bfIS1| (|lhs| |rhs|)
(LET* (|l2|
@@ -1152,11 +1156,11 @@
(LIST '|reverse!| |a|))
'T)
NIL)))))))
- (T (|bpSpecificErrorHere| "bad IS code is generated") (|bpTrap|)))))
+ (T (|bfSpecificErrorHere| "bad IS code is generated")))))
(DEFUN |bfHas| (|expr| |prop|)
(COND ((SYMBOLP |prop|) (LIST 'GET |expr| (|quote| |prop|)))
- (T (|bpSpecificErrorHere| "expected identifier as property name"))))
+ (T (|bfSpecificErrorHere| "expected identifier as property name"))))
(DEFUN |bfKeyArg| (|k| |x|) (LIST '|%Key| |k| |x|))
@@ -1579,7 +1583,7 @@
((AND (CONSP |p1|) (EQ (CAR |p1|) '&OPTIONAL))
(COND
((NOT (AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL)))
- (|bpSpecificErrorHere| "default value required"))
+ (|bfSpecificErrorHere| "default value required"))
(T (CONS (CAR |p1|) (|append| (CDR |p1|) (CDR |p2|))))))
((AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL))
(CONS |p1| (CONS (CAR |p2|) (CDR |p2|))))
@@ -2617,7 +2621,7 @@
(LIST 'LET (LIST (LIST |v| (LIST 'CDR |e|)))
|s|))
|xs|)))
- (T (|bpTrap|)))))
+ (T (|bfSpecificErrorHere| "invalid handler message")))))
(DEFUN |codeForCatchHandlers| (|g| |e| |cs|)
(LET* (|ehTest|)
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 620207d2..105fe06f 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -93,7 +93,7 @@
(SETF (|parserTokens| |ps|) (CDR (|parserTokens| |ps|)))
(|bpFirstToken| |ps|)))
-(DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap|)))
+(DEFUN |bpRequire| (|ps| |f|) (OR (APPLY |f| |ps| NIL) (|bpTrap| |ps|)))
(DEFUN |bpState| (|ps|)
(LIST (|parserTokens| |ps|) (|parserTrees| |ps|) (|parserNesting| |ps|)
@@ -146,12 +146,12 @@
(SETF (|parserScope| |ps|) 0)
(SETQ |a| |$stok|)
(COND
- ((|bpEqPeek| 'OPAREN)
+ ((|bpEqPeek| |ps| 'OPAREN)
(SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1))
(|bpNext| |ps|)
(COND
((AND (APPLY |f| |ps| NIL) (|bpFirstTok| |ps|)
- (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
+ (OR (|bpEqPeek| |ps| 'CPAREN) (|bpParenTrap| |a|)))
(SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
(|bpNextToken| |ps|)
(COND ((EQL (|parserScope| |ps|) 0) T)
@@ -162,7 +162,7 @@
(|bpFirstToken| |ps|)
(COND ((EQL (|parserNesting| |ps|) 0) (|bpCancel| |ps|) T)
(T T)))))
- ((|bpEqPeek| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
+ ((|bpEqPeek| |ps| 'CPAREN) (|bpPush| |ps| (|bfTuple| NIL))
(SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
(|bpNextToken| |ps|) T)
(T (|bpParenTrap| |a|))))
@@ -320,7 +320,7 @@
(COND ((|bpEqKey| |ps| 'BACKSET) (|bpEqKey| |ps| 'ELSE))
(T (|bpEqKey| |ps| 'ELSE))))
-(DEFUN |bpEqPeek| (|s|)
+(DEFUN |bpEqPeek| (|ps| |s|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|tokenClass| |$stok|) 'KEY) (EQ |s| |$ttok|)))
@@ -351,7 +351,7 @@
(DEFUN |bpCompMissing| (|ps| |s|) (OR (|bpEqKey| |ps| |s|) (|bpMissing| |s|)))
-(DEFUN |bpTrap| ()
+(DEFUN |bpTrap| (|ps|)
(PROGN
(|bpGeneralErrorHere|)
(THROW :OPEN-AXIOM-CATCH-POINT
@@ -398,12 +398,14 @@
((NOT |found|) (SETF (|parserTokens| |ps|) |c|)
(|bpGeneralErrorHere|) (|bpRecoverTrap| |ps|)))
(COND ((|bpEqKey| |ps| 'BACKSET) (SETQ |c| (|parserTokens| |ps|)))
- ((OR (|bpEqPeek| 'BACKTAB) (NULL (|parserTokens| |ps|)))
+ ((OR (|bpEqPeek| |ps| 'BACKTAB)
+ (NULL (|parserTokens| |ps|)))
(SETQ |done| T))
(T (SETF (|parserTokens| |ps|) |c|) (|bpGeneralErrorHere|)
(|bpRecoverTrap| |ps|)
(COND
- ((OR (|bpEqPeek| 'BACKTAB) (NULL (|parserTokens| |ps|)))
+ ((OR (|bpEqPeek| |ps| 'BACKTAB)
+ (NULL (|parserTokens| |ps|)))
(SETQ |done| T))
(T (|bpNext| |ps|) (SETQ |c| (|parserTokens| |ps|))))))
(SETQ |b| (CONS (|bpPop1| |ps|) |b|)))))
@@ -412,18 +414,19 @@
(DEFUN |bpMoveTo| (|ps| |n|)
(COND ((NULL (|parserTokens| |ps|)) T)
- ((|bpEqPeek| 'BACKTAB)
+ ((|bpEqPeek| |ps| 'BACKTAB)
(COND ((EQL |n| 0) T)
(T (|bpNextToken| |ps|)
(SETF (|parserScope| |ps|) (- (|parserScope| |ps|) 1))
(|bpMoveTo| |ps| (- |n| 1)))))
- ((|bpEqPeek| 'BACKSET)
+ ((|bpEqPeek| |ps| 'BACKSET)
(COND ((EQL |n| 0) T) (T (|bpNextToken| |ps|) (|bpMoveTo| |ps| |n|))))
- ((|bpEqPeek| 'SETTAB) (|bpNextToken| |ps|) (|bpMoveTo| |ps| (+ |n| 1)))
- ((|bpEqPeek| 'OPAREN) (|bpNextToken| |ps|)
+ ((|bpEqPeek| |ps| 'SETTAB) (|bpNextToken| |ps|)
+ (|bpMoveTo| |ps| (+ |n| 1)))
+ ((|bpEqPeek| |ps| 'OPAREN) (|bpNextToken| |ps|)
(SETF (|parserNesting| |ps|) (+ (|parserNesting| |ps|) 1))
(|bpMoveTo| |ps| |n|))
- ((|bpEqPeek| 'CPAREN) (|bpNextToken| |ps|)
+ ((|bpEqPeek| |ps| 'CPAREN) (|bpNextToken| |ps|)
(SETF (|parserNesting| |ps|) (- (|parserNesting| |ps|) 1))
(|bpMoveTo| |ps| |n|))
(T (|bpNextToken| |ps|) (|bpMoveTo| |ps| |n|))))
@@ -431,7 +434,7 @@
(DEFUN |bpQualifiedName| (|ps|)
(DECLARE (SPECIAL |$stok|))
(COND
- ((|bpEqPeek| 'COLON-COLON) (|bpNext| |ps|)
+ ((|bpEqPeek| |ps| 'COLON-COLON) (|bpNext| |ps|)
(AND (EQ (|tokenClass| |$stok|) 'ID) (|bpPushId| |ps|) (|bpNext| |ps|)
(|bpPush| |ps| (|bfColonColon| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(T NIL)))
@@ -454,7 +457,7 @@
(AND (|bpPush| |ps| |$ttok|) (|bpNext| |ps|)))
((EQ (|tokenClass| |$stok|) 'LINE)
(AND (|bpPush| |ps| (LIST '+LINE |$ttok|)) (|bpNext| |ps|)))
- ((|bpEqPeek| 'QUOTE) (|bpNext| |ps|)
+ ((|bpEqPeek| |ps| 'QUOTE) (|bpNext| |ps|)
(AND (|bpRequire| |ps| #'|bpSexp|)
(|bpPush| |ps| (|bfSymbol| (|bpPop1| |ps|)))))
(T (OR (|bpString| |ps|) (|bpFunction| |ps|)))))
@@ -485,12 +488,12 @@
(DEFUN |bpExportItem| (|ps|)
(LET* (|a|)
- (COND ((|bpEqPeek| 'STRUCTURE) (|bpStruct| |ps|))
+ (COND ((|bpEqPeek| |ps| 'STRUCTURE) (|bpStruct| |ps|))
(T (SETQ |a| (|bpState| |ps|))
(COND
((|bpName| |ps|)
(COND
- ((|bpEqPeek| 'COLON) (|bpRestore| |ps| |a|)
+ ((|bpEqPeek| |ps| 'COLON) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpSignature|)
(OR (|bpExportItemTail| |ps|) T))
(T (|bpRestore| |ps| |a|) (|bpTypeAliasDefition| |ps|))))
@@ -503,7 +506,7 @@
((|bpEqKey| |ps| 'WHERE)
(OR (|bpPileBracketed| |ps| #'|bpExportItemList|)
(AND (|bpExportItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|))))
- (|bpTrap|)))
+ (|bpTrap| |ps|)))
(T (|bpPush| |ps| NIL))))
(DEFUN |bpModuleExports| (|ps|)
@@ -529,12 +532,12 @@
(OR
(AND (|bpLeftAssoc| |ps| '(DOT) #'|bpName|)
(|bpPush| |ps| (|%Import| (|bfNamespace| (|bpPop1| |ps|)))))
- (|bpTrap|)))
+ (|bpTrap| |ps|)))
(T (SETQ |a| (|bpState| |ps|)) (|bpRequire| |ps| #'|bpName|)
(COND
- ((|bpEqPeek| 'COLON) (|bpRestore| |ps| |a|)
+ ((|bpEqPeek| |ps| 'COLON) (|bpRestore| |ps| |a|)
(AND (|bpRequire| |ps| #'|bpSignature|)
- (OR (|bpEqKey| |ps| 'FOR) (|bpTrap|))
+ (OR (|bpEqKey| |ps| 'FOR) (|bpTrap| |ps|))
(|bpRequire| |ps| #'|bpName|)
(|bpPush| |ps|
(|%ImportSignature| (|bpPop1| |ps|)
@@ -547,7 +550,7 @@
(|bpPush| |ps| (|bfNamespace| (|bpPop1| |ps|)))))
(DEFUN |bpTypeAliasDefition| (|ps|)
- (AND (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap|)) (|bpEqKey| |ps| 'TDEF)
+ (AND (OR (|bpTerm| |ps| #'|bpIdList|) (|bpTrap| |ps|)) (|bpEqKey| |ps| 'TDEF)
(|bpLogical| |ps|)
(|bpPush| |ps| (|%TypeAlias| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
@@ -594,16 +597,16 @@
(CONS (|mk%Token| 'KEY 'BACKTAB (|tokenPosition| |$stok|))
(|bpAddTokens| (+ |n| 1))))))
-(DEFUN |bpExceptions| ()
- (OR (|bpEqPeek| 'DOT) (|bpEqPeek| 'QUOTE) (|bpEqPeek| 'OPAREN)
- (|bpEqPeek| 'CPAREN) (|bpEqPeek| 'SETTAB) (|bpEqPeek| 'BACKTAB)
- (|bpEqPeek| 'BACKSET)))
+(DEFUN |bpExceptions| (|ps|)
+ (OR (|bpEqPeek| |ps| 'DOT) (|bpEqPeek| |ps| 'QUOTE) (|bpEqPeek| |ps| 'OPAREN)
+ (|bpEqPeek| |ps| 'CPAREN) (|bpEqPeek| |ps| 'SETTAB)
+ (|bpEqPeek| |ps| 'BACKTAB) (|bpEqPeek| |ps| 'BACKSET)))
(DEFUN |bpSexpKey| (|ps|)
(LET* (|a|)
(DECLARE (SPECIAL |$ttok| |$stok|))
(COND
- ((AND (EQ (|tokenClass| |$stok|) 'KEY) (NOT (|bpExceptions|)))
+ ((AND (EQ (|tokenClass| |$stok|) 'KEY) (NOT (|bpExceptions| |ps|)))
(SETQ |a| (GET |$ttok| 'SHOEINF))
(COND
((NULL |a|) (AND (|bpPush| |ps| (|keywordId| |$ttok|)) (|bpNext| |ps|)))
@@ -614,7 +617,7 @@
(DECLARE (SPECIAL |$ttok| |$stok|))
(OR
(AND (|bpEqKey| |ps| 'MINUS)
- (OR (EQ (|tokenClass| |$stok|) 'INTEGER) (|bpTrap|))
+ (OR (EQ (|tokenClass| |$stok|) 'INTEGER) (|bpTrap| |ps|))
(|bpPush| |ps| (- |$ttok|)) (|bpNext| |ps|))
(|bpSexpKey| |ps|)
(AND (|symbolMember?| (|tokenClass| |$stok|) '(ID INTEGER STRING FLOAT))
@@ -683,7 +686,7 @@
(DEFUN |bpTyping| (|ps|)
(COND
((|bpEqKey| |ps| 'FORALL) (|bpRequire| |ps| #'|bpVariable|)
- (OR (AND (|bpDot| |ps|) (|bpPop1| |ps|)) (|bpTrap|))
+ (OR (AND (|bpDot| |ps|) (|bpPop1| |ps|)) (|bpTrap| |ps|))
(|bpRequire| |ps| #'|bpTyping|)
(|bpPush| |ps| (|%Forall| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T (OR (|bpMapping| |ps|) (|bpSimpleMapping| |ps|)))))
@@ -719,7 +722,7 @@
(COND
((NOT
(AND (|bpInfGeneric| |ps| |o|)
- (OR (|bpRightAssoc| |ps| |o| |p|) (|bpTrap|))))
+ (OR (|bpRightAssoc| |ps| |o| |p|) (|bpTrap| |ps|))))
(RETURN NIL))
(T
(|bpPush| |ps|
@@ -769,7 +772,7 @@
(COND
((AND (|bpReduceOperator| |ps|) (|bpEqKey| |ps| 'SLASH))
(COND
- ((|bpEqPeek| 'OBRACK)
+ ((|bpEqPeek| |ps| 'OBRACK)
(AND (|bpRequire| |ps| #'|bpDConstruct|)
(|bpPush| |ps|
(|bfReduceCollect| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
@@ -841,13 +844,14 @@
(|bpPush| |ps|
(|bfTry| (|bpPop2| |ps|)
(|reverse!| (CONS (|bpPop1| |ps|) |cs|))))))
- ((NULL |cs|) (|bpTrap|))
+ ((NULL |cs|) (|bpTrap| |ps|))
(T (|bpPush| |ps| (|bfTry| (|bpPop1| |ps|) (|reverse!| |cs|))))))
(T NIL))))
(DEFUN |bpCatchItem| (|ps|)
(AND (|bpRequire| |ps| #'|bpExceptionVariable|)
- (OR (|bpEqKey| |ps| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpAssign|)
+ (OR (|bpEqKey| |ps| 'EXIT) (|bpTrap| |ps|))
+ (|bpRequire| |ps| #'|bpAssign|)
(|bpPush| |ps| (|%Catch| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpExceptionVariable| (|ps|)
@@ -858,7 +862,7 @@
(OR
(AND (|bpEqKey| |ps| 'OPAREN) (|bpRequire| |ps| #'|bpSignature|)
(OR (|bpEqKey| |ps| 'CPAREN) (|bpMissing| |t|)))
- (|bpTrap|)))))
+ (|bpTrap| |ps|)))))
(DEFUN |bpFinally| (|ps|)
(AND (|bpRequire| |ps| #'|bpAssign|)
@@ -901,7 +905,7 @@
(OR
(AND (|bpLogical| |ps|)
(|bpPush| |ps| (|bfApplication| 'COLON (|bpPop1| |ps|))))
- (|bpTrap|)))
+ (|bpTrap| |ps|)))
(|bpLogical| |ps|)))
(DEFUN |bpStatement| (|ps|)
@@ -966,11 +970,11 @@
(COND
((|bpStatement| |ps|)
(COND
- ((|bpEqPeek| 'BEC) (|bpRestore| |ps| |a|)
+ ((|bpEqPeek| |ps| 'BEC) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpAssignment|))
- ((|bpEqPeek| 'GIVES) (|bpRestore| |ps| |a|)
+ ((|bpEqPeek| |ps| 'GIVES) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpLambda|))
- ((|bpEqPeek| 'LARROW) (|bpRestore| |ps| |a|)
+ ((|bpEqPeek| |ps| 'LARROW) (|bpRestore| |ps| |a|)
(|bpRequire| |ps| #'|bpKeyArg|))
(T T)))
(T (|bpRestore| |ps| |a|) NIL)))))
@@ -1003,12 +1007,12 @@
(OR
(AND (|bpName| |ps|) (|bpStoreName| |ps|)
(|bpCompoundDefinitionTail| |ps| #'|%Macro|))
- (|bpTrap|)))
+ (|bpTrap| |ps|)))
(T (SETQ |a| (|bpState| |ps|))
(COND
((|bpExit| |ps|)
- (COND ((|bpEqPeek| 'DEF) (|bpRestore| |ps| |a|) (|bpDef| |ps|))
- ((|bpEqPeek| 'TDEF) (|bpRestore| |ps| |a|)
+ (COND ((|bpEqPeek| |ps| 'DEF) (|bpRestore| |ps| |a|) (|bpDef| |ps|))
+ ((|bpEqPeek| |ps| 'TDEF) (|bpRestore| |ps| |a|)
(|bpTypeAliasDefition| |ps|))
(T T)))
(T (|bpRestore| |ps| |a|) NIL))))))
@@ -1126,7 +1130,7 @@
(DEFUN |bpEqual| (|ps|)
(AND (|bpEqKey| |ps| 'SHOEEQ)
- (OR (|bpApplication| |ps|) (|bpConstTok| |ps|) (|bpTrap|))
+ (OR (|bpApplication| |ps|) (|bpConstTok| |ps|) (|bpTrap| |ps|))
(|bpPush| |ps| (|bfEqual| (|bpPop1| |ps|)))))
(DEFUN |bpRegularPatternItem| (|ps|)
@@ -1164,7 +1168,7 @@
(AND (|bpPatternTail| |ps|)
(|bpPush| |ps|
(|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))
- (|bpTrap|))
+ (|bpTrap| |ps|))
NIL))))
(RETURN NIL))
(T (|bpPush| |ps| (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
@@ -1204,7 +1208,7 @@
(DEFUN |bpColonName| (|ps|)
(AND (|bpEqKey| |ps| 'COLON)
- (OR (|bpName| |ps|) (|bpBVString| |ps|) (|bpTrap|))))
+ (OR (|bpName| |ps|) (|bpBVString| |ps|) (|bpTrap| |ps|))))
(DEFUN |bpBoundVariablelist| (|ps|)
(COND
@@ -1220,7 +1224,7 @@
(|bpPush| |ps|
(|bfColonAppend| (|bpPop2| |ps|)
(|bpPop1| |ps|))))
- (|bpTrap|))
+ (|bpTrap| |ps|))
NIL))))
(RETURN NIL))
(T (|bpPush| |ps| (|append| (|bpPop2| |ps|) (|bpPop1| |ps|))))))
@@ -1245,10 +1249,10 @@
(|bpPush| |ps| (|bfLocal| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T
(AND (|bpArgumentList| |ps|)
- (OR (|bpEqPeek| 'DOT)
- (AND (|bpEqPeek| 'BEC)
+ (OR (|bpEqPeek| |ps| 'DOT)
+ (AND (|bpEqPeek| |ps| 'BEC)
(|bpPush| |ps| (|bfPlace| (|bpPop1| |ps|))))
- (|bpTrap|)))
+ (|bpTrap| |ps|)))
(COND
((|bpEqKey| |ps| 'DOT)
(AND (|bpList| |ps| #'|bpPrimary| 'DOT) (|bpChecknull| |ps|)
@@ -1260,11 +1264,11 @@
(LET* (|a|)
(PROGN
(SETQ |a| (|bpPop1| |ps|))
- (COND ((NULL |a|) (|bpTrap|)) (T (|bpPush| |ps| |a|))))))
+ (COND ((NULL |a|) (|bpTrap| |ps|)) (T (|bpPush| |ps| |a|))))))
(DEFUN |bpStruct| (|ps|)
(AND (|bpEqKey| |ps| 'STRUCTURE) (|bpRequire| |ps| #'|bpName|)
- (OR (|bpEqKey| |ps| 'DEF) (|bpTrap|))
+ (OR (|bpEqKey| |ps| 'DEF) (|bpTrap| |ps|))
(OR (|bpRecord| |ps|) (|bpTypeList| |ps|))
(|bpPush| |ps| (|%Structure| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
@@ -1274,7 +1278,7 @@
(SETQ |s| (|bpState| |ps|))
(COND
((AND (|bpName| |ps|) (EQ (|bpPop1| |ps|) '|Record|))
- (AND (OR (|bpParenthesized| |ps| #'|bpFieldList|) (|bpTrap|))
+ (AND (OR (|bpParenthesized| |ps| #'|bpFieldList|) (|bpTrap| |ps|))
(|bpGlobalAccessors| |ps|)
(|bpPush| |ps|
(|%Record| (|bfUntuple| (|bpPop2| |ps|))
@@ -1286,14 +1290,14 @@
(DEFUN |bpGlobalAccessors| (|ps|)
(COND
((|bpEqKey| |ps| 'WITH)
- (OR (|bpPileBracketed| |ps| #'|bpAccessorDefinitionList|) (|bpTrap|)))
+ (OR (|bpPileBracketed| |ps| #'|bpAccessorDefinitionList|) (|bpTrap| |ps|)))
(T (|bpPush| |ps| NIL))))
(DEFUN |bpAccessorDefinitionList| (|ps|)
(|bpListAndRecover| |ps| #'|bpAccessorDefinition|))
(DEFUN |bpAccessorDefinition| (|ps|)
- (AND (|bpRequire| |ps| #'|bpName|) (OR (|bpEqKey| |ps| 'DEF) (|bpTrap|))
+ (AND (|bpRequire| |ps| #'|bpName|) (OR (|bpEqKey| |ps| 'DEF) (|bpTrap| |ps|))
(|bpRequire| |ps| #'|bpFieldSection|)
(|bpPush| |ps| (|%AccessorDef| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
@@ -1336,8 +1340,9 @@
(DEFUN |bpCasePatternVarList| (|ps|) (|bpTuple| |ps| #'|bpCasePatternVar|))
(DEFUN |bpCaseItem| (|ps|)
- (AND (OR (|bpTerm| |ps| #'|bpCasePatternVarList|) (|bpTrap|))
- (OR (|bpEqKey| |ps| 'EXIT) (|bpTrap|)) (|bpRequire| |ps| #'|bpWhere|)
+ (AND (OR (|bpTerm| |ps| #'|bpCasePatternVarList|) (|bpTrap| |ps|))
+ (OR (|bpEqKey| |ps| 'EXIT) (|bpTrap| |ps|))
+ (|bpRequire| |ps| #'|bpWhere|)
(|bpPush| |ps| (|bfCaseItem| (|bpPop2| |ps|) (|bpPop1| |ps|)))))
(DEFUN |bpOutItem| (|ps|)
@@ -1346,7 +1351,16 @@
(LET* ((|$op| NIL) (|$GenVarCounter| 0))
(DECLARE (SPECIAL |$op| |$GenVarCounter|))
(PROGN
- (|bpRequire| |ps| #'|bpComma|)
+ (LET ((#1=#:G721
+ (CATCH :OPEN-AXIOM-CATCH-POINT (|bpRequire| |ps| #'|bpComma|))))
+ (COND
+ ((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
+ (COND
+ ((EQUAL (CAR #2=(CDR #1#)) '(|BootSpecificError|))
+ (LET ((|e| (CDR #2#)))
+ (PROGN (|bpSpecificErrorHere| |e|) (|bpTrap| |ps|))))
+ (T (THROW :OPEN-AXIOM-CATCH-POINT #1#))))
+ (T #1#)))
(SETQ |b| (|bpPop1| |ps|))
(SETQ |t|
(COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index c9d4a9d5..c7567e89 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -563,7 +563,8 @@
(EQ (CAR |ISTMP#2|) '|Foreign|))))))
(COND ((|%hasFeature| :SBCL) 'SB-ALIEN)
((|%hasFeature| :ECL) 'FFI) (T (RETURN NIL))))
- ((|ident?| |ns|) |ns|) (T (|bpTrap|))))
+ ((|ident?| |ns|) |ns|)
+ (T (|bfSpecificErrorHere| "invalid namespace"))))
(CONS 'USE-PACKAGE (CONS (SYMBOL-NAME |z|) |user|)))))
((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN))
(CONS (CAR |x|)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 10:24:16 +0000