aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/parser.clisp
diff options
context:
space:
mode:
authorGabriel Dos Reis <gdr@axiomatics.org>2018-01-01 13:56:29 -0800
committerGabriel Dos Reis <gdr@axiomatics.org>2018-01-01 13:56:29 -0800
commitcfaa50b1a3f9461bb96c7f871e2ac05778d25786 (patch)
tree6a680033550d2fcf73ab3d2303ce9c9fd177f161 /src/boot/strap/parser.clisp
parent1612b13828475d024af2e9b565d1bbe9d937c08e (diff)
downloadopen-axiom-cfaa50b1a3f9461bb96c7f871e2ac05778d25786.tar.gz
Name bracket pattern parser
and update the boot translator Lisp cache.
Diffstat (limited to 'src/boot/strap/parser.clisp')
-rw-r--r--src/boot/strap/parser.clisp72
1 files changed, 54 insertions, 18 deletions
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 50a1b076..7bf31b92 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -387,7 +387,7 @@
(COND (|done| (RETURN NIL))
(T
(SETQ |found|
- (LET ((#1=#:G392
+ (LET ((#1=#:G393
(CATCH :OPEN-AXIOM-CATCH-POINT (FUNCALL |f| |ps|))))
(COND
((AND (CONSP #1#)
@@ -534,6 +534,42 @@
(|%Module| (|bpPop3| |ps|) (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T NIL)))
+(DEFUN |bpProvenance| (|ps|)
+ (LET* (|lib| |ISTMP#6| |ISTMP#5| |ISTMP#4| |ISTMP#3| |ISTMP#2| |ISTMP#1| |x|)
+ (BLOCK NIL
+ (COND
+ ((|bpEqKey| |ps| 'IN)
+ (OR (|bpApplication| |ps|) (RETURN (|bpTrap| |ps|)))
+ (SETQ |x| (|bpPop1| |ps|))
+ (COND
+ ((NOT
+ (AND (CONSP |x|)
+ (PROGN
+ (SETQ |ISTMP#1| (CAR |x|))
+ (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'ELT)
+ (PROGN
+ (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+ (AND (CONSP |ISTMP#2|) (EQ (CAR |ISTMP#2|) '|System|)
+ (PROGN
+ (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+ (AND (CONSP |ISTMP#3|) (NULL (CDR |ISTMP#3|))
+ (EQ (CAR |ISTMP#3|) '|LoadUnit|)))))))
+ (PROGN
+ (SETQ |ISTMP#4| (CDR |x|))
+ (AND (CONSP |ISTMP#4|) (NULL (CDR |ISTMP#4|))
+ (PROGN
+ (SETQ |ISTMP#5| (CAR |ISTMP#4|))
+ (AND (CONSP |ISTMP#5|) (EQ (CAR |ISTMP#5|) 'QUOTE)
+ (PROGN
+ (SETQ |ISTMP#6| (CDR |ISTMP#5|))
+ (AND (CONSP |ISTMP#6|) (NULL (CDR |ISTMP#6|))
+ (PROGN
+ (SETQ |lib| (CAR |ISTMP#6|))
+ T)))))))))
+ (|bpGeneralErrorHere| |ps|))
+ (T (|bpPush| |ps| (|%LoadUnit| |lib|)))))
+ (T (|bpPush| |ps| NIL))))))
+
(DEFUN |bpImport| (|ps|)
(LET* (|a|)
(COND
@@ -547,12 +583,12 @@
(T (SETQ |a| (|bpState| |ps|)) (|bpRequire| |ps| #'|bpName|)
(COND
((|bpEqPeek| |ps| 'COLON) (|bpRestore| |ps| |a|)
- (AND (|bpRequire| |ps| #'|bpSignature|)
- (OR (|bpEqKey| |ps| 'FOR) (|bpTrap| |ps|))
- (|bpRequire| |ps| #'|bpName|)
- (|bpPush| |ps|
- (|%ImportSignature| (|bpPop1| |ps|)
- (|bpPop1| |ps|)))))
+ (|bpRequire| |ps| #'|bpSignature|) (|bpProvenance| |ps|)
+ (OR (|bpEqKey| |ps| 'FOR) (|bpTrap| |ps|))
+ (|bpRequire| |ps| #'|bpName|)
+ (|bpPush| |ps|
+ (|%ImportSignature| (|bpPop1| |ps|) (|bpPop2| |ps|)
+ (|bpPop1| |ps|))))
(T (|bpPush| |ps| (|%Import| (|bpPop1| |ps|))))))))
(T NIL))))
@@ -819,9 +855,6 @@
(|bpPush| |ps| (|bfHas| (|bpPop2| |ps|) (|bpPop1| |ps|))))
(T T))))
-(DEFUN |bpBracketConstruct| (|ps| |f|)
- (AND (|bpBracket| |ps| |f|) (|bpPush| |ps| (|bfConstruct| (|bpPop1| |ps|)))))
-
(DEFUN |bpCompare| (|ps|)
(OR
(AND (|bpIs| |ps|)
@@ -1143,8 +1176,12 @@
(|bpPush| |ps| (|bfDTuple| (|bpPop1| |ps|))))))
(DEFUN |bpPattern| (|ps|)
- (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpChar| |ps|)
- (|bpName| |ps|) (|bpConstTok| |ps|)))
+ (OR (|bpBracketPattern| |ps|) (|bpChar| |ps|) (|bpName| |ps|)
+ (|bpConstTok| |ps|)))
+
+(DEFUN |bpBracketPattern| (|ps|)
+ (AND (|bpBracket| |ps| #'|bpPatternL|)
+ (|bpPush| |ps| (|bfConstruct| (|bpPop1| |ps|)))))
(DEFUN |bpEqual| (|ps|)
(AND (|bpEqKey| |ps| 'SHOEEQ)
@@ -1160,7 +1197,7 @@
(|bfAssign| (|parserLoadUnit| |ps|) (|bpPop2| |ps|)
(|bpPop1| |ps|))))
T))
- (|bpBracketConstruct| |ps| #'|bpPatternL|)))
+ (|bpBracketPattern| |ps|)))
(DEFUN |bpRegularPatternItemL| (|ps|)
(AND (|bpRegularPatternItem| |ps|) (|bpPush| |ps| (LIST (|bpPop1| |ps|)))))
@@ -1218,7 +1255,7 @@
(DEFUN |bpRegularBVItem| (|ps|)
(OR (|bpBVString| |ps|) (|bpConstTok| |ps|)
(AND (|bpName| |ps|) (OR (|bpRegularBVItemTail| |ps|) T))
- (|bpBracketConstruct| |ps| #'|bpPatternL|)))
+ (|bpBracketPattern| |ps|)))
(DEFUN |bpBVString| (|ps|)
(AND (EQ (|parserTokenClass| |ps|) 'STRING)
@@ -1259,11 +1296,10 @@
(OR
(AND (|bpParenthesized| |ps| #'|bpBoundVariablelist|)
(|bpPush| |ps| (|bfTupleIf| (|bpPop1| |ps|))))
- (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpName| |ps|)
- (|bpConstTok| |ps|)))
+ (|bpBracketPattern| |ps|) (|bpName| |ps|) (|bpConstTok| |ps|)))
(DEFUN |bpAssignVariable| (|ps|)
- (OR (|bpBracketConstruct| |ps| #'|bpPatternL|) (|bpAssignLHS| |ps|)))
+ (OR (|bpBracketPattern| |ps|) (|bpAssignLHS| |ps|)))
(DEFUN |bpAssignLHS| (|ps|)
(COND ((NOT (|bpName| |ps|)) NIL) ((|bpSignatureTail| |ps|) T)
@@ -1375,7 +1411,7 @@
(SETQ |op| (|enclosingFunction| (|parserLoadUnit| |ps|)))
(SETQ |varno| (|parserGensymSequenceNumber| |ps|))
(UNWIND-PROTECT
- (LET ((#1=#:G393
+ (LET ((#1=#:G394
(CATCH :OPEN-AXIOM-CATCH-POINT
(PROGN
(SETF (|enclosingFunction| (|parserLoadUnit| |ps|)) NIL)