aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/boot/strap/ast.clisp540
-rw-r--r--src/boot/strap/includer.clisp6
-rw-r--r--src/boot/strap/parser.clisp33
-rw-r--r--src/boot/strap/scanner.clisp10
-rw-r--r--src/boot/strap/tokens.clisp23
-rw-r--r--src/boot/strap/translator.clisp501
6 files changed, 678 insertions, 435 deletions
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index e3f18dd0..5bbd792c 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -22,9 +22,7 @@
(DEFTYPE |%Sequence| () 'SEQUENCE)
-(DEFTYPE |%List| () 'LIST)
-
-(DEFUN |Name| #0=(|bfVar#1|) (CONS '|Name| (LIST . #0#)))
+(DEFUN |%Name| #0=(|bfVar#1|) (CONS '|%Name| (LIST . #0#)))
(DEFUN |Command| #0=(|bfVar#2|) (CONS '|Command| (LIST . #0#)))
@@ -35,106 +33,111 @@
(DEFUN |ImportSignature| #0=(|bfVar#5| |bfVar#6|)
(CONS '|ImportSignature| (LIST . #0#)))
-(DEFUN |TypeAlias| #0=(|bfVar#7| |bfVar#8| |bfVar#9|)
+(DEFUN |TypeAlias| #0=(|bfVar#7| |bfVar#8|)
(CONS '|TypeAlias| (LIST . #0#)))
-(DEFUN |Signature| #0=(|bfVar#10| |bfVar#11|)
+(DEFUN |Signature| #0=(|bfVar#9| |bfVar#10|)
(CONS '|Signature| (LIST . #0#)))
-(DEFUN |Mapping| #0=(|bfVar#12| |bfVar#13|)
+(DEFUN |Mapping| #0=(|bfVar#11| |bfVar#12|)
(CONS '|Mapping| (LIST . #0#)))
-(DEFUN |SuffixDot| #0=(|bfVar#14|) (CONS '|SuffixDot| (LIST . #0#)))
+(DEFUN |SuffixDot| #0=(|bfVar#13|) (CONS '|SuffixDot| (LIST . #0#)))
-(DEFUN |Quote| #0=(|bfVar#15|) (CONS '|Quote| (LIST . #0#)))
+(DEFUN |Quote| #0=(|bfVar#14|) (CONS '|Quote| (LIST . #0#)))
-(DEFUN |EqualName| #0=(|bfVar#16|) (CONS '|EqualName| (LIST . #0#)))
+(DEFUN |EqualName| #0=(|bfVar#15|) (CONS '|EqualName| (LIST . #0#)))
-(DEFUN |Colon| #0=(|bfVar#17|) (CONS '|Colon| (LIST . #0#)))
+(DEFUN |Colon| #0=(|bfVar#16|) (CONS '|Colon| (LIST . #0#)))
-(DEFUN |QualifiedName| #0=(|bfVar#18| |bfVar#19|)
+(DEFUN |QualifiedName| #0=(|bfVar#17| |bfVar#18|)
(CONS '|QualifiedName| (LIST . #0#)))
-(DEFUN |Bracket| #0=(|bfVar#20|) (CONS '|Bracket| (LIST . #0#)))
+(DEFUN |%DefaultValue| #0=(|bfVar#19| |bfVar#20|)
+ (CONS '|%DefaultValue| (LIST . #0#)))
-(DEFUN |UnboundedSegment| #0=(|bfVar#21|)
+(DEFUN |Bracket| #0=(|bfVar#21|) (CONS '|Bracket| (LIST . #0#)))
+
+(DEFUN |UnboundedSegment| #0=(|bfVar#22|)
(CONS '|UnboundedSegment| (LIST . #0#)))
-(DEFUN |BoundedSgement| #0=(|bfVar#22| |bfVar#23|)
+(DEFUN |BoundedSgement| #0=(|bfVar#23| |bfVar#24|)
(CONS '|BoundedSgement| (LIST . #0#)))
-(DEFUN |Tuple| #0=(|bfVar#24|) (CONS '|Tuple| (LIST . #0#)))
+(DEFUN |Tuple| #0=(|bfVar#25|) (CONS '|Tuple| (LIST . #0#)))
-(DEFUN |ColonAppend| #0=(|bfVar#25| |bfVar#26|)
+(DEFUN |ColonAppend| #0=(|bfVar#26| |bfVar#27|)
(CONS '|ColonAppend| (LIST . #0#)))
-(DEFUN |Is| #0=(|bfVar#27| |bfVar#28|) (CONS '|Is| (LIST . #0#)))
+(DEFUN |Is| #0=(|bfVar#28| |bfVar#29|) (CONS '|Is| (LIST . #0#)))
-(DEFUN |Isnt| #0=(|bfVar#29| |bfVar#30|) (CONS '|Isnt| (LIST . #0#)))
+(DEFUN |Isnt| #0=(|bfVar#30| |bfVar#31|) (CONS '|Isnt| (LIST . #0#)))
-(DEFUN |Reduce| #0=(|bfVar#31| |bfVar#32|)
+(DEFUN |Reduce| #0=(|bfVar#32| |bfVar#33|)
(CONS '|Reduce| (LIST . #0#)))
-(DEFUN |PrefixExpr| #0=(|bfVar#33| |bfVar#34|)
+(DEFUN |PrefixExpr| #0=(|bfVar#34| |bfVar#35|)
(CONS '|PrefixExpr| (LIST . #0#)))
-(DEFUN |Call| #0=(|bfVar#35| |bfVar#36|) (CONS '|Call| (LIST . #0#)))
+(DEFUN |Call| #0=(|bfVar#36| |bfVar#37|) (CONS '|Call| (LIST . #0#)))
-(DEFUN |InfixExpr| #0=(|bfVar#37| |bfVar#38| |bfVar#39|)
+(DEFUN |InfixExpr| #0=(|bfVar#38| |bfVar#39| |bfVar#40|)
(CONS '|InfixExpr| (LIST . #0#)))
-(DEFUN |ConstantDefinition| #0=(|bfVar#40| |bfVar#41|)
+(DEFUN |ConstantDefinition| #0=(|bfVar#41| |bfVar#42|)
(CONS '|ConstantDefinition| (LIST . #0#)))
-(DEFUN |Definition| #0=(|bfVar#42| |bfVar#43| |bfVar#44| |bfVar#45|)
+(DEFUN |Definition| #0=(|bfVar#43| |bfVar#44| |bfVar#45| |bfVar#46|)
(CONS '|Definition| (LIST . #0#)))
-(DEFUN |Macro| #0=(|bfVar#46| |bfVar#47| |bfVar#48|)
+(DEFUN |Macro| #0=(|bfVar#47| |bfVar#48| |bfVar#49|)
(CONS '|Macro| (LIST . #0#)))
-(DEFUN |SuchThat| #0=(|bfVar#49|) (CONS '|SuchThat| (LIST . #0#)))
+(DEFUN |SuchThat| #0=(|bfVar#50|) (CONS '|SuchThat| (LIST . #0#)))
-(DEFUN |Assignment| #0=(|bfVar#50| |bfVar#51|)
+(DEFUN |Assignment| #0=(|bfVar#51| |bfVar#52|)
(CONS '|Assignment| (LIST . #0#)))
-(DEFUN |While| #0=(|bfVar#52|) (CONS '|While| (LIST . #0#)))
+(DEFUN |While| #0=(|bfVar#53|) (CONS '|While| (LIST . #0#)))
-(DEFUN |Until| #0=(|bfVar#53|) (CONS '|Until| (LIST . #0#)))
+(DEFUN |Until| #0=(|bfVar#54|) (CONS '|Until| (LIST . #0#)))
-(DEFUN |For| #0=(|bfVar#54| |bfVar#55| |bfVar#56|)
+(DEFUN |For| #0=(|bfVar#55| |bfVar#56| |bfVar#57|)
(CONS '|For| (LIST . #0#)))
-(DEFUN |Exit| #0=(|bfVar#57| |bfVar#58|) (CONS '|Exit| (LIST . #0#)))
+(DEFUN |Exit| #0=(|bfVar#58| |bfVar#59|) (CONS '|Exit| (LIST . #0#)))
-(DEFUN |Iterators| #0=(|bfVar#59|) (CONS '|Iterators| (LIST . #0#)))
+(DEFUN |Iterators| #0=(|bfVar#60|) (CONS '|Iterators| (LIST . #0#)))
-(DEFUN |Cross| #0=(|bfVar#60|) (CONS '|Cross| (LIST . #0#)))
+(DEFUN |Cross| #0=(|bfVar#61|) (CONS '|Cross| (LIST . #0#)))
-(DEFUN |Repeat| #0=(|bfVar#61| |bfVar#62|)
+(DEFUN |Repeat| #0=(|bfVar#62| |bfVar#63|)
(CONS '|Repeat| (LIST . #0#)))
-(DEFUN |Pile| #0=(|bfVar#63|) (CONS '|Pile| (LIST . #0#)))
+(DEFUN |Pile| #0=(|bfVar#64|) (CONS '|Pile| (LIST . #0#)))
-(DEFUN |Append| #0=(|bfVar#64|) (CONS '|Append| (LIST . #0#)))
+(DEFUN |Append| #0=(|bfVar#65|) (CONS '|Append| (LIST . #0#)))
-(DEFUN |Case| #0=(|bfVar#65| |bfVar#66|) (CONS '|Case| (LIST . #0#)))
+(DEFUN |Case| #0=(|bfVar#66| |bfVar#67|) (CONS '|Case| (LIST . #0#)))
-(DEFUN |Return| #0=(|bfVar#67|) (CONS '|Return| (LIST . #0#)))
+(DEFUN |Return| #0=(|bfVar#68|) (CONS '|Return| (LIST . #0#)))
-(DEFUN |%Throw| #0=(|bfVar#68|) (CONS '|%Throw| (LIST . #0#)))
+(DEFUN |%Throw| #0=(|bfVar#69|) (CONS '|%Throw| (LIST . #0#)))
-(DEFUN |%Catch| #0=(|bfVar#69|) (CONS '|%Catch| (LIST . #0#)))
+(DEFUN |%Catch| #0=(|bfVar#70|) (CONS '|%Catch| (LIST . #0#)))
-(DEFUN |%Try| #0=(|bfVar#70| |bfVar#71|) (CONS '|%Try| (LIST . #0#)))
+(DEFUN |%Try| #0=(|bfVar#71| |bfVar#72|) (CONS '|%Try| (LIST . #0#)))
-(DEFUN |Where| #0=(|bfVar#72| |bfVar#73|)
+(DEFUN |Where| #0=(|bfVar#73| |bfVar#74|)
(CONS '|Where| (LIST . #0#)))
-(DEFUN |Structure| #0=(|bfVar#74| |bfVar#75|)
+(DEFUN |Structure| #0=(|bfVar#75| |bfVar#76|)
(CONS '|Structure| (LIST . #0#)))
(DEFPARAMETER |$inDefIS| NIL)
+(DEFUN |quote| (|x|) (LIST 'QUOTE |x|))
+
(DECLAIM (FTYPE (FUNCTION NIL |%Symbol|) |bfGenSymbol|))
(DEFUN |bfGenSymbol| ()
@@ -151,11 +154,14 @@
(DEFUN |bfColon| (|x|) (LIST 'COLON |x|))
-(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Symbol|) |%Symbol|)
+(DECLAIM (FTYPE (FUNCTION (|%Symbol| |%Symbol|) |%Symbol|)
|bfColonColon|))
(DEFUN |bfColonColon| (|package| |name|)
- (INTERN (SYMBOL-NAME |name|) |package|))
+ (COND
+ ((AND (|%hasFeature| :CLISP) (MEMBER |package| '(EXT FFI)))
+ (FIND-SYMBOL (SYMBOL-NAME |name|) |package|))
+ ('T (INTERN (SYMBOL-NAME |name|) |package|))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |bfSymbol|))
@@ -216,14 +222,14 @@
(DEFUN |bfCompDef| (|x|)
(PROG (|body| |ISTMP#3| |args| |ISTMP#2| |op| |ISTMP#1| |def|
- |bfVar#77| |bfVar#76|)
+ |bfVar#78| |bfVar#77|)
(RETURN
(PROGN
- (SETQ |bfVar#76| |x|)
- (SETQ |bfVar#77| (CDR |bfVar#76|))
- (CASE (CAR |bfVar#76|)
+ (SETQ |bfVar#77| |x|)
+ (SETQ |bfVar#78| (CDR |bfVar#77|))
+ (CASE (CAR |bfVar#77|)
(|ConstantDefinition|
- (LET ((|n| (CAR |bfVar#77|)) (|e| (CADR |bfVar#77|)))
+ (LET ((|n| (CAR |bfVar#78|)) (|e| (CADR |bfVar#78|)))
|x|))
(T (COND
((AND (CONSP |x|)
@@ -275,22 +281,22 @@
(PROGN
(SETQ |a| (COND ((|bfTupleP| |b|) (CDR |b|)) ('T (LIST |b|))))
(COND
- ((LET ((|bfVar#79| NIL) (|bfVar#78| |a|) (|x| NIL))
+ ((LET ((|bfVar#80| NIL) (|bfVar#79| |a|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#78|)
- (PROGN (SETQ |x| (CAR |bfVar#78|)) NIL))
- (RETURN |bfVar#79|))
+ ((OR (ATOM |bfVar#79|)
+ (PROGN (SETQ |x| (CAR |bfVar#79|)) NIL))
+ (RETURN |bfVar#80|))
('T
(PROGN
- (SETQ |bfVar#79|
+ (SETQ |bfVar#80|
(AND (CONSP |x|) (EQ (CAR |x|) 'COLON)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
(AND (CONSP |ISTMP#1|)
(EQ (CDR |ISTMP#1|) NIL)))))
- (COND (|bfVar#79| (RETURN |bfVar#79|))))))
- (SETQ |bfVar#78| (CDR |bfVar#78|))))
+ (COND (|bfVar#80| (RETURN |bfVar#80|))))))
+ (SETQ |bfVar#79| (CDR |bfVar#79|))))
(|bfMakeCons| |a|))
('T (CONS 'LIST |a|)))))))
@@ -450,19 +456,19 @@
(COND
((NULL |iters|) (LIST NIL NIL NIL NIL NIL NIL))
('T (SETQ |f| (CAR |iters|)) (SETQ |r| (|bfSep| (CDR |iters|)))
- (LET ((|bfVar#82| NIL) (|bfVar#80| |f|) (|i| NIL)
- (|bfVar#81| |r|) (|j| NIL))
+ (LET ((|bfVar#83| NIL) (|bfVar#81| |f|) (|i| NIL)
+ (|bfVar#82| |r|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#80|)
- (PROGN (SETQ |i| (CAR |bfVar#80|)) NIL)
- (ATOM |bfVar#81|)
- (PROGN (SETQ |j| (CAR |bfVar#81|)) NIL))
- (RETURN (NREVERSE |bfVar#82|)))
+ ((OR (ATOM |bfVar#81|)
+ (PROGN (SETQ |i| (CAR |bfVar#81|)) NIL)
+ (ATOM |bfVar#82|)
+ (PROGN (SETQ |j| (CAR |bfVar#82|)) NIL))
+ (RETURN (NREVERSE |bfVar#83|)))
('T
- (SETQ |bfVar#82| (CONS (APPEND |i| |j|) |bfVar#82|))))
- (SETQ |bfVar#80| (CDR |bfVar#80|))
- (SETQ |bfVar#81| (CDR |bfVar#81|)))))))))
+ (SETQ |bfVar#83| (CONS (APPEND |i| |j|) |bfVar#83|))))
+ (SETQ |bfVar#81| (CDR |bfVar#81|))
+ (SETQ |bfVar#82| (CDR |bfVar#82|)))))))))
(DEFUN |bfReduce| (|op| |y|)
(PROG (|it| |ny| |g2| |body| |g1| |g| |init| |a|)
@@ -577,25 +583,25 @@
(COND
(|vars| (SETQ |loop|
(LIST 'LET
- (LET ((|bfVar#85| NIL)
- (|bfVar#83| |vars|) (|v| NIL)
- (|bfVar#84| |inits|) (|i| NIL))
+ (LET ((|bfVar#86| NIL)
+ (|bfVar#84| |vars|) (|v| NIL)
+ (|bfVar#85| |inits|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#83|)
+ ((OR (ATOM |bfVar#84|)
(PROGN
- (SETQ |v| (CAR |bfVar#83|))
+ (SETQ |v| (CAR |bfVar#84|))
NIL)
- (ATOM |bfVar#84|)
+ (ATOM |bfVar#85|)
(PROGN
- (SETQ |i| (CAR |bfVar#84|))
+ (SETQ |i| (CAR |bfVar#85|))
NIL))
- (RETURN (NREVERSE |bfVar#85|)))
+ (RETURN (NREVERSE |bfVar#86|)))
('T
- (SETQ |bfVar#85|
- (CONS (LIST |v| |i|) |bfVar#85|))))
- (SETQ |bfVar#83| (CDR |bfVar#83|))
- (SETQ |bfVar#84| (CDR |bfVar#84|))))
+ (SETQ |bfVar#86|
+ (CONS (LIST |v| |i|) |bfVar#86|))))
+ (SETQ |bfVar#84| (CDR |bfVar#84|))
+ (SETQ |bfVar#85| (CDR |bfVar#85|))))
|loop|))))
|loop|))))
@@ -754,7 +760,7 @@
(SETQ |ISTMP#1| (CDR |lhs|))
(AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL))))
(|bfLetForm| |lhs| |rhs|))
- ((AND (IDENTP |rhs|) (NULL (|bfCONTAINED| |rhs| |lhs|)))
+ ((AND (IDENTP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|)))
(PROGN
(SETQ |rhs1| (|bfLET2| |lhs| |rhs|))
(COND
@@ -1160,7 +1166,7 @@
((SETQ |a| (GET |x| 'SHOERENAME)) (CAR |a|))
(#0='T |x|)))
(COND
- ((AND |$translatingOldBoot| (NULL (|bfSameMeaning| |x|)))
+ ((AND |$translatingOldBoot| (NOT (|bfSameMeaning| |x|)))
(PROGN
(SETQ |oldName| (|bfGetOldBootName| |x|))
(COND
@@ -1210,17 +1216,17 @@
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'OR
- (LET ((|bfVar#87| NIL) (|bfVar#86| |l|) (|c| NIL))
+ (LET ((|bfVar#88| NIL) (|bfVar#87| |l|) (|c| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#86|)
- (PROGN (SETQ |c| (CAR |bfVar#86|)) NIL))
- (RETURN (NREVERSE |bfVar#87|)))
+ ((OR (ATOM |bfVar#87|)
+ (PROGN (SETQ |c| (CAR |bfVar#87|)) NIL))
+ (RETURN (NREVERSE |bfVar#88|)))
('T
- (SETQ |bfVar#87|
+ (SETQ |bfVar#88|
(APPEND (REVERSE (|bfFlatten| 'OR |c|))
- |bfVar#87|))))
- (SETQ |bfVar#86| (CDR |bfVar#86|))))))))
+ |bfVar#88|))))
+ (SETQ |bfVar#87| (CDR |bfVar#87|))))))))
(DEFUN |bfAND| (|l|)
(COND
@@ -1228,17 +1234,17 @@
((NULL (CDR |l|)) (CAR |l|))
('T
(CONS 'AND
- (LET ((|bfVar#89| NIL) (|bfVar#88| |l|) (|c| NIL))
+ (LET ((|bfVar#90| NIL) (|bfVar#89| |l|) (|c| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#88|)
- (PROGN (SETQ |c| (CAR |bfVar#88|)) NIL))
- (RETURN (NREVERSE |bfVar#89|)))
+ ((OR (ATOM |bfVar#89|)
+ (PROGN (SETQ |c| (CAR |bfVar#89|)) NIL))
+ (RETURN (NREVERSE |bfVar#90|)))
('T
- (SETQ |bfVar#89|
+ (SETQ |bfVar#90|
(APPEND (REVERSE (|bfFlatten| 'AND |c|))
- |bfVar#89|))))
- (SETQ |bfVar#88| (CDR |bfVar#88|))))))))
+ |bfVar#90|))))
+ (SETQ |bfVar#89| (CDR |bfVar#89|))))))))
(DEFUN |defQuoteId| (|x|)
(AND (EQCAR |x| 'QUOTE) (IDENTP (CADR |x|))))
@@ -1273,55 +1279,55 @@
(SETQ |nargl| (CADDR . #0#))
(SETQ |largl| (CADDDR . #0#))
(SETQ |sb|
- (LET ((|bfVar#92| NIL) (|bfVar#90| |nargl|) (|i| NIL)
- (|bfVar#91| |sgargl|) (|j| NIL))
+ (LET ((|bfVar#93| NIL) (|bfVar#91| |nargl|) (|i| NIL)
+ (|bfVar#92| |sgargl|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#90|)
- (PROGN (SETQ |i| (CAR |bfVar#90|)) NIL)
- (ATOM |bfVar#91|)
- (PROGN (SETQ |j| (CAR |bfVar#91|)) NIL))
- (RETURN (NREVERSE |bfVar#92|)))
+ ((OR (ATOM |bfVar#91|)
+ (PROGN (SETQ |i| (CAR |bfVar#91|)) NIL)
+ (ATOM |bfVar#92|)
+ (PROGN (SETQ |j| (CAR |bfVar#92|)) NIL))
+ (RETURN (NREVERSE |bfVar#93|)))
(#1='T
- (SETQ |bfVar#92| (CONS (CONS |i| |j|) |bfVar#92|))))
- (SETQ |bfVar#90| (CDR |bfVar#90|))
- (SETQ |bfVar#91| (CDR |bfVar#91|)))))
+ (SETQ |bfVar#93| (CONS (CONS |i| |j|) |bfVar#93|))))
+ (SETQ |bfVar#91| (CDR |bfVar#91|))
+ (SETQ |bfVar#92| (CDR |bfVar#92|)))))
(SETQ |body| (SUBLIS |sb| |body|))
(SETQ |sb2|
- (LET ((|bfVar#95| NIL) (|bfVar#93| |sgargl|) (|i| NIL)
- (|bfVar#94| |largl|) (|j| NIL))
+ (LET ((|bfVar#96| NIL) (|bfVar#94| |sgargl|) (|i| NIL)
+ (|bfVar#95| |largl|) (|j| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#93|)
- (PROGN (SETQ |i| (CAR |bfVar#93|)) NIL)
- (ATOM |bfVar#94|)
- (PROGN (SETQ |j| (CAR |bfVar#94|)) NIL))
- (RETURN (NREVERSE |bfVar#95|)))
+ ((OR (ATOM |bfVar#94|)
+ (PROGN (SETQ |i| (CAR |bfVar#94|)) NIL)
+ (ATOM |bfVar#95|)
+ (PROGN (SETQ |j| (CAR |bfVar#95|)) NIL))
+ (RETURN (NREVERSE |bfVar#96|)))
(#1#
- (SETQ |bfVar#95|
+ (SETQ |bfVar#96|
(CONS (LIST 'CONS (LIST 'QUOTE |i|) |j|)
- |bfVar#95|))))
- (SETQ |bfVar#93| (CDR |bfVar#93|))
- (SETQ |bfVar#94| (CDR |bfVar#94|)))))
+ |bfVar#96|))))
+ (SETQ |bfVar#94| (CDR |bfVar#94|))
+ (SETQ |bfVar#95| (CDR |bfVar#95|)))))
(SETQ |body|
(LIST 'SUBLIS (CONS 'LIST |sb2|) (LIST 'QUOTE |body|)))
(SETQ |lamex| (LIST 'MLAMBDA |gargl| |body|))
(SETQ |def| (LIST |op| |lamex|))
(|bfTuple|
(CONS (|shoeComp| |def|)
- (LET ((|bfVar#97| NIL) (|bfVar#96| |$wheredefs|)
+ (LET ((|bfVar#98| NIL) (|bfVar#97| |$wheredefs|)
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#96|)
- (PROGN (SETQ |d| (CAR |bfVar#96|)) NIL))
- (RETURN (NREVERSE |bfVar#97|)))
+ ((OR (ATOM |bfVar#97|)
+ (PROGN (SETQ |d| (CAR |bfVar#97|)) NIL))
+ (RETURN (NREVERSE |bfVar#98|)))
(#1#
- (SETQ |bfVar#97|
+ (SETQ |bfVar#98|
(APPEND (REVERSE
(|shoeComps| (|bfDef1| |d|)))
- |bfVar#97|))))
- (SETQ |bfVar#96| (CDR |bfVar#96|))))))))))
+ |bfVar#98|))))
+ (SETQ |bfVar#97| (CDR |bfVar#97|))))))))))
(DEFUN |bfGargl| (|argl|)
(PROG (|f| |d| |c| |b| |a| |LETTMP#1|)
@@ -1341,13 +1347,13 @@
(LIST (CONS |f| |a|) (CONS |f| |b|) (CONS (CAR |argl|) |c|)
(CONS |f| |d|)))))))))
-(DEFUN |bfDef1| (|bfVar#98|)
+(DEFUN |bfDef1| (|bfVar#99|)
(PROG (|arglp| |control| |quotes| |LETTMP#1| |argl| |body| |args|
|op| |defOp|)
(RETURN
(PROGN
- (SETQ |defOp| (CAR |bfVar#98|))
- (SETQ |op| (CADR . #0=(|bfVar#98|)))
+ (SETQ |defOp| (CAR |bfVar#99|))
+ (SETQ |op| (CADR . #0=(|bfVar#99|)))
(SETQ |args| (CADDR . #0#))
(SETQ |body| (CADDDR . #0#))
(SETQ |argl|
@@ -1393,31 +1399,31 @@
(|bfCompHash| |op1| |arg1| |body1|)))
('T
(|bfTuple|
- (LET ((|bfVar#100| NIL)
- (|bfVar#99|
+ (LET ((|bfVar#101| NIL)
+ (|bfVar#100|
(CONS (LIST |defOp| |op| |args| |body|)
|$wheredefs|))
(|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#99|)
- (PROGN (SETQ |d| (CAR |bfVar#99|)) NIL))
- (RETURN (NREVERSE |bfVar#100|)))
+ ((OR (ATOM |bfVar#100|)
+ (PROGN (SETQ |d| (CAR |bfVar#100|)) NIL))
+ (RETURN (NREVERSE |bfVar#101|)))
('T
- (SETQ |bfVar#100|
+ (SETQ |bfVar#101|
(APPEND (REVERSE (|shoeComps| (|bfDef1| |d|)))
- |bfVar#100|))))
- (SETQ |bfVar#99| (CDR |bfVar#99|))))))))))
+ |bfVar#101|))))
+ (SETQ |bfVar#100| (CDR |bfVar#100|))))))))))
(DEFUN |shoeComps| (|x|)
- (LET ((|bfVar#102| NIL) (|bfVar#101| |x|) (|def| NIL))
+ (LET ((|bfVar#103| NIL) (|bfVar#102| |x|) (|def| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#101|)
- (PROGN (SETQ |def| (CAR |bfVar#101|)) NIL))
- (RETURN (NREVERSE |bfVar#102|)))
- ('T (SETQ |bfVar#102| (CONS (|shoeComp| |def|) |bfVar#102|))))
- (SETQ |bfVar#101| (CDR |bfVar#101|)))))
+ ((OR (ATOM |bfVar#102|)
+ (PROGN (SETQ |def| (CAR |bfVar#102|)) NIL))
+ (RETURN (NREVERSE |bfVar#103|)))
+ ('T (SETQ |bfVar#103| (CONS (|shoeComp| |def|) |bfVar#103|))))
+ (SETQ |bfVar#102| (CDR |bfVar#102|)))))
(DEFUN |shoeComp| (|x|)
(PROG (|a|)
@@ -1431,6 +1437,18 @@
(CONS 'DEFMACRO
(CONS (CAR |x|) (CONS (CADR |a|) (CDDR |a|))))))))))
+(DEFUN |bfParameterList| (|p1| |p2|)
+ (COND
+ ((AND (NULL |p2|) (NOT (ATOM |p1|))) |p1|)
+ ((AND (CONSP |p1|) (EQ (CAR |p1|) '&OPTIONAL))
+ (COND
+ ((NOT (AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL)))
+ (|bpSpecificErrorHere| "default value required"))
+ (#0='T (CONS (CAR |p1|) (APPEND (CDR |p1|) (CDR |p2|))))))
+ ((AND (CONSP |p2|) (EQ (CAR |p2|) '&OPTIONAL))
+ (CONS |p1| (CONS (CAR |p2|) (CDR |p2|))))
+ (#0# (CONS |p1| |p2|))))
+
(DEFUN |bfInsertLet| (|x| |body|)
(PROG (|body2| |name2| |norq1| |b1| |body1| |name1| |norq| |LETTMP#1|
|b| |a| |ISTMP#1|)
@@ -1459,10 +1477,10 @@
(SETQ |norq1| (CADR . #3=(|LETTMP#1|)))
(SETQ |name2| (CADDR . #3#)) (SETQ |body2| (CADDDR . #3#))
(LIST (OR |b| |b1|) (CONS |norq| |norq1|)
- (CONS |name1| |name2|) |body2|))))))
+ (|bfParameterList| |name1| |name2|) |body2|))))))
(DEFUN |bfInsertLet1| (|y| |body|)
- (PROG (|g| |b| |r| |ISTMP#2| |l| |ISTMP#1|)
+ (PROG (|bfVar#105| |bfVar#104| |g| |b| |r| |ISTMP#2| |l| |ISTMP#1|)
(RETURN
(COND
((AND (CONSP |y|) (EQ (CAR |y|) 'L%T)
@@ -1483,13 +1501,25 @@
(AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
(PROGN (SETQ |b| (CAR |ISTMP#1|)) #0#))))
(LIST T 'QUOTE |b| |body|))
- ('T (SETQ |g| (|bfGenSymbol|))
- (COND
- ((ATOM |y|) (LIST NIL NIL |g| |body|))
- ('T
- (LIST NIL NIL |g|
- (|bfMKPROGN|
- (LIST (|bfLET| (|compFluidize| |y|) |g|) |body|))))))))))
+ (#1='T
+ (PROGN
+ (SETQ |g| (|bfGenSymbol|))
+ (COND
+ ((ATOM |y|) (LIST NIL NIL |g| |body|))
+ (#1#
+ (PROGN
+ (SETQ |bfVar#104| |y|)
+ (SETQ |bfVar#105| (CDR |bfVar#104|))
+ (CASE (CAR |bfVar#104|)
+ (|%DefaultValue|
+ (LET ((|p| (CAR |bfVar#105|))
+ (|v| (CADR |bfVar#105|)))
+ (LIST NIL NIL (LIST '&OPTIONAL (LIST |p| |v|))
+ |body|)))
+ (T (LIST NIL NIL |g|
+ (|bfMKPROGN|
+ (LIST (|bfLET| (|compFluidize| |y|) |g|)
+ |body|))))))))))))))
(DEFUN |shoeCompTran| (|x|)
(PROG (|$dollarVars| |$locVars| |$fluidVars| |fvs| |fl| |fvars|
@@ -1546,17 +1576,17 @@
(COND
((MEMBER |op| '(RETURN RETURN-FROM)) T)
((MEMBER |op| '(LET PROG LOOP BLOCK DECLARE LAMBDA)) NIL)
- ((LET ((|bfVar#104| NIL) (|bfVar#103| |body|) (|t| NIL))
+ ((LET ((|bfVar#107| NIL) (|bfVar#106| |body|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#103|)
- (PROGN (SETQ |t| (CAR |bfVar#103|)) NIL))
- (RETURN |bfVar#104|))
+ ((OR (ATOM |bfVar#106|)
+ (PROGN (SETQ |t| (CAR |bfVar#106|)) NIL))
+ (RETURN |bfVar#107|))
('T
(PROGN
- (SETQ |bfVar#104| (|needsPROG| |t|))
- (COND (|bfVar#104| (RETURN |bfVar#104|))))))
- (SETQ |bfVar#103| (CDR |bfVar#103|))))
+ (SETQ |bfVar#107| (|needsPROG| |t|))
+ (COND (|bfVar#107| (RETURN |bfVar#107|))))))
+ (SETQ |bfVar#106| (CDR |bfVar#106|))))
T)
(#0# NIL))))))))
@@ -1623,7 +1653,7 @@
(COND
((IDENTP |l|)
(COND
- ((NULL (|bfBeginsDollar| |l|))
+ ((NOT (|bfBeginsDollar| |l|))
(SETQ |$locVars|
(COND
((MEMQ |l| |$locVars|) |$locVars|)
@@ -1644,37 +1674,37 @@
((MEMQ U '(PROG LAMBDA))
(PROGN
(SETQ |newbindings| NIL)
- (LET ((|bfVar#105| (CADR |x|)) (|y| NIL))
+ (LET ((|bfVar#108| (CADR |x|)) (|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#105|)
- (PROGN (SETQ |y| (CAR |bfVar#105|)) NIL))
+ ((OR (ATOM |bfVar#108|)
+ (PROGN (SETQ |y| (CAR |bfVar#108|)) NIL))
(RETURN NIL))
(#1='T
(COND
- ((NULL (MEMQ |y| |$locVars|))
+ ((NOT (MEMQ |y| |$locVars|))
(IDENTITY
(PROGN
(SETQ |$locVars| (CONS |y| |$locVars|))
(SETQ |newbindings|
(CONS |y| |newbindings|))))))))
- (SETQ |bfVar#105| (CDR |bfVar#105|))))
+ (SETQ |bfVar#108| (CDR |bfVar#108|))))
(SETQ |res| (|shoeCompTran1| (CDDR |x|)))
(SETQ |$locVars|
- (LET ((|bfVar#107| NIL) (|bfVar#106| |$locVars|)
+ (LET ((|bfVar#110| NIL) (|bfVar#109| |$locVars|)
(|y| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#106|)
+ ((OR (ATOM |bfVar#109|)
(PROGN
- (SETQ |y| (CAR |bfVar#106|))
+ (SETQ |y| (CAR |bfVar#109|))
NIL))
- (RETURN (NREVERSE |bfVar#107|)))
+ (RETURN (NREVERSE |bfVar#110|)))
(#1#
- (AND (NULL (MEMQ |y| |newbindings|))
- (SETQ |bfVar#107|
- (CONS |y| |bfVar#107|)))))
- (SETQ |bfVar#106| (CDR |bfVar#106|)))))))
+ (AND (NOT (MEMQ |y| |newbindings|))
+ (SETQ |bfVar#110|
+ (CONS |y| |bfVar#110|)))))
+ (SETQ |bfVar#109| (CDR |bfVar#109|)))))))
(#0#
(PROGN
(|shoeCompTran1| (CAR |x|))
@@ -1761,14 +1791,14 @@
(RETURN
(PROGN
(SETQ |a|
- (LET ((|bfVar#108| NIL) (|c| |l|))
+ (LET ((|bfVar#111| NIL) (|c| |l|))
(LOOP
(COND
- ((ATOM |c|) (RETURN (NREVERSE |bfVar#108|)))
+ ((ATOM |c|) (RETURN (NREVERSE |bfVar#111|)))
('T
- (SETQ |bfVar#108|
+ (SETQ |bfVar#111|
(APPEND (REVERSE (|bfFlattenSeq| |c|))
- |bfVar#108|))))
+ |bfVar#111|))))
(SETQ |c| (CDR |c|)))))
(COND
((NULL |a|) NIL)
@@ -1788,17 +1818,17 @@
((EQCAR |f| 'PROGN)
(COND
((CDR |x|)
- (LET ((|bfVar#110| NIL) (|bfVar#109| (CDR |f|))
+ (LET ((|bfVar#113| NIL) (|bfVar#112| (CDR |f|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#109|)
- (PROGN (SETQ |i| (CAR |bfVar#109|)) NIL))
- (RETURN (NREVERSE |bfVar#110|)))
+ ((OR (ATOM |bfVar#112|)
+ (PROGN (SETQ |i| (CAR |bfVar#112|)) NIL))
+ (RETURN (NREVERSE |bfVar#113|)))
('T
- (AND (NULL (ATOM |i|))
- (SETQ |bfVar#110| (CONS |i| |bfVar#110|)))))
- (SETQ |bfVar#109| (CDR |bfVar#109|)))))
+ (AND (NOT (ATOM |i|))
+ (SETQ |bfVar#113| (CONS |i| |bfVar#113|)))))
+ (SETQ |bfVar#112| (CDR |bfVar#112|)))))
(#0# (CDR |f|))))
(#0# (LIST |f|)))))))))
@@ -1811,11 +1841,11 @@
(#0='T
(PROGN
(SETQ |transform|
- (LET ((|bfVar#112| NIL) (|bfVar#111| |l|) (|x| NIL))
+ (LET ((|bfVar#115| NIL) (|bfVar#114| |l|) (|x| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#111|)
- (PROGN (SETQ |x| (CAR |bfVar#111|)) NIL)
+ ((OR (ATOM |bfVar#114|)
+ (PROGN (SETQ |x| (CAR |bfVar#114|)) NIL)
(NOT (AND (CONSP |x|) (EQ (CAR |x|) 'COND)
(PROGN
(SETQ |ISTMP#1| (CDR |x|))
@@ -1850,11 +1880,11 @@
(SETQ |b|
(CAR |ISTMP#5|))
'T))))))))))))))
- (RETURN (NREVERSE |bfVar#112|)))
+ (RETURN (NREVERSE |bfVar#115|)))
('T
- (SETQ |bfVar#112|
- (CONS (LIST |a| |b|) |bfVar#112|))))
- (SETQ |bfVar#111| (CDR |bfVar#111|)))))
+ (SETQ |bfVar#115|
+ (CONS (LIST |a| |b|) |bfVar#115|))))
+ (SETQ |bfVar#114| (CDR |bfVar#114|)))))
(SETQ |no| (LENGTH |transform|))
(SETQ |before| (|bfTake| |no| |l|))
(SETQ |aft| (|bfDrop| |no| |l|))
@@ -1887,12 +1917,12 @@
(SETQ |defs| (CADR . #0=(|LETTMP#1|)))
(SETQ |nondefs| (CADDR . #0#))
(SETQ |a|
- (LET ((|bfVar#114| NIL) (|bfVar#113| |defs|) (|d| NIL))
+ (LET ((|bfVar#117| NIL) (|bfVar#116| |defs|) (|d| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#113|)
- (PROGN (SETQ |d| (CAR |bfVar#113|)) NIL))
- (RETURN (NREVERSE |bfVar#114|)))
+ ((OR (ATOM |bfVar#116|)
+ (PROGN (SETQ |d| (CAR |bfVar#116|)) NIL))
+ (RETURN (NREVERSE |bfVar#117|)))
('T
(AND (CONSP |d|)
(PROGN
@@ -1911,11 +1941,11 @@
(PROGN
(SETQ |body| (CAR |ISTMP#3|))
'T)))))))
- (SETQ |bfVar#114|
+ (SETQ |bfVar#117|
(CONS (LIST |def| |op| |args|
(|bfSUBLIS| |opassoc| |body|))
- |bfVar#114|)))))
- (SETQ |bfVar#113| (CDR |bfVar#113|)))))
+ |bfVar#117|)))))
+ (SETQ |bfVar#116| (CDR |bfVar#116|)))))
(SETQ |$wheredefs| (APPEND |a| |$wheredefs|))
(|bfMKPROGN|
(|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|))))))))
@@ -1993,16 +2023,16 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%List|) |bfStruct|))
(DEFUN |bfStruct| (|name| |arglist|)
- (|bfTuple| (LET ((|bfVar#116| NIL) (|bfVar#115| |arglist|) (|i| NIL))
+ (|bfTuple| (LET ((|bfVar#119| NIL) (|bfVar#118| |arglist|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#115|)
- (PROGN (SETQ |i| (CAR |bfVar#115|)) NIL))
- (RETURN (NREVERSE |bfVar#116|)))
+ ((OR (ATOM |bfVar#118|)
+ (PROGN (SETQ |i| (CAR |bfVar#118|)) NIL))
+ (RETURN (NREVERSE |bfVar#119|)))
('T
- (SETQ |bfVar#116|
- (CONS (|bfCreateDef| |i|) |bfVar#116|))))
- (SETQ |bfVar#115| (CDR |bfVar#115|))))))
+ (SETQ |bfVar#119|
+ (CONS (|bfCreateDef| |i|) |bfVar#119|))))
+ (SETQ |bfVar#118| (CDR |bfVar#118|))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%List|) |bfCreateDef|))
@@ -2014,17 +2044,17 @@
(LIST 'SETQ |f| (LIST 'LIST (LIST 'QUOTE |f|))))
('T
(SETQ |a|
- (LET ((|bfVar#118| NIL) (|bfVar#117| (CDR |x|))
+ (LET ((|bfVar#121| NIL) (|bfVar#120| (CDR |x|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#117|)
- (PROGN (SETQ |i| (CAR |bfVar#117|)) NIL))
- (RETURN (NREVERSE |bfVar#118|)))
+ ((OR (ATOM |bfVar#120|)
+ (PROGN (SETQ |i| (CAR |bfVar#120|)) NIL))
+ (RETURN (NREVERSE |bfVar#121|)))
('T
- (SETQ |bfVar#118|
- (CONS (|bfGenSymbol|) |bfVar#118|))))
- (SETQ |bfVar#117| (CDR |bfVar#117|)))))
+ (SETQ |bfVar#121|
+ (CONS (|bfGenSymbol|) |bfVar#121|))))
+ (SETQ |bfVar#120| (CDR |bfVar#120|)))))
(LIST 'DEFUN (CAR |x|) |a|
(LIST 'CONS (LIST 'QUOTE (CAR |x|)) (CONS 'LIST |a|))))))))
@@ -2051,22 +2081,22 @@
(DEFUN |bfCaseItems| (|g| |x|)
(PROG (|j| |ISTMP#1| |i|)
(RETURN
- (LET ((|bfVar#121| NIL) (|bfVar#120| |x|) (|bfVar#119| NIL))
+ (LET ((|bfVar#124| NIL) (|bfVar#123| |x|) (|bfVar#122| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#120|)
- (PROGN (SETQ |bfVar#119| (CAR |bfVar#120|)) NIL))
- (RETURN (NREVERSE |bfVar#121|)))
+ ((OR (ATOM |bfVar#123|)
+ (PROGN (SETQ |bfVar#122| (CAR |bfVar#123|)) NIL))
+ (RETURN (NREVERSE |bfVar#124|)))
('T
- (AND (CONSP |bfVar#119|)
+ (AND (CONSP |bfVar#122|)
(PROGN
- (SETQ |i| (CAR |bfVar#119|))
- (SETQ |ISTMP#1| (CDR |bfVar#119|))
+ (SETQ |i| (CAR |bfVar#122|))
+ (SETQ |ISTMP#1| (CDR |bfVar#122|))
(AND (CONSP |ISTMP#1|) (EQ (CDR |ISTMP#1|) NIL)
(PROGN (SETQ |j| (CAR |ISTMP#1|)) 'T)))
- (SETQ |bfVar#121|
- (CONS (|bfCI| |g| |i| |j|) |bfVar#121|)))))
- (SETQ |bfVar#120| (CDR |bfVar#120|)))))))
+ (SETQ |bfVar#124|
+ (CONS (|bfCI| |g| |i| |j|) |bfVar#124|)))))
+ (SETQ |bfVar#123| (CDR |bfVar#123|)))))))
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|) |bfCI|))
@@ -2079,18 +2109,18 @@
((NULL |a|) (LIST (CAR |x|) |y|))
('T
(SETQ |b|
- (LET ((|bfVar#123| NIL) (|bfVar#122| |a|) (|i| NIL)
+ (LET ((|bfVar#126| NIL) (|bfVar#125| |a|) (|i| NIL)
(|j| 0))
(LOOP
(COND
- ((OR (ATOM |bfVar#122|)
- (PROGN (SETQ |i| (CAR |bfVar#122|)) NIL))
- (RETURN (NREVERSE |bfVar#123|)))
+ ((OR (ATOM |bfVar#125|)
+ (PROGN (SETQ |i| (CAR |bfVar#125|)) NIL))
+ (RETURN (NREVERSE |bfVar#126|)))
('T
- (SETQ |bfVar#123|
+ (SETQ |bfVar#126|
(CONS (LIST |i| (|bfCARCDR| |j| |g|))
- |bfVar#123|))))
- (SETQ |bfVar#122| (CDR |bfVar#122|))
+ |bfVar#126|))))
+ (SETQ |bfVar#125| (CDR |bfVar#125|))
(SETQ |j| (+ |j| 1)))))
(LIST (CAR |x|) (LIST 'LET |b| |y|))))))))
@@ -2107,17 +2137,17 @@
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List|) |%Thing|) |bfTry|))
(DEFUN |bfTry| (|e| |cs|)
- (PROG (|bfVar#125| |bfVar#124|)
+ (PROG (|bfVar#128| |bfVar#127|)
(RETURN
(COND
((NULL |cs|) |e|)
(#0='T
(PROGN
- (SETQ |bfVar#124| (CAR |cs|))
- (SETQ |bfVar#125| (CDR |bfVar#124|))
- (CASE (CAR |bfVar#124|)
+ (SETQ |bfVar#127| (CAR |cs|))
+ (SETQ |bfVar#128| (CDR |bfVar#127|))
+ (CASE (CAR |bfVar#127|)
(|%Catch|
- (LET ((|tag| (CAR |bfVar#125|)))
+ (LET ((|tag| (CAR |bfVar#128|)))
(COND
((ATOM |tag|)
(|bfTry| (LIST 'CATCH (LIST 'QUOTE |tag|) |e|)
@@ -2128,6 +2158,52 @@
(DEFUN |bfThrow| (|e|)
(COND
((ATOM |e|) (LIST 'THROW (LIST 'QUOTE |e|) NIL))
- ((NULL (ATOM (CAR |e|))) (|bpTrap|))
+ ((NOT (ATOM (CAR |e|))) (|bpTrap|))
('T (CONS 'THROW (CONS (LIST 'QUOTE (CAR |e|)) (CDR |e|))))))
+(DEFUN |backquote| (|form| |params|)
+ (COND
+ ((NULL |params|) (|quote| |form|))
+ ((ATOM |form|)
+ (COND ((MEMBER |form| |params|) |form|) (#0='T (|quote| |form|))))
+ (#0#
+ (CONS 'LIST
+ (LET ((|bfVar#130| NIL) (|bfVar#129| |form|) (|t| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#129|)
+ (PROGN (SETQ |t| (CAR |bfVar#129|)) NIL))
+ (RETURN (NREVERSE |bfVar#130|)))
+ ('T
+ (SETQ |bfVar#130|
+ (CONS (|backquote| |t| |params|) |bfVar#130|))))
+ (SETQ |bfVar#129| (CDR |bfVar#129|))))))))
+
+(DEFUN |genTypeAlias| (|head| |body|)
+ (PROG (|args| |op|)
+ (RETURN
+ (PROGN
+ (SETQ |op| (CAR |head|))
+ (SETQ |args| (CDR |head|))
+ (LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|))))))
+
+(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |coreSymbol|))
+
+(DEFUN |coreSymbol| (|s|) (INTERN (SYMBOL-NAME |s|) '|AxiomCore|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |bootSymbol|))
+
+(DEFUN |bootSymbol| (|s|) (INTERN (SYMBOL-NAME |s|)))
+
+(DEFUN |nativeType| (|t|)
+ (PROG (|t'|)
+ (DECLARE (SPECIAL |$NativeTypeTable|))
+ (RETURN
+ (COND
+ ((NULL |t|) |t|)
+ ((SETQ |t'| (ASSOC (|coreSymbol| |t|) |$NativeTypeTable|))
+ (|bootSymbol| (CDR |t'|)))
+ ('T
+ (|fatalError|
+ (CONCAT "unsupported native type: " (SYMBOL-NAME |t|))))))))
+
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 61726ec9..d8b645cc 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -97,7 +97,7 @@
(CDR |stream|)))
((AND (EQUAL (SUBSTRING |a| 0 |sz|) |name|)
(< |sz| (LENGTH |a|))
- (NULL (|shoeIdChar| (ELT |a| |sz|))))
+ (NOT (|shoeIdChar| (ELT |a| |sz|))))
(LIST |lines| |stream|))
('T
(|shoePackageStartsAt| |lines| |sz| |name|
@@ -425,7 +425,7 @@
(|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
((SETQ |command| (|shoeElseIf?| |string|))
(COND
- ((AND |keep1| (NULL |b1|))
+ ((AND |keep1| (NOT |b1|))
(|shoeThen| (CONS T (CDR |keep|))
(CONS (STTOMC |command|) (CDR |b|)) |t|))
(#0#
@@ -433,7 +433,7 @@
(CONS NIL (CDR |b|)) |t|))))
((SETQ |command| (|shoeElse?| |string|))
(COND
- ((AND |keep1| (NULL |b1|))
+ ((AND |keep1| (NOT |b1|))
(|shoeElse| (CONS T (CDR |keep|))
(CONS T (CDR |b|)) |t|))
(#0#
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index d9cce37d..9a9c2cf7 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -362,7 +362,7 @@
(COND
((EQ |found| 'TRAPPED) (SETQ |$inputStream| |c|)
(|bpRecoverTrap|))
- ((NULL |found|) (SETQ |$inputStream| |c|)
+ ((NOT |found|) (SETQ |$inputStream| |c|)
(|bpGeneralErrorHere|) (|bpRecoverTrap|)))
(COND
((|bpEqKey| 'BACKSET) (SETQ |c| |$inputStream|))
@@ -458,16 +458,17 @@
('T NIL)))
(DEFUN |bpTypeAliasDefition| ()
- (AND (OR (|bpName|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|)
- (|bpPush| (|TypeAlias| (|bpPop2|) NIL (|bpPop1|)))))
+ (AND (OR (|bpTerm|) (|bpTrap|)) (|bpEqKey| 'TDEF) (|bpLogical|)
+ (|bpPush| (|TypeAlias| (|bpPop2|) (|bpPop1|)))))
(DEFUN |bpSignature| ()
(AND (|bpName|) (|bpEqKey| 'COLON) (|bpMapping|)
(|bpPush| (|Signature| (|bpPop2|) (|bpPop1|)))))
(DEFUN |bpMapping| ()
- (AND (OR (|bpName|) (|bpIdList|)) (|bpEqKey| 'ARROW) (|bpName|)
- (|bpPush| (|Mapping| (|bpPop1|) (|bpPop1|)))))
+ (AND (OR (|bpName|) (|bpParenthesized| #'|bpIdList|))
+ (|bpEqKey| 'ARROW) (|bpName|)
+ (|bpPush| (|Mapping| (|bpPop1|) (|bfUntuple| (|bpPop1|))))))
(DEFUN |bpCancel| ()
(PROG (|a|)
@@ -506,7 +507,7 @@
(DECLARE (SPECIAL |$ttok| |$stok|))
(RETURN
(COND
- ((AND (EQCAR |$stok| 'KEY) (NULL (|bpExceptions|)))
+ ((AND (EQCAR |$stok| 'KEY) (NOT (|bpExceptions|)))
(PROGN
(SETQ |a| (GET |$ttok| 'SHOEINF))
(COND
@@ -1009,17 +1010,19 @@
(|bpPush| (APPEND (|bpPop2|) (|bpPop1|))))
T)))
+(DEFUN |bpRegularBVItemTail| ()
+ (OR (AND (|bpEqKey| 'COLON) (OR (|bpApplication|) (|bpTrap|))
+ (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|))
+ (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'IS) (OR (|bpPattern|) (|bpTrap|))
+ (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
+ (AND (|bpEqKey| 'DEF) (OR (|bpApplication|) (|bpTrap|))
+ (|bpPush| (|%DefaultValue| (|bpPop2|) (|bpPop1|))))))
+
(DEFUN |bpRegularBVItem| ()
(OR (|bpBVString|) (|bpConstTok|)
- (AND (|bpName|)
- (OR (AND (|bpEqKey| 'COLON)
- (OR (|bpApplication|) (|bpTrap|))
- (|bpPush| (|bfTagged| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'BEC) (OR (|bpPattern|) (|bpTrap|))
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- (AND (|bpEqKey| 'IS) (OR (|bpPattern|) (|bpTrap|))
- (|bpPush| (|bfAssign| (|bpPop2|) (|bpPop1|))))
- T))
+ (AND (|bpName|) (OR (|bpRegularBVItemTail|) T))
(|bpBracketConstruct| #'|bpPatternL|)))
(DEFUN |bpBVString| ()
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 2689a8bf..4d3406f4 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -71,7 +71,7 @@
(SETQ |$floatok| T)
(SETQ |$linepos| |s|)
(COND
- ((NULL (|shoeNextLine| |s|)) (CONS NIL NIL))
+ ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
((NULL |$n|) (|shoeLineToks| |$r|))
(#0='T
(PROGN
@@ -136,7 +136,7 @@
(DECLARE (SPECIAL |$ln| |$r| |$n|))
(RETURN
(COND
- ((NULL (|shoeNextLine| |s|)) (CONS |s| |string|))
+ ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|))
((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|))
(#0='T
@@ -348,13 +348,13 @@
(COND
(|$floatok| (|shoePossFloat| |w|))
(#0='T (|shoeLeafKey| |w|))))
- (#0# (SETQ |$floatok| (NULL (|shoeCloser| |w|)))
+ (#0# (SETQ |$floatok| (NOT (|shoeCloser| |w|)))
(|shoeLeafKey| |w|))))
(DEFUN |shoePossFloat| (|w|)
(DECLARE (SPECIAL |$ln| |$sz| |$n|))
(COND
- ((OR (NOT (< |$n| |$sz|)) (NULL (|shoeDigit| (ELT |$ln| |$n|))))
+ ((OR (NOT (< |$n| |$sz|)) (NOT (|shoeDigit| (ELT |$ln| |$n|))))
(|shoeLeafKey| |w|))
('T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|))))
@@ -560,7 +560,7 @@
(DEFUN |shoeKeyWord| (|st|) (GETHASH |st| |shoeKeyTable|))
(DEFUN |shoeKeyWordP| (|st|)
- (NULL (NULL (GETHASH |st| |shoeKeyTable|))))
+ (NOT (NULL (GETHASH |st| |shoeKeyTable|))))
(DEFUN |shoeMatch| (|l| |i|)
(|shoeSubStringMatch| |l| |shoeDict| |i|))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index d1d701d2..97b0f8ff 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -145,7 +145,7 @@
(RETURN NIL))
(#0#
(COND
- ((NULL (|shoeStartsId| (ELT |k| 0)))
+ ((NOT (|shoeStartsId| (ELT |k| 0)))
(BVEC-SETELT |a| (QENUM |k| 0) 1)))))
(SETQ |bfVar#5| (CDR |bfVar#5|))))
|a|))))
@@ -209,25 +209,26 @@
(LIST '|lastNode| 'LAST) (LIST 'LAST '|last|)
(LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
(LIST '|nconc| 'NCONC) (LIST '|nil| NIL)
- (LIST '|not| 'NULL) (LIST 'NOT 'NULL)
+ (LIST '|not| 'NOT)
(LIST '|nreverse| 'NREVERSE)
(LIST '|null| 'NULL) (LIST '|or| 'OR)
(LIST '|otherwise| 'T) (LIST 'PAIRP 'CONSP)
(LIST '|removeDuplicates| 'REMDUP)
(LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
+ (LIST '|second| 'CADR)
(LIST '|setDifference| 'SETDIFFERENCE)
(LIST '|setIntersection| 'INTERSECTION)
(LIST '|setPart| 'SETELT)
(LIST '|setUnion| 'UNION) (LIST '|size| 'SIZE)
(LIST '|strconc| 'CONCAT)
(LIST '|substitute| 'SUBST)
- (LIST '|take| 'TAKE) (LIST '|true| 'T)
- (LIST 'PLUS '+) (LIST 'MINUS '-)
- (LIST 'TIMES '*) (LIST 'POWER 'EXPT)
- (LIST 'SLASH '/) (LIST 'LT '<) (LIST 'GT '>)
- (LIST 'LE '<=) (LIST 'GE '>=)
- (LIST 'SHOEEQ 'EQUAL) (LIST 'SHOENE '/=)
- (LIST 'T 'T$)))
+ (LIST '|take| 'TAKE) (LIST '|third| 'CADDR)
+ (LIST '|true| 'T) (LIST 'PLUS '+)
+ (LIST 'MINUS '-) (LIST 'TIMES '*)
+ (LIST 'POWER 'EXPT) (LIST 'SLASH '/)
+ (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=)
+ (LIST 'GE '>=) (LIST 'SHOEEQ 'EQUAL)
+ (LIST 'SHOENE '/=) (LIST 'T 'T$)))
(|i| NIL))
(LOOP
(COND
@@ -250,7 +251,7 @@
(LIST '|lastNode| 'LASTNODE)
(LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
(LIST '|nconc| 'NCONC) (LIST '|nil| 'NIL)
- (LIST '|not| 'NULL) (LIST 'NOT 'NULL)
+ (LIST '|not| 'NOT)
(LIST '|nreverse| 'NREVERSE)
(LIST '|null| 'NULL) (LIST '|or| 'OR)
(LIST '|otherwise| 'T)
@@ -267,7 +268,7 @@
(LIST 'SUBST 'MSUBST) (LIST '|take| 'TAKE)
(LIST '|true| 'T) (LIST '|where| 'WHERE)
(LIST 'TIMES 'TIMES) (LIST 'POWER 'EXPT)
- (LIST 'NOT 'NULL) (LIST 'SHOENE 'NEQUAL)
+ (LIST 'SHOENE 'NEQUAL)
(LIST 'MINUS 'SPADDIFFERENCE)
(LIST 'SLASH 'QUOTIENT) (LIST '= 'EQUAL)
(LIST 'SHOEEQ 'EQUAL) (LIST 'ASSOC '|assoc|)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index e05baa29..d2675cea 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -20,8 +20,12 @@
((EQUAL (CDR (ASSOC (|Option| "boot") (|%systemOptions|))) "old")
(SETQ |$translatingOldBoot| T))))
+(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Thing|) |setCurrentPackage|))
+
(DEFUN |setCurrentPackage| (|x|) (SETQ *PACKAGE* |x|))
+(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) |shoeCOMPILE-FILE|))
+
(DEFUN |shoeCOMPILE-FILE| (|lspFileName|)
(COMPILE-FILE |lspFileName|))
@@ -49,24 +53,24 @@
|result|))))
(DEFUN |shoeClLines| (|a| |fn| |lines| |outfn|)
- (PROG (|$GenVarCounter|)
- (DECLARE (SPECIAL |$GenVarCounter|))
- (RETURN
- (COND
- ((NULL |a|) (|shoeNotFound| |fn|))
- ('T (SETQ |$GenVarCounter| 0)
- (|shoeOpenOutputFile| |stream| |outfn|
- (PROGN
- (LET ((|bfVar#1| |lines|) (|line| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#1|)
- (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
- (RETURN NIL))
- ('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#1| (CDR |bfVar#1|))))
- (|shoeFileTrees| (|shoeTransformStream| |a|) |stream|)))
- |outfn|)))))
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T
+ (PROGN
+ (SETQ |$GenVarCounter| 0)
+ (|shoeOpenOutputFile| |stream| |outfn|
+ (PROGN
+ (LET ((|bfVar#1| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#1|)
+ (PROGN (SETQ |line| (CAR |bfVar#1|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#1| (CDR |bfVar#1|))))
+ (|shoeFileTrees| (|shoeTransformStream| |a|) |stream|)))
+ |outfn|))))
(DEFUN BOOTTOCLC (|fn| |out|) (BOOTTOCLCLINES NIL |fn| |out|))
@@ -84,31 +88,33 @@
|result|))))
(DEFUN |shoeClCLines| (|a| |fn| |lines| |outfn|)
- (PROG (|$GenVarCounter|)
- (DECLARE (SPECIAL |$GenVarCounter|))
- (RETURN
- (COND
- ((NULL |a|) (|shoeNotFound| |fn|))
- ('T (SETQ |$GenVarCounter| 0)
- (|shoeOpenOutputFile| |stream| |outfn|
- (PROGN
- (LET ((|bfVar#2| |lines|) (|line| NIL))
- (LOOP
- (COND
- ((OR (ATOM |bfVar#2|)
- (PROGN (SETQ |line| (CAR |bfVar#2|)) NIL))
- (RETURN NIL))
- ('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#2| (CDR |bfVar#2|))))
- (|shoeFileTrees|
- (|shoeTransformToFile| |stream|
- (|shoeInclude|
- (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))
- |stream|)))
- |outfn|)))))
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (COND
+ ((NULL |a|) (|shoeNotFound| |fn|))
+ ('T
+ (PROGN
+ (SETQ |$GenVarCounter| 0)
+ (|shoeOpenOutputFile| |stream| |outfn|
+ (PROGN
+ (LET ((|bfVar#2| |lines|) (|line| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#2|)
+ (PROGN (SETQ |line| (CAR |bfVar#2|)) NIL))
+ (RETURN NIL))
+ ('T (|shoeFileLine| |line| |stream|)))
+ (SETQ |bfVar#2| (CDR |bfVar#2|))))
+ (|shoeFileTrees|
+ (|shoeTransformToFile| |stream|
+ (|shoeInclude|
+ (|bAddLineNumber| (|bRgen| |a|) (|bIgen| 0))))
+ |stream|)))
+ |outfn|))))
+
+(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) BOOTTOMC))
(DEFUN BOOTTOMC (|fn|)
- (PROG (|$GenVarCounter| |result| |infn| |callingPackage|)
+ (PROG (|result| |infn| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -124,8 +130,10 @@
(DEFUN |shoeMc| (|a| |fn|)
(COND
((NULL |a|) (|shoeNotFound| |fn|))
- ('T (|shoePCompileTrees| (|shoeTransformStream| |a|))
- (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED")))))
+ ('T
+ (PROGN
+ (|shoePCompileTrees| (|shoeTransformStream| |a|))
+ (|shoeConsole| (CONCAT |fn| " COMPILED AND LOADED"))))))
(DEFUN EVAL-BOOT-FILE (|fn|)
(PROG (|outfn| |infn| |b|)
@@ -142,8 +150,10 @@
(|setCurrentPackage| |b|)
(LOAD |outfn|)))))
+(DECLAIM (FTYPE (FUNCTION (|%String|) |%Thing|) BO))
+
(DEFUN BO (|fn|)
- (PROG (|$GenVarCounter| |infn| |b|)
+ (PROG (|infn| |b|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -155,8 +165,7 @@
(|setCurrentPackage| |b|)))))
(DEFUN BOCLAM (|fn|)
- (PROG (|$bfClamming| |$GenVarCounter| |result| |infn|
- |callingPackage|)
+ (PROG (|result| |infn| |callingPackage|)
(DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|))
(RETURN
(PROGN
@@ -183,7 +192,7 @@
(DEFUN STOUT (|string|) (PSTOUT (LIST |string|)))
(DEFUN STEVAL (|string|)
- (PROG (|$GenVarCounter| |result| |fn| |a| |callingPackage|)
+ (PROG (|result| |fn| |a| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -204,7 +213,7 @@
|result|))))
(DEFUN STTOMC (|string|)
- (PROG (|$GenVarCounter| |result| |a| |callingPackage|)
+ (PROG (|result| |a| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -225,6 +234,8 @@
((|bStreamNull| |s|) (RETURN NIL))
('T (PROGN (|shoeCompile| (CAR |s|)) (SETQ |s| (CDR |s|)))))))
+(DECLAIM (FTYPE (FUNCTION (|%Ast|) |%Thing|) |shoerCompile|))
+
(DEFUN |shoeCompile| (|fn|)
(PROG (|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
(RETURN
@@ -375,7 +386,8 @@
(DEFUN |shoeAddComment| (|l|) (CONCAT "; " (CAR |l|)))
(DEFUN |genImportDeclaration| (|op| |sig|)
- (PROG (|s| |t| |m| |ISTMP#2| |op'| |ISTMP#1|)
+ (PROG (|forwardingFun| |foreignDecl| |n| |args| |s| |t| |m| |ISTMP#2|
+ |op'| |ISTMP#1|)
(RETURN
(COND
((NOT (AND (CONSP |sig|) (EQ (CAR |sig|) '|Signature|)
@@ -404,17 +416,128 @@
(SETQ |s| (CAR |ISTMP#2|))
#0#)))))))
(|coreError| "invalid function type"))
- ((|%hasFeature| :GCL)
+ (#1='T
(PROGN
- (COND ((SYMBOLP |s|) (SETQ |s| (LIST |s|))))
- (LIST 'DEFENTRY |op| |s| (LIST |t| (SYMBOL-NAME |op'|)))))
- ('T
- (|fatalError|
- "import declaration not implemented for this Lisp"))))))
+ (COND
+ ((AND (NOT (NULL |s|)) (SYMBOLP |s|))
+ (SETQ |s| (LIST |s|))))
+ (COND
+ ((|%hasFeature| :GCL)
+ (LIST (LIST 'DEFENTRY |op|
+ (LET ((|bfVar#6| NIL) (|bfVar#5| |s|)
+ (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#5|)
+ (PROGN
+ (SETQ |x| (CAR |bfVar#5|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#6|)))
+ (#2='T
+ (SETQ |bfVar#6|
+ (CONS (|nativeType| |x|)
+ |bfVar#6|))))
+ (SETQ |bfVar#5| (CDR |bfVar#5|))))
+ (LIST (|nativeType| |t|) (SYMBOL-NAME |op'|)))))
+ (#1#
+ (PROGN
+ (SETQ |args|
+ (LET ((|bfVar#8| NIL) (|bfVar#7| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#7|)
+ (PROGN
+ (SETQ |x| (CAR |bfVar#7|))
+ NIL))
+ (RETURN (NREVERSE |bfVar#8|)))
+ (#2#
+ (SETQ |bfVar#8| (CONS (GENSYM) |bfVar#8|))))
+ (SETQ |bfVar#7| (CDR |bfVar#7|)))))
+ (COND
+ ((|%hasFeature| :SBCL)
+ (LIST (LIST 'DEFUN |op| |args|
+ (CONS (INTERN "ALIEN-FUNCALL"
+ "SB-ALIEN")
+ (CONS
+ (LIST
+ (INTERN "EXTERN-ALIEN"
+ "SB-ALIEN")
+ (SYMBOL-NAME |op'|)
+ (CONS 'FUNCTION
+ (CONS (|nativeType| |t|)
+ (LET
+ ((|bfVar#10| NIL)
+ (|bfVar#9| |s|) (|x| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#9|)
+ (PROGN
+ (SETQ |x|
+ (CAR |bfVar#9|))
+ NIL))
+ (RETURN
+ (NREVERSE |bfVar#10|)))
+ (#2#
+ (SETQ |bfVar#10|
+ (CONS
+ (|nativeType| |x|)
+ |bfVar#10|))))
+ (SETQ |bfVar#9|
+ (CDR |bfVar#9|)))))))
+ |args|)))))
+ ((|%hasFeature| :CLISP)
+ (PROGN
+ (SETQ |foreignDecl|
+ (PROGN
+ (SETQ |n|
+ (INTERN
+ (CONCAT (SYMBOL-NAME |op|)
+ "%clisp-hack")))
+ (LIST (|bfColonColon| 'FFI 'DEF-CALL-OUT)
+ |n| (LIST :NAME (SYMBOL-NAME |op'|))
+ (CONS :ARGUMENTS
+ (LET
+ ((|bfVar#13| NIL) (|bfVar#11| |s|)
+ (|x| NIL) (|bfVar#12| |args|)
+ (|a| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM |bfVar#11|)
+ (PROGN
+ (SETQ |x|
+ (CAR |bfVar#11|))
+ NIL)
+ (ATOM |bfVar#12|)
+ (PROGN
+ (SETQ |a|
+ (CAR |bfVar#12|))
+ NIL))
+ (RETURN
+ (NREVERSE |bfVar#13|)))
+ (#2#
+ (SETQ |bfVar#13|
+ (CONS
+ (LIST |a|
+ (|bfColonColon| 'FFI
+ (|nativeType| |x|)))
+ |bfVar#13|))))
+ (SETQ |bfVar#11|
+ (CDR |bfVar#11|))
+ (SETQ |bfVar#12|
+ (CDR |bfVar#12|)))))
+ (LIST :RETURN-TYPE
+ (|bfColonColon| 'FFI
+ (|nativeType| |t|)))
+ (LIST :LANGUAGE :STDC))))
+ (SETQ |forwardingFun|
+ (LIST 'DEFUN |op| |args| (CONS |n| |args|)))
+ (LIST |foreignDecl| |forwardingFun|)))
+ (#1#
+ (|fatalError|
+ "import declaration not implemented for this Lisp"))))))))))))
(DEFUN |shoeOutParse| (|stream|)
- (PROG (|$bpParenCount| |$bpCount| |$returns| |$typings| |$wheredefs|
- |$op| |$ttok| |$stok| |$stack| |$inputStream| |found|)
+ (PROG (|found|)
(DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$returns| |$typings|
|$wheredefs| |$op| |$ttok| |$stok| |$stack|
|$inputStream|))
@@ -434,9 +557,9 @@
(SETQ |found| (CATCH 'TRAPPOINT (|bpOutItem|)))
(COND
((EQ |found| 'TRAPPED) NIL)
- ((NULL (|bStreamNull| |$inputStream|)) (|bpGeneralErrorHere|)
- NIL)
- ((NULL |$stack|) (|bpGeneralErrorHere|) NIL)
+ ((NOT (|bStreamNull| |$inputStream|))
+ (PROGN (|bpGeneralErrorHere|) NIL))
+ ((NULL |$stack|) (PROGN (|bpGeneralErrorHere|) NIL))
('T (CAR |$stack|)))))))
(DEFUN |genDeclaration| (|n| |t|)
@@ -459,7 +582,7 @@
((|bfTupleP| |argTypes|)
(SETQ |argTypes| (CDR |argTypes|))))
(COND
- ((AND (NULL (NULL |argTypes|)) (SYMBOLP |argTypes|))
+ ((AND (NOT (NULL |argTypes|)) (SYMBOLP |argTypes|))
(SETQ |argTypes| (LIST |argTypes|))))
(LIST 'DECLAIM
(LIST 'FTYPE (LIST 'FUNCTION |argTypes| |valType|)
@@ -473,24 +596,24 @@
(SETQ |expr'|
(CDR (CDR (|shoeCompTran|
(LIST 'LAMBDA (LIST '|x|) |expr|)))))
- (LET ((|bfVar#5| |expr'|) (|t| NIL))
+ (LET ((|bfVar#14| |expr'|) (|t| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#5|)
- (PROGN (SETQ |t| (CAR |bfVar#5|)) NIL))
+ ((OR (ATOM |bfVar#14|)
+ (PROGN (SETQ |t| (CAR |bfVar#14|)) NIL))
(RETURN NIL))
('T
(COND
((AND (CONSP |t|) (EQ (CAR |t|) 'DECLARE))
(IDENTITY (RPLACA |t| 'DECLAIM))))))
- (SETQ |bfVar#5| (CDR |bfVar#5|))))
+ (SETQ |bfVar#14| (CDR |bfVar#14|))))
(|shoeEVALANDFILEACTQ|
(COND
((< 1 (LENGTH |expr'|)) (CONS 'PROGN |expr'|))
('T (CAR |expr'|))))))))
(DEFUN |bpOutItem| ()
- (PROG (|bfVar#7| |bfVar#6| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
+ (PROG (|bfVar#16| |bfVar#15| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
(DECLARE (SPECIAL |$op|))
(RETURN
(PROGN
@@ -514,34 +637,32 @@
(|bpPush| (LIST (LIST 'DEFPARAMETER |l| |r|))))
('T
(PROGN
- (SETQ |bfVar#6| |b|)
- (SETQ |bfVar#7| (CDR |bfVar#6|))
- (CASE (CAR |bfVar#6|)
+ (SETQ |bfVar#15| |b|)
+ (SETQ |bfVar#16| (CDR |bfVar#15|))
+ (CASE (CAR |bfVar#15|)
(|Signature|
- (LET ((|op| (CAR |bfVar#7|)) (|t| (CADR |bfVar#7|)))
+ (LET ((|op| (CAR |bfVar#16|))
+ (|t| (CADR |bfVar#16|)))
(|bpPush| (LIST (|genDeclaration| |op| |t|)))))
(|Module|
- (LET ((|m| (CAR |bfVar#7|)))
+ (LET ((|m| (CAR |bfVar#16|)))
(|bpPush|
(LIST (|shoeCompileTimeEvaluation|
(LIST 'PROVIDE |m|))))))
(|Import|
- (LET ((|m| (CAR |bfVar#7|)))
+ (LET ((|m| (CAR |bfVar#16|)))
(|bpPush| (LIST (LIST 'IMPORT-MODULE |m|)))))
(|ImportSignature|
- (LET ((|x| (CAR |bfVar#7|))
- (|sig| (CADR |bfVar#7|)))
- (|bpPush|
- (LIST (|genImportDeclaration| |x| |sig|)))))
+ (LET ((|x| (CAR |bfVar#16|))
+ (|sig| (CADR |bfVar#16|)))
+ (|bpPush| (|genImportDeclaration| |x| |sig|))))
(|TypeAlias|
- (LET ((|t| (CAR |bfVar#7|))
- (|args| (CADR |bfVar#7|))
- (|rhs| (CADDR |bfVar#7|)))
- (|bpPush|
- (LIST (LIST 'DEFTYPE |t| |args|
- (LIST 'QUOTE |rhs|))))))
+ (LET ((|lhs| (CAR |bfVar#16|))
+ (|rhs| (CADR |bfVar#16|)))
+ (|bpPush| (LIST (|genTypeAlias| |lhs| |rhs|)))))
(|ConstantDefinition|
- (LET ((|n| (CAR |bfVar#7|)) (|e| (CADR |bfVar#7|)))
+ (LET ((|n| (CAR |bfVar#16|))
+ (|e| (CADR |bfVar#16|)))
(|bpPush| (LIST (LIST 'DEFCONSTANT |n| |e|)))))
(T (|bpPush| (LIST (|translateToplevelExpression| |b|))))))))))))
@@ -572,25 +693,28 @@
(|shoeOpenInputFile| |a| |infn| (|shoeDfu| |a| |fn|))))))
(DEFUN |shoeDfu| (|a| |fn|)
- (PROG (|$bfClamming| |$GenVarCounter| |$bootDefinedTwice| |$bootUsed|
- |$bootDefined| |$lispWordTable| |out|)
+ (PROG (|out|)
(DECLARE (SPECIAL |$bfClamming| |$GenVarCounter|
|$bootDefinedTwice| |$bootUsed| |$bootDefined|
|$lispWordTable|))
(RETURN
(COND
((NULL |a|) (|shoeNotFound| |fn|))
- ('T (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
- (DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
- (HPUT |$lispWordTable| |i| T))
- (SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
- (SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
- (SETQ |$bootDefinedTwice| NIL) (SETQ |$GenVarCounter| 0)
- (SETQ |$bfClamming| NIL)
- (|shoeDefUse| (|shoeTransformStream| |a|))
- (SETQ |out| (CONCAT |fn| ".defuse"))
- (|shoeOpenOutputFile| |stream| |out| (|shoeReport| |stream|))
- |out|)))))
+ ('T
+ (PROGN
+ (SETQ |$lispWordTable| (MAKE-HASHTABLE 'EQ))
+ (DO-SYMBOLS (|i| (FIND-PACKAGE 'LISP))
+ (HPUT |$lispWordTable| |i| T))
+ (SETQ |$bootDefined| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootUsed| (MAKE-HASHTABLE 'EQ))
+ (SETQ |$bootDefinedTwice| NIL)
+ (SETQ |$GenVarCounter| 0)
+ (SETQ |$bfClamming| NIL)
+ (|shoeDefUse| (|shoeTransformStream| |a|))
+ (SETQ |out| (CONCAT |fn| ".defuse"))
+ (|shoeOpenOutputFile| |stream| |out|
+ (|shoeReport| |stream|))
+ |out|))))))
(DEFUN |shoeReport| (|stream|)
(PROG (|b| |a|)
@@ -599,17 +723,17 @@
(PROGN
(|shoeFileLine| "DEFINED and not USED" |stream|)
(SETQ |a|
- (LET ((|bfVar#9| NIL) (|bfVar#8| (HKEYS |$bootDefined|))
- (|i| NIL))
+ (LET ((|bfVar#18| NIL)
+ (|bfVar#17| (HKEYS |$bootDefined|)) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#8|)
- (PROGN (SETQ |i| (CAR |bfVar#8|)) NIL))
- (RETURN (NREVERSE |bfVar#9|)))
+ ((OR (ATOM |bfVar#17|)
+ (PROGN (SETQ |i| (CAR |bfVar#17|)) NIL))
+ (RETURN (NREVERSE |bfVar#18|)))
(#0='T
- (AND (NULL (GETHASH |i| |$bootUsed|))
- (SETQ |bfVar#9| (CONS |i| |bfVar#9|)))))
- (SETQ |bfVar#8| (CDR |bfVar#8|)))))
+ (AND (NOT (GETHASH |i| |$bootUsed|))
+ (SETQ |bfVar#18| (CONS |i| |bfVar#18|)))))
+ (SETQ |bfVar#17| (CDR |bfVar#17|)))))
(|bootOut| (SSORT |a|) |stream|)
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "DEFINED TWICE" |stream|)
@@ -617,29 +741,29 @@
(|shoeFileLine| " " |stream|)
(|shoeFileLine| "USED and not DEFINED" |stream|)
(SETQ |a|
- (LET ((|bfVar#11| NIL) (|bfVar#10| (HKEYS |$bootUsed|))
+ (LET ((|bfVar#20| NIL) (|bfVar#19| (HKEYS |$bootUsed|))
(|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#10|)
- (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL))
- (RETURN (NREVERSE |bfVar#11|)))
+ ((OR (ATOM |bfVar#19|)
+ (PROGN (SETQ |i| (CAR |bfVar#19|)) NIL))
+ (RETURN (NREVERSE |bfVar#20|)))
(#0#
- (AND (NULL (GETHASH |i| |$bootDefined|))
- (SETQ |bfVar#11| (CONS |i| |bfVar#11|)))))
- (SETQ |bfVar#10| (CDR |bfVar#10|)))))
- (LET ((|bfVar#12| (SSORT |a|)) (|i| NIL))
+ (AND (NOT (GETHASH |i| |$bootDefined|))
+ (SETQ |bfVar#20| (CONS |i| |bfVar#20|)))))
+ (SETQ |bfVar#19| (CDR |bfVar#19|)))))
+ (LET ((|bfVar#21| (SSORT |a|)) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#12|)
- (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
+ ((OR (ATOM |bfVar#21|)
+ (PROGN (SETQ |i| (CAR |bfVar#21|)) NIL))
(RETURN NIL))
(#0#
(PROGN
(SETQ |b| (CONCAT (PNAME |i|) " is used in "))
(|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
|stream| |b|))))
- (SETQ |bfVar#12| (CDR |bfVar#12|))))))))
+ (SETQ |bfVar#21| (CDR |bfVar#21|))))))))
(DEFUN |shoeDefUse| (|s|)
(LOOP
@@ -648,11 +772,10 @@
('T (PROGN (|defuse| NIL (CAR |s|)) (SETQ |s| (CDR |s|)))))))
(DEFUN |defuse| (|e| |x|)
- (PROG (|$used| |niens| |nee| |LETTMP#1| |exp| |ISTMP#5| |id|
- |ISTMP#4| |ISTMP#3| |body| |bv| |ISTMP#2| |name|
- |ISTMP#1|)
- (DECLARE (SPECIAL |$bootUsed| |$used| |$bootDefinedTwice|
- |$bootDefined|))
+ (PROG (|niens| |nee| |LETTMP#1| |exp| |ISTMP#5| |id| |ISTMP#4|
+ |ISTMP#3| |body| |bv| |ISTMP#2| |name| |ISTMP#1|)
+ (DECLARE (SPECIAL |$bootUsed| |$bootDefinedTwice| |$bootDefined|
+ |$used|))
(RETURN
(PROGN
(SETQ |x| (|stripm| |x| *PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
@@ -736,16 +859,16 @@
(#1# (CONS |nee| |$bootDefinedTwice|)))))
('T (HPUT |$bootDefined| |nee| T)))
(|defuse1| |e| |niens|)
- (LET ((|bfVar#13| |$used|) (|i| NIL))
+ (LET ((|bfVar#22| |$used|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#13|)
- (PROGN (SETQ |i| (CAR |bfVar#13|)) NIL))
+ ((OR (ATOM |bfVar#22|)
+ (PROGN (SETQ |i| (CAR |bfVar#22|)) NIL))
(RETURN NIL))
('T
(HPUT |$bootUsed| |i|
(CONS |nee| (GETHASH |i| |$bootUsed|)))))
- (SETQ |bfVar#13| (CDR |bfVar#13|))))))))
+ (SETQ |bfVar#22| (CDR |bfVar#22|))))))))
(DEFUN |defuse1| (|e| |y|)
(PROG (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|)
@@ -783,14 +906,14 @@
(SETQ |LETTMP#1| (|defSeparate| |a|))
(SETQ |dol| (CAR |LETTMP#1|))
(SETQ |ndol| (CADR |LETTMP#1|))
- (LET ((|bfVar#14| |dol|) (|i| NIL))
+ (LET ((|bfVar#23| |dol|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#14|)
- (PROGN (SETQ |i| (CAR |bfVar#14|)) NIL))
+ ((OR (ATOM |bfVar#23|)
+ (PROGN (SETQ |i| (CAR |bfVar#23|)) NIL))
(RETURN NIL))
(#2='T (HPUT |$bootDefined| |i| T)))
- (SETQ |bfVar#14| (CDR |bfVar#14|))))
+ (SETQ |bfVar#23| (CDR |bfVar#23|))))
(|defuse1| (APPEND |ndol| |e|) |b|)))
((AND (CONSP |y|) (EQ (CAR |y|) 'QUOTE)
(PROGN (SETQ |a| (CDR |y|)) #1#))
@@ -799,26 +922,29 @@
(PROGN (SETQ |a| (CDR |y|)) #1#))
NIL)
(#0#
- (LET ((|bfVar#15| |y|) (|i| NIL))
+ (LET ((|bfVar#24| |y|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#15|)
- (PROGN (SETQ |i| (CAR |bfVar#15|)) NIL))
+ ((OR (ATOM |bfVar#24|)
+ (PROGN (SETQ |i| (CAR |bfVar#24|)) NIL))
(RETURN NIL))
(#2# (|defuse1| |e| |i|)))
- (SETQ |bfVar#15| (CDR |bfVar#15|)))))))))
+ (SETQ |bfVar#24| (CDR |bfVar#24|)))))))))
(DEFUN |defSeparate| (|x|)
(PROG (|x2| |x1| |LETTMP#1| |f|)
(RETURN
(COND
((NULL |x|) (LIST NIL NIL))
- (#0='T (SETQ |f| (CAR |x|))
- (SETQ |LETTMP#1| (|defSeparate| (CDR |x|)))
- (SETQ |x1| (CAR |LETTMP#1|)) (SETQ |x2| (CADR |LETTMP#1|))
- (COND
- ((|bfBeginsDollar| |f|) (LIST (CONS |f| |x1|) |x2|))
- (#0# (LIST |x1| (CONS |f| |x2|)))))))))
+ (#0='T
+ (PROGN
+ (SETQ |f| (CAR |x|))
+ (SETQ |LETTMP#1| (|defSeparate| (CDR |x|)))
+ (SETQ |x1| (CAR |LETTMP#1|))
+ (SETQ |x2| (CADR |LETTMP#1|))
+ (COND
+ ((|bfBeginsDollar| |f|) (LIST (CONS |f| |x1|) |x2|))
+ (#0# (LIST |x1| (CONS |f| |x2|))))))))))
(DEFUN |unfluidlist| (|x|)
(PROG (|y| |ISTMP#1|)
@@ -839,15 +965,15 @@
(GETHASH |x| |$lispWordTable|))
(DEFUN |bootOut| (|l| |outfn|)
- (LET ((|bfVar#16| |l|) (|i| NIL))
+ (LET ((|bfVar#25| |l|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#16|) (PROGN (SETQ |i| (CAR |bfVar#16|)) NIL))
+ ((OR (ATOM |bfVar#25|) (PROGN (SETQ |i| (CAR |bfVar#25|)) NIL))
(RETURN NIL))
('T (|shoeFileLine| (CONCAT " " (PNAME |i|)) |outfn|)))
- (SETQ |bfVar#16| (CDR |bfVar#16|)))))
+ (SETQ |bfVar#25| (CDR |bfVar#25|)))))
-(DEFUN CLESSP (|s1| |s2|) (NULL (SHOEGREATERP |s1| |s2|)))
+(DEFUN CLESSP (|s1| |s2|) (NOT (SHOEGREATERP |s1| |s2|)))
(DEFUN SSORT (|l|) (SORT |l| #'CLESSP))
@@ -872,8 +998,7 @@
(|shoeOpenInputFile| |a| |infn| (|shoeXref| |a| |fn|))))))
(DEFUN |shoeXref| (|a| |fn|)
- (PROG (|$bfClamming| |$GenVarCounter| |$bootUsed| |$bootDefined|
- |$lispWordTable| |out|)
+ (PROG (|out|)
(DECLARE (SPECIAL |$bfClamming| |$GenVarCounter| |$bootUsed|
|$bootDefined| |$lispWordTable|))
(RETURN
@@ -897,18 +1022,18 @@
(PROGN
(|shoeFileLine| "USED and where DEFINED" |stream|)
(SETQ |c| (SSORT (HKEYS |$bootUsed|)))
- (LET ((|bfVar#17| |c|) (|i| NIL))
+ (LET ((|bfVar#26| |c|) (|i| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#17|)
- (PROGN (SETQ |i| (CAR |bfVar#17|)) NIL))
+ ((OR (ATOM |bfVar#26|)
+ (PROGN (SETQ |i| (CAR |bfVar#26|)) NIL))
(RETURN NIL))
('T
(PROGN
(SETQ |a| (CONCAT (PNAME |i|) " is used in "))
(|bootOutLines| (SSORT (GETHASH |i| |$bootUsed|))
|stream| |a|))))
- (SETQ |bfVar#17| (CDR |bfVar#17|))))))))
+ (SETQ |bfVar#26| (CDR |bfVar#26|))))))))
(DEFUN FBO (|name| |fn|) (|shoeGeneralFC| #'BO |name| |fn|))
@@ -916,7 +1041,7 @@
(|shoeGeneralFC| #'EVAL-BOOT-FILE |name| |fn|))
(DEFUN |shoeGeneralFC| (|f| |name| |fn|)
- (PROG (|$GenVarCounter| |$bfClamming| |filename| |a| |infn|)
+ (PROG (|filename| |a| |infn|)
(DECLARE (SPECIAL |$GenVarCounter| |$bfClamming|))
(RETURN
(PROGN
@@ -949,16 +1074,16 @@
(SETQ |filename|
(CONCAT "/tmp/" |filename| ".boot"))
(|shoeOpenOutputFile| |stream| |filename|
- (LET ((|bfVar#18| |lines|) (|line| NIL))
+ (LET ((|bfVar#27| |lines|) (|line| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#18|)
+ ((OR (ATOM |bfVar#27|)
(PROGN
- (SETQ |line| (CAR |bfVar#18|))
+ (SETQ |line| (CAR |bfVar#27|))
NIL))
(RETURN NIL))
('T (|shoeFileLine| |line| |stream|)))
- (SETQ |bfVar#18| (CDR |bfVar#18|)))))
+ (SETQ |bfVar#27| (CDR |bfVar#27|)))))
T))
('T NIL))))))
@@ -973,20 +1098,20 @@
(RETURN
(PROGN
(SETQ |dq| (CAR |str|))
- (CONS (LIST (LET ((|bfVar#20| NIL)
- (|bfVar#19| (|shoeDQlines| |dq|))
+ (CONS (LIST (LET ((|bfVar#29| NIL)
+ (|bfVar#28| (|shoeDQlines| |dq|))
(|line| NIL))
(LOOP
(COND
- ((OR (ATOM |bfVar#19|)
+ ((OR (ATOM |bfVar#28|)
(PROGN
- (SETQ |line| (CAR |bfVar#19|))
+ (SETQ |line| (CAR |bfVar#28|))
NIL))
- (RETURN (NREVERSE |bfVar#20|)))
+ (RETURN (NREVERSE |bfVar#29|)))
('T
- (SETQ |bfVar#20|
- (CONS (CAR |line|) |bfVar#20|))))
- (SETQ |bfVar#19| (CDR |bfVar#19|)))))
+ (SETQ |bfVar#29|
+ (CONS (CAR |line|) |bfVar#29|))))
+ (SETQ |bfVar#28| (CDR |bfVar#28|)))))
(CDR |str|))))))
(DEFUN |stripm| (|x| |pk| |bt|)
@@ -1024,7 +1149,7 @@
('T (EVAL |fn|)))))))
(DEFUN FC (|name| |fn|)
- (PROG (|$GenVarCounter| |infn|)
+ (PROG (|infn|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -1060,12 +1185,10 @@
|b|))))
(DEFUN PSTTOMC (|string|)
- (PROG (|$GenVarCounter|)
- (DECLARE (SPECIAL |$GenVarCounter|))
- (RETURN
- (PROGN
- (SETQ |$GenVarCounter| 0)
- (|shoePCompileTrees| (|shoeTransformString| |string|))))))
+ (DECLARE (SPECIAL |$GenVarCounter|))
+ (PROGN
+ (SETQ |$GenVarCounter| 0)
+ (|shoePCompileTrees| (|shoeTransformString| |string|))))
(DEFUN BOOTLOOP ()
(PROG (|stream| |b| |a|)
@@ -1108,7 +1231,7 @@
(#0# (PROGN (PSTOUT (LIST |a|)) (BOOTPO)))))))))))
(DEFUN PSTOUT (|string|)
- (PROG (|$GenVarCounter| |result| |callingPackage|)
+ (PROG (|result| |callingPackage|)
(DECLARE (SPECIAL |$GenVarCounter|))
(RETURN
(PROGN
@@ -1156,3 +1279,43 @@
(|associateRequestWithFileType| (|Option| "compile") "boot"
#'|compileBootHandler|))
+(DEFUN |systemRootDirectory| ()
+ (PROG (|dir|)
+ (DECLARE (SPECIAL |$systemInstallationDirectory|))
+ (RETURN
+ (COND
+ ((SETQ |dir| (ASSOC (|Option| "system") (|%systemOptions|)))
+ (|ensureTrailingSlash| (CDR |dir|)))
+ ('T |$systemInstallationDirectory|)))))
+
+(DEFUN |systemLibraryDirectory| ()
+ (PROG (|dir|)
+ (RETURN
+ (COND
+ ((SETQ |dir| (ASSOC (|Option| '|syslib|) (|%systemOptions|)))
+ (|ensureTrailingSlash| (CDR |dir|)))
+ ('T (CONCAT (|systemRootDirectory|) "lib/"))))))
+
+(DEFUN |loadNativeModule| (|m|)
+ (COND
+ ((|%hasFeature| :SBCL)
+ (FUNCALL (|bfColonColon| 'SB-ALIEN 'LOAD-SHARED-OBJECT) |m|))
+ ((|%hasFeature| :CLISP)
+ (EVAL (LIST (|bfColonColon| 'FFI 'DEFAULT-FOREIGN-LIBRARY) |m|)))
+ ('T
+ (|systemError|
+ "don't know how to load a dynamically linked module"))))
+
+(DEFPARAMETER |$OpenAxiomCoreModuleLoaded| NIL)
+
+(DEFUN |loadSystemRuntimeCore| ()
+ (DECLARE (SPECIAL |$NativeModuleExt| |$OpenAxiomCoreModuleLoaded|))
+ (COND
+ (|$OpenAxiomCoreModuleLoaded| NIL)
+ ('T
+ (PROGN
+ (|loadNativeModule|
+ (CONCAT (|systemLibraryDirectory|) "libopen-axiom-core"
+ |$NativeModuleExt|))
+ (SETQ |$OpenAxiomCoreModuleLoaded| T)))))
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 12:38:47 +0000