aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/boot/parser.boot21
-rw-r--r--src/boot/strap/ast.clisp118
-rw-r--r--src/boot/strap/parser.clisp72
-rw-r--r--src/boot/strap/tokens.clisp12
-rw-r--r--src/boot/strap/translator.clisp156
5 files changed, 228 insertions, 151 deletions
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 0b589ead..2cd2ca86 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -799,9 +799,6 @@ bpIs ps ==
bpPush(ps,bfHas(bpPop2 ps, bpPop1 ps))
true
-bpBracketConstruct(ps,f)==
- bpBracket(ps,f) and bpPush(ps,bfConstruct bpPop1 ps)
-
bpCompare ps ==
bpIs ps and (bpInfKey(ps,'(SHOEEQ SHOENE LT LE GT GE IN))
and bpRequire(ps,function bpIs)
@@ -1122,8 +1119,13 @@ bpDConstruction ps ==
--PATTERN
bpPattern ps ==
- bpBracketConstruct(ps,function bpPatternL)
- or bpChar ps or bpName ps or bpConstTok ps
+ bpBracketPattern ps
+ or bpChar ps
+ or bpName ps
+ or bpConstTok ps
+
+bpBracketPattern ps ==
+ bpBracket(ps,function bpPatternL) and bpPush(ps,bfConstruct bpPop1 ps)
bpEqual ps ==
bpEqKey(ps,"SHOEEQ") and (bpApplication ps or bpConstTok ps or
@@ -1135,7 +1137,7 @@ bpRegularPatternItem ps ==
bpName ps and
((bpEqKey(ps,"BEC") and bpRequire(ps,function bpPattern)
and bpPush(ps,bfAssign(parserLoadUnit ps,bpPop2 ps,bpPop1 ps))) or true)
- or bpBracketConstruct(ps,function bpPatternL)
+ or bpBracketPattern ps
bpRegularPatternItemL ps ==
bpRegularPatternItem ps and bpPush(ps,[bpPop1 ps])
@@ -1188,7 +1190,7 @@ bpRegularBVItem ps ==
bpBVString ps
or bpConstTok ps
or (bpName ps and (bpRegularBVItemTail ps or true))
- or bpBracketConstruct(ps,function bpPatternL)
+ or bpBracketPattern ps
bpBVString ps ==
parserTokenClass ps = "STRING" and
@@ -1216,11 +1218,12 @@ bpBoundVariablelist ps ==
bpVariable ps ==
bpParenthesized(ps,function bpBoundVariablelist) and
bpPush(ps,bfTupleIf bpPop1 ps)
- or bpBracketConstruct(ps,function bpPatternL)
+ or bpBracketPattern ps
or bpName ps or bpConstTok ps
bpAssignVariable ps ==
- bpBracketConstruct(ps,function bpPatternL) or bpAssignLHS ps
+ bpBracketPattern ps
+ or bpAssignLHS ps
bpAssignLHS ps ==
not bpName ps => false
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 4cb50b33..63c806be 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -25,122 +25,124 @@
(DEFUN |%Import| #1=(|bfVar#7|) (CONS '|%Import| (LIST . #1#)))
-(DEFUN |%ImportSignature| #1=(|bfVar#8| |bfVar#9|)
+(DEFUN |%LoadUnit| #1=(|bfVar#8|) (CONS '|%LoadUnit| (LIST . #1#)))
+
+(DEFUN |%ImportSignature| #1=(|bfVar#9| |bfVar#10| |bfVar#11|)
(CONS '|%ImportSignature| (LIST . #1#)))
-(DEFUN |%Record| #1=(|bfVar#10| |bfVar#11|) (CONS '|%Record| (LIST . #1#)))
+(DEFUN |%Record| #1=(|bfVar#12| |bfVar#13|) (CONS '|%Record| (LIST . #1#)))
-(DEFUN |%AccessorDef| #1=(|bfVar#12| |bfVar#13|)
+(DEFUN |%AccessorDef| #1=(|bfVar#14| |bfVar#15|)
(CONS '|%AccessorDef| (LIST . #1#)))
-(DEFUN |%TypeAlias| #1=(|bfVar#14| |bfVar#15|)
+(DEFUN |%TypeAlias| #1=(|bfVar#16| |bfVar#17|)
(CONS '|%TypeAlias| (LIST . #1#)))
-(DEFUN |%Signature| #1=(|bfVar#16| |bfVar#17|)
+(DEFUN |%Signature| #1=(|bfVar#18| |bfVar#19|)
(CONS '|%Signature| (LIST . #1#)))
-(DEFUN |%Mapping| #1=(|bfVar#18| |bfVar#19|) (CONS '|%Mapping| (LIST . #1#)))
+(DEFUN |%Mapping| #1=(|bfVar#20| |bfVar#21|) (CONS '|%Mapping| (LIST . #1#)))
-(DEFUN |%Forall| #1=(|bfVar#20| |bfVar#21|) (CONS '|%Forall| (LIST . #1#)))
+(DEFUN |%Forall| #1=(|bfVar#22| |bfVar#23|) (CONS '|%Forall| (LIST . #1#)))
-(DEFUN |%Dynamic| #1=(|bfVar#22|) (CONS '|%Dynamic| (LIST . #1#)))
+(DEFUN |%Dynamic| #1=(|bfVar#24|) (CONS '|%Dynamic| (LIST . #1#)))
-(DEFUN |%SuffixDot| #1=(|bfVar#23|) (CONS '|%SuffixDot| (LIST . #1#)))
+(DEFUN |%SuffixDot| #1=(|bfVar#25|) (CONS '|%SuffixDot| (LIST . #1#)))
-(DEFUN |%Quote| #1=(|bfVar#24|) (CONS '|%Quote| (LIST . #1#)))
+(DEFUN |%Quote| #1=(|bfVar#26|) (CONS '|%Quote| (LIST . #1#)))
-(DEFUN |%EqualPattern| #1=(|bfVar#25|) (CONS '|%EqualPattern| (LIST . #1#)))
+(DEFUN |%EqualPattern| #1=(|bfVar#27|) (CONS '|%EqualPattern| (LIST . #1#)))
-(DEFUN |%Colon| #1=(|bfVar#26|) (CONS '|%Colon| (LIST . #1#)))
+(DEFUN |%Colon| #1=(|bfVar#28|) (CONS '|%Colon| (LIST . #1#)))
-(DEFUN |%QualifiedName| #1=(|bfVar#27| |bfVar#28|)
+(DEFUN |%QualifiedName| #1=(|bfVar#29| |bfVar#30|)
(CONS '|%QualifiedName| (LIST . #1#)))
-(DEFUN |%Restrict| #1=(|bfVar#29| |bfVar#30|) (CONS '|%Restrict| (LIST . #1#)))
+(DEFUN |%Restrict| #1=(|bfVar#31| |bfVar#32|) (CONS '|%Restrict| (LIST . #1#)))
-(DEFUN |%DefaultValue| #1=(|bfVar#31| |bfVar#32|)
+(DEFUN |%DefaultValue| #1=(|bfVar#33| |bfVar#34|)
(CONS '|%DefaultValue| (LIST . #1#)))
-(DEFUN |%Key| #1=(|bfVar#33| |bfVar#34|) (CONS '|%Key| (LIST . #1#)))
+(DEFUN |%Key| #1=(|bfVar#35| |bfVar#36|) (CONS '|%Key| (LIST . #1#)))
-(DEFUN |%Bracket| #1=(|bfVar#35|) (CONS '|%Bracket| (LIST . #1#)))
+(DEFUN |%Bracket| #1=(|bfVar#37|) (CONS '|%Bracket| (LIST . #1#)))
-(DEFUN |%UnboundedSegment| #1=(|bfVar#36|)
+(DEFUN |%UnboundedSegment| #1=(|bfVar#38|)
(CONS '|%UnboundedSegment| (LIST . #1#)))
-(DEFUN |%BoundedSgement| #1=(|bfVar#37| |bfVar#38|)
+(DEFUN |%BoundedSgement| #1=(|bfVar#39| |bfVar#40|)
(CONS '|%BoundedSgement| (LIST . #1#)))
-(DEFUN |%Tuple| #1=(|bfVar#39|) (CONS '|%Tuple| (LIST . #1#)))
+(DEFUN |%Tuple| #1=(|bfVar#41|) (CONS '|%Tuple| (LIST . #1#)))
-(DEFUN |%ColonAppend| #1=(|bfVar#40| |bfVar#41|)
+(DEFUN |%ColonAppend| #1=(|bfVar#42| |bfVar#43|)
(CONS '|%ColonAppend| (LIST . #1#)))
-(DEFUN |%Is| #1=(|bfVar#42| |bfVar#43|) (CONS '|%Is| (LIST . #1#)))
+(DEFUN |%Is| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Is| (LIST . #1#)))
-(DEFUN |%Isnt| #1=(|bfVar#44| |bfVar#45|) (CONS '|%Isnt| (LIST . #1#)))
+(DEFUN |%Isnt| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Isnt| (LIST . #1#)))
-(DEFUN |%Reduce| #1=(|bfVar#46| |bfVar#47|) (CONS '|%Reduce| (LIST . #1#)))
+(DEFUN |%Reduce| #1=(|bfVar#48| |bfVar#49|) (CONS '|%Reduce| (LIST . #1#)))
-(DEFUN |%PrefixExpr| #1=(|bfVar#48| |bfVar#49|)
+(DEFUN |%PrefixExpr| #1=(|bfVar#50| |bfVar#51|)
(CONS '|%PrefixExpr| (LIST . #1#)))
-(DEFUN |%Call| #1=(|bfVar#50| |bfVar#51|) (CONS '|%Call| (LIST . #1#)))
+(DEFUN |%Call| #1=(|bfVar#52| |bfVar#53|) (CONS '|%Call| (LIST . #1#)))
-(DEFUN |%InfixExpr| #1=(|bfVar#52| |bfVar#53| |bfVar#54|)
+(DEFUN |%InfixExpr| #1=(|bfVar#54| |bfVar#55| |bfVar#56|)
(CONS '|%InfixExpr| (LIST . #1#)))
-(DEFUN |%ConstantDefinition| #1=(|bfVar#55| |bfVar#56|)
+(DEFUN |%ConstantDefinition| #1=(|bfVar#57| |bfVar#58|)
(CONS '|%ConstantDefinition| (LIST . #1#)))
-(DEFUN |%Definition| #1=(|bfVar#57| |bfVar#58| |bfVar#59|)
+(DEFUN |%Definition| #1=(|bfVar#59| |bfVar#60| |bfVar#61|)
(CONS '|%Definition| (LIST . #1#)))
-(DEFUN |%Macro| #1=(|bfVar#60| |bfVar#61| |bfVar#62|)
+(DEFUN |%Macro| #1=(|bfVar#62| |bfVar#63| |bfVar#64|)
(CONS '|%Macro| (LIST . #1#)))
-(DEFUN |%Lambda| #1=(|bfVar#63| |bfVar#64|) (CONS '|%Lambda| (LIST . #1#)))
+(DEFUN |%Lambda| #1=(|bfVar#65| |bfVar#66|) (CONS '|%Lambda| (LIST . #1#)))
-(DEFUN |%SuchThat| #1=(|bfVar#65|) (CONS '|%SuchThat| (LIST . #1#)))
+(DEFUN |%SuchThat| #1=(|bfVar#67|) (CONS '|%SuchThat| (LIST . #1#)))
-(DEFUN |%Assignment| #1=(|bfVar#66| |bfVar#67|)
+(DEFUN |%Assignment| #1=(|bfVar#68| |bfVar#69|)
(CONS '|%Assignment| (LIST . #1#)))
-(DEFUN |%While| #1=(|bfVar#68|) (CONS '|%While| (LIST . #1#)))
+(DEFUN |%While| #1=(|bfVar#70|) (CONS '|%While| (LIST . #1#)))
-(DEFUN |%Until| #1=(|bfVar#69|) (CONS '|%Until| (LIST . #1#)))
+(DEFUN |%Until| #1=(|bfVar#71|) (CONS '|%Until| (LIST . #1#)))
-(DEFUN |%For| #1=(|bfVar#70| |bfVar#71| |bfVar#72|) (CONS '|%For| (LIST . #1#)))
+(DEFUN |%For| #1=(|bfVar#72| |bfVar#73| |bfVar#74|) (CONS '|%For| (LIST . #1#)))
-(DEFUN |%Implies| #1=(|bfVar#73| |bfVar#74|) (CONS '|%Implies| (LIST . #1#)))
+(DEFUN |%Implies| #1=(|bfVar#75| |bfVar#76|) (CONS '|%Implies| (LIST . #1#)))
-(DEFUN |%Iterators| #1=(|bfVar#75|) (CONS '|%Iterators| (LIST . #1#)))
+(DEFUN |%Iterators| #1=(|bfVar#77|) (CONS '|%Iterators| (LIST . #1#)))
-(DEFUN |%Cross| #1=(|bfVar#76|) (CONS '|%Cross| (LIST . #1#)))
+(DEFUN |%Cross| #1=(|bfVar#78|) (CONS '|%Cross| (LIST . #1#)))
-(DEFUN |%Repeat| #1=(|bfVar#77| |bfVar#78|) (CONS '|%Repeat| (LIST . #1#)))
+(DEFUN |%Repeat| #1=(|bfVar#79| |bfVar#80|) (CONS '|%Repeat| (LIST . #1#)))
-(DEFUN |%Pile| #1=(|bfVar#79|) (CONS '|%Pile| (LIST . #1#)))
+(DEFUN |%Pile| #1=(|bfVar#81|) (CONS '|%Pile| (LIST . #1#)))
-(DEFUN |%Append| #1=(|bfVar#80|) (CONS '|%Append| (LIST . #1#)))
+(DEFUN |%Append| #1=(|bfVar#82|) (CONS '|%Append| (LIST . #1#)))
-(DEFUN |%Case| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Case| (LIST . #1#)))
+(DEFUN |%Case| #1=(|bfVar#83| |bfVar#84|) (CONS '|%Case| (LIST . #1#)))
-(DEFUN |%Return| #1=(|bfVar#83|) (CONS '|%Return| (LIST . #1#)))
+(DEFUN |%Return| #1=(|bfVar#85|) (CONS '|%Return| (LIST . #1#)))
-(DEFUN |%Leave| #1=(|bfVar#84|) (CONS '|%Leave| (LIST . #1#)))
+(DEFUN |%Leave| #1=(|bfVar#86|) (CONS '|%Leave| (LIST . #1#)))
-(DEFUN |%Throw| #1=(|bfVar#85|) (CONS '|%Throw| (LIST . #1#)))
+(DEFUN |%Throw| #1=(|bfVar#87|) (CONS '|%Throw| (LIST . #1#)))
-(DEFUN |%Catch| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Catch| (LIST . #1#)))
+(DEFUN |%Catch| #1=(|bfVar#88| |bfVar#89|) (CONS '|%Catch| (LIST . #1#)))
-(DEFUN |%Finally| #1=(|bfVar#88|) (CONS '|%Finally| (LIST . #1#)))
+(DEFUN |%Finally| #1=(|bfVar#90|) (CONS '|%Finally| (LIST . #1#)))
-(DEFUN |%Try| #1=(|bfVar#89| |bfVar#90|) (CONS '|%Try| (LIST . #1#)))
+(DEFUN |%Try| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Try| (LIST . #1#)))
-(DEFUN |%Where| #1=(|bfVar#91| |bfVar#92|) (CONS '|%Where| (LIST . #1#)))
+(DEFUN |%Where| #1=(|bfVar#93| |bfVar#94|) (CONS '|%Where| (LIST . #1#)))
-(DEFUN |%Structure| #1=(|bfVar#93| |bfVar#94|)
+(DEFUN |%Structure| #1=(|bfVar#95| |bfVar#96|)
(CONS '|%Structure| (LIST . #1#)))
(DEFSTRUCT (|%LoadUnit| (:COPIER |copy%LoadUnit|))
@@ -3824,9 +3826,9 @@
(DEFPARAMETER |$ffs| NIL)
-(DEFUN |genImportDeclaration| (|op| |sig|)
- (LET* (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
- (DECLARE (SPECIAL |$ffs|))
+(DEFUN |genImportDeclaration| (|op| |sig| |dom|)
+ (LET* (|lib| |s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
+ (DECLARE (SPECIAL |$foreignLoadUnits| |$ffs|))
(COND
((NOT
(AND (CONSP |sig|) (EQ (CAR |sig|) '|%Signature|)
@@ -3853,6 +3855,14 @@
(T (COND ((AND |s| (SYMBOLP |s|)) (SETQ |s| (LIST |s|))))
(SETQ |$ffs| (CONS |op| |$ffs|))
(COND
+ ((AND (CONSP |dom|) (EQ (CAR |dom|) '|%LoadUnit|)
+ (PROGN
+ (SETQ |ISTMP#1| (CDR |dom|))
+ (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
+ (PROGN (SETQ |lib| (CAR |ISTMP#1|)) T)))
+ (NOT (|symbolMember?| |lib| |$foreignLoadUnits|)))
+ (SETQ |$foreignLoadUnits| (CONS |lib| |$foreignLoadUnits|))))
+ (COND
((|%hasFeature| :GCL) (|genGCLnativeTranslation| |op| |s| |t| |op'|))
((|%hasFeature| :SBCL) (|genSBCLnativeTranslation| |op| |s| |t| |op'|))
((|%hasFeature| :CLISP)
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)
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index aede083d..7aae98ae 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -84,10 +84,10 @@
(LET* (|s|)
(COND
((SETQ |s|
- (WITH-HASH-TABLE-ITERATOR (#1=#:G391 |shoeKeyTable|)
+ (WITH-HASH-TABLE-ITERATOR (#1=#:G392 |shoeKeyTable|)
(LET ((|bfVar#1| NIL))
(LOOP
- (MULTIPLE-VALUE-BIND (#2=#:G392 |k| |v|)
+ (MULTIPLE-VALUE-BIND (#2=#:G393 |k| |v|)
(#1#)
(COND ((NOT #2#) (RETURN |bfVar#1|))
(T
@@ -138,9 +138,9 @@
(COND ((> |i| 255) (RETURN NIL)) (T (SETF (ELT |a| |i|) |b|)))
(SETQ |i| (+ |i| 1))))
|a|))
- (WITH-HASH-TABLE-ITERATOR (#1=#:G393 |shoeKeyTable|)
+ (WITH-HASH-TABLE-ITERATOR (#1=#:G394 |shoeKeyTable|)
(LOOP
- (MULTIPLE-VALUE-BIND (#2=#:G394 |s| #:G395)
+ (MULTIPLE-VALUE-BIND (#2=#:G395 |s| #:G396)
(#1#)
(COND ((NOT #2#) (RETURN NIL)) (T (|shoeInsert| |s| |d|))))))
|d|)))
@@ -154,9 +154,9 @@
(LET ((|i| 0))
(LOOP (COND ((> |i| 255) (RETURN NIL)) (T (SETF (SBIT |a| |i|) 0)))
(SETQ |i| (+ |i| 1))))
- (WITH-HASH-TABLE-ITERATOR (#1=#:G396 |shoeKeyTable|)
+ (WITH-HASH-TABLE-ITERATOR (#1=#:G397 |shoeKeyTable|)
(LOOP
- (MULTIPLE-VALUE-BIND (#2=#:G397 |k| #:G398)
+ (MULTIPLE-VALUE-BIND (#2=#:G398 |k| #:G399)
(#1#)
(COND ((NOT #2#) (RETURN NIL)) ((|shoeStartsId| (SCHAR |k| 0)) NIL)
(T (SETF (SBIT |a| (CHAR-CODE (SCHAR |k| 0))) 1))))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 8e7ab21c..df59ddc4 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -16,56 +16,83 @@
(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
(EXPORT
'(|evalBootFile| |loadNativeModule| |loadSystemRuntimeCore|
- |string2BootTree| |genImportDeclaration| |retainFile?|)))
+ |compileBootHandler| |string2BootTree|
+ |genImportDeclaration| |retainFile?|)))
(DEFPARAMETER |$currentModuleName| NIL)
+(DEFPARAMETER |$foreignLoadUnits| NIL)
+
(DEFPARAMETER |$foreignsDefsForCLisp| NIL)
(DEFUN |reallyPrettyPrint| (|x| &OPTIONAL (|st| *STANDARD-OUTPUT*))
(PROGN (|prettyPrint| |x| |st|) (TERPRI |st|)))
(DEFUN |genModuleFinalization| (|stream|)
- (LET* (|init| |setFFS|)
- (DECLARE (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName| |$ffs|))
- (COND ((NULL |$ffs|) NIL)
- ((NULL |$currentModuleName|)
- (|coreError| "current module has no name"))
- (T
- (SETQ |setFFS|
- (LIST 'SETQ '|$dynamicForeignFunctions|
- (LIST '|append!| (|quote| |$ffs|)
- '|$dynamicForeignFunctions|)))
- (|reallyPrettyPrint| (|atLoadOrExecutionTime| |setFFS|) |stream|)
- (COND
- ((|%hasFeature| :CLISP)
- (COND ((NULL |$foreignsDefsForCLisp|) NIL)
- (T
- (SETQ |init|
- (CONS 'PROGN
- (LET ((|bfVar#2| NIL)
- (|bfVar#3| NIL)
- (|bfVar#1| |$foreignsDefsForCLisp|)
- (|d| NIL))
- (LOOP
- (COND
- ((OR (NOT (CONSP |bfVar#1|))
- (PROGN
- (SETQ |d| (CAR |bfVar#1|))
- NIL))
- (RETURN |bfVar#2|))
- ((NULL |bfVar#2|)
- (SETQ |bfVar#2|
- #1=(CONS
- (LIST 'EVAL (|quote| |d|))
- NIL))
- (SETQ |bfVar#3| |bfVar#2|))
- (T (RPLACD |bfVar#3| #1#)
- (SETQ |bfVar#3| (CDR |bfVar#3|))))
- (SETQ |bfVar#1| (CDR |bfVar#1|))))))
- (|reallyPrettyPrint| (|atLoadOrExecutionTime| |init|)
- |stream|))))
- (T NIL))))))
+ (LET* (|init| |setFFS| |loadUnitsForm| |loadUnits|)
+ (DECLARE
+ (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName| |$ffs|
+ |$foreignLoadUnits|))
+ (PROGN
+ (SETQ |loadUnits|
+ (LET ((|bfVar#2| NIL)
+ (|bfVar#3| NIL)
+ (|bfVar#1| |$foreignLoadUnits|)
+ (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (NOT (CONSP |bfVar#1|))
+ (PROGN (SETQ |x| (CAR |bfVar#1|)) NIL))
+ (RETURN |bfVar#2|))
+ ((NULL |bfVar#2|)
+ (SETQ |bfVar#2| #1=(CONS (SYMBOL-NAME |x|) NIL))
+ (SETQ |bfVar#3| |bfVar#2|))
+ (T (RPLACD |bfVar#3| #1#) (SETQ |bfVar#3| (CDR |bfVar#3|))))
+ (SETQ |bfVar#1| (CDR |bfVar#1|)))))
+ (COND
+ (|loadUnits|
+ (SETQ |loadUnitsForm|
+ (LIST 'MAP (|quote| '|loadNativeModule|) (|quote| |loadUnits|)))
+ (|reallyPrettyPrint| (|atLoadOrExecutionTime| |loadUnitsForm|)
+ |stream|)))
+ (COND ((NULL |$ffs|) NIL)
+ ((NULL |$currentModuleName|)
+ (|coreError| "current module has no name"))
+ (T
+ (SETQ |setFFS|
+ (LIST 'SETQ '|$dynamicForeignFunctions|
+ (LIST '|append!| (|quote| |$ffs|)
+ '|$dynamicForeignFunctions|)))
+ (|reallyPrettyPrint| (|atLoadOrExecutionTime| |setFFS|) |stream|)
+ (COND
+ ((|%hasFeature| :CLISP)
+ (COND ((NULL |$foreignsDefsForCLisp|) NIL)
+ (T
+ (SETQ |init|
+ (CONS 'PROGN
+ (LET ((|bfVar#5| NIL)
+ (|bfVar#6| NIL)
+ (|bfVar#4| |$foreignsDefsForCLisp|)
+ (|d| NIL))
+ (LOOP
+ (COND
+ ((OR (NOT (CONSP |bfVar#4|))
+ (PROGN
+ (SETQ |d| (CAR |bfVar#4|))
+ NIL))
+ (RETURN |bfVar#5|))
+ ((NULL |bfVar#5|)
+ (SETQ |bfVar#5|
+ #2=(CONS
+ (LIST 'EVAL (|quote| |d|))
+ NIL))
+ (SETQ |bfVar#6| |bfVar#5|))
+ (T (RPLACD |bfVar#6| #2#)
+ (SETQ |bfVar#6| (CDR |bfVar#6|))))
+ (SETQ |bfVar#4| (CDR |bfVar#4|))))))
+ (|reallyPrettyPrint| (|atLoadOrExecutionTime| |init|)
+ |stream|))))
+ (T NIL)))))))
(DEFUN |genOptimizeOptions| (|stream|)
(|reallyPrettyPrint|
@@ -416,7 +443,7 @@
(SETQ |ps| (|makeParserState| |toks|))
(|bpFirstTok| |ps|)
(SETQ |found|
- (LET ((#1=#:G401
+ (LET ((#1=#:G402
(CATCH :OPEN-AXIOM-CATCH-POINT (|bpOutItem| |ps|))))
(COND
((AND (CONSP #1#) (EQUAL (CAR #1#) :OPEN-AXIOM-CATCH-POINT))
@@ -632,8 +659,8 @@
(|bootImport| (SYMBOL-NAME |m|))))
(LIST (LIST 'IMPORT-MODULE (SYMBOL-NAME |m|)))))))
(|%ImportSignature|
- (LET ((|x| (CADR |b|)) (|sig| (CADDR |b|)))
- (|genImportDeclaration| |x| |sig|)))
+ (LET ((|x| (CADR |b|)) (|sig| (CADDR |b|)) (|dom| (CADDDR |b|)))
+ (|genImportDeclaration| |x| |sig| |dom|)))
(|%TypeAlias|
(LET ((|lhs| (CADR |b|)) (|rhs| (CADDR |b|)))
(LIST (|genTypeAlias| |lhs| |rhs|))))
@@ -865,13 +892,14 @@
(DEFUN |getIntermediateLispFile| (|file| |options|)
(LET* (|out|)
- (PROGN
- (SETQ |out| (NAMESTRING (|getOutputPathname| |options|)))
- (COND
- (|out|
- (CONCAT (|shoeRemoveStringIfNec| (CONCAT "." |$faslType|) |out|)
- ".clisp"))
- (T (|defaultBootToLispFile| |file|))))))
+ (BLOCK NIL
+ (PROGN
+ (SETQ |out|
+ (OR (|getOutputPathname| |options|)
+ (RETURN (|defaultBootToLispFile| |file|))))
+ (CONCAT
+ (|shoeRemoveStringIfNec| (CONCAT "." |$faslType|) (NAMESTRING |out|))
+ ".clisp")))))
(DEFUN |translateBootFile| (|progname| |options| |file|)
(LET* (|outFile|)
@@ -909,20 +937,20 @@
#'|compileBootHandler|)
(DEFUN |loadNativeModule| (|m|)
- (COND
- ((|%hasFeature| :SBCL)
- (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m| :DONT-SAVE T))
- ((|%hasFeature| :CLISP)
- (EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|)))
- ((|%hasFeature| :ECL)
- (EVAL (LIST (|bfColonColon| 'FFI 'LOAD-FOREIGN-LIBRARY) |m|)))
- ((|%hasFeature| :CLOZURE)
- (EVAL (LIST (|bfColonColon| 'CCL 'OPEN-SHARED-LIBRARY) |m|)))
- (T (|coreError| "don't know how to load a dynamically linked module"))))
+ (PROGN
+ (SETQ |m| (CONCAT |$NativeModulePrefix| |m| |$NativeModuleExt|))
+ (COND
+ ((|%hasFeature| :SBCL)
+ (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m| :DONT-SAVE T))
+ ((|%hasFeature| :CLISP)
+ (EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|)))
+ ((|%hasFeature| :ECL)
+ (EVAL (LIST (|bfColonColon| 'FFI 'LOAD-FOREIGN-LIBRARY) |m|)))
+ ((|%hasFeature| :CLOZURE)
+ (EVAL (LIST (|bfColonColon| 'CCL 'OPEN-SHARED-LIBRARY) |m|)))
+ (T (|coreError| "don't know how to load a dynamically linked module")))))
(DEFUN |loadSystemRuntimeCore| ()
(COND ((OR (|%hasFeature| :ECL) (|%hasFeature| :GCL)) NIL)
- (T
- (|loadNativeModule|
- (CONCAT "libopen-axiom-core" |$NativeModuleExt|)))))
+ (T (|loadNativeModule| "open-axiom-core"))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-20 13:05:57 +0000