From b1cd408a22e554e9e9a950aef3a89ea9f665a5b6 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 20 May 2012 01:53:27 +0000
Subject: * boot/ast.boot (shoeCompTran1): Take variable sets by
reference. Remove globals. Adjust caller. (shoeCompTran):
Replace fluid variables by references.
---
src/boot/strap/ast.clisp | 117 +++++++++++++++++++++++-----------------
src/boot/strap/parser.clisp | 46 ++++++++--------
src/boot/strap/scanner.clisp | 42 +++++++--------
src/boot/strap/translator.clisp | 44 +++++++--------
4 files changed, 133 insertions(+), 116 deletions(-)
(limited to 'src/boot/strap')
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 90b857fa..8ec1bc57 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1035,7 +1035,7 @@
(DEFUN |bfIS| (|left| |right|)
(PROG (|$inDefIS| |$isGenVarCounter|)
- (DECLARE (SPECIAL |$isGenVarCounter| |$inDefIS|))
+ (DECLARE (SPECIAL |$inDefIS| |$isGenVarCounter|))
(RETURN
(PROGN
(SETQ |$isGenVarCounter| 0)
@@ -1584,7 +1584,7 @@
(DEFUN |bfDef| (|op| |args| |body|)
(PROG (|body1| |arg1| |op1| |LETTMP#1|)
- (DECLARE (SPECIAL |$bfClamming| |$wheredefs|))
+ (DECLARE (SPECIAL |$wheredefs| |$bfClamming|))
(RETURN
(COND
(|$bfClamming|
@@ -1707,43 +1707,45 @@
|body|))))))))))))
(DEFUN |shoeCompTran| (|x|)
- (PROG (|$dollarVars| |$locVars| |$fluidVars| |fvs| |fl| |fvars| |body'|
- |lvars| |body| |args| |lamtype|)
- (DECLARE (SPECIAL |$typings| |$dollarVars| |$locVars| |$fluidVars|))
+ (PROG (|fl| |fvars| |body'| |lvars| |dollarVars| |locVars| |fluidVars| |body|
+ |args| |lamtype|)
+ (DECLARE (SPECIAL |$typings|))
(RETURN
(PROGN
(SETQ |lamtype| (CAR |x|))
(SETQ |args| (CADR . #1=(|x|)))
(SETQ |body| (CDDR . #1#))
- (SETQ |$fluidVars| NIL)
- (SETQ |$locVars| NIL)
- (SETQ |$dollarVars| NIL)
- (|shoeCompTran1| |body|)
- (SETQ |$locVars|
- (|setDifference| (|setDifference| |$locVars| |$fluidVars|)
- (|shoeATOMs| |args|)))
+ (SETQ |fluidVars| (|ref| NIL))
+ (SETQ |locVars| (|ref| NIL))
+ (SETQ |dollarVars| (|ref| NIL))
+ (|shoeCompTran1| |body| |fluidVars| |locVars| |dollarVars|)
+ (SETF (|deref| |locVars|)
+ (|setDifference|
+ (|setDifference| (|deref| |locVars|) (|deref| |fluidVars|))
+ (|shoeATOMs| |args|)))
(SETQ |body|
(PROGN
- (SETQ |lvars| (|append| |$fluidVars| |$locVars|))
- (SETQ |$fluidVars| (UNION |$fluidVars| |$dollarVars|))
+ (SETQ |lvars|
+ (|append| (|deref| |fluidVars|) (|deref| |locVars|)))
+ (SETF (|deref| |fluidVars|)
+ (|setUnion| (|deref| |fluidVars|)
+ (|deref| |dollarVars|)))
(SETQ |body'| |body|)
(COND
(|$typings|
(SETQ |body'| (CONS (CONS 'DECLARE |$typings|) |body'|))))
(COND
- (|$fluidVars|
- (SETQ |fvars| (LIST 'DECLARE (CONS 'SPECIAL |$fluidVars|)))
+ ((|deref| |fluidVars|)
+ (SETQ |fvars|
+ (LIST 'DECLARE (CONS 'SPECIAL (|deref| |fluidVars|))))
(SETQ |body'| (CONS |fvars| |body'|))))
(COND
((OR |lvars| (|needsPROG| |body|))
(|shoePROG| |lvars| |body'|))
(T |body'|))))
- (SETQ |fl| (|shoeFluids| |args|))
- (SETQ |body|
- (COND
- (|fl| (SETQ |fvs| (LIST 'DECLARE (CONS 'SPECIAL |fl|)))
- (CONS |fvs| |body|))
- (T |body|)))
+ (COND
+ ((SETQ |fl| (|shoeFluids| |args|))
+ (SETQ |body| (CONS (LIST 'DECLARE (CONS 'SPECIAL |fl|)) |body|))))
(CONS |lamtype| (CONS |args| |body|))))))
(DEFUN |needsPROG| (|body|)
@@ -1793,7 +1795,7 @@
(DEFUN |isDynamicVariable| (|x|)
(PROG (|y|)
- (DECLARE (SPECIAL |$constantIdentifiers| |$activeNamespace|))
+ (DECLARE (SPECIAL |$activeNamespace| |$constantIdentifiers|))
(RETURN
(COND
((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|))
@@ -1805,16 +1807,15 @@
(T T)))
(T NIL)))))
-(DEFUN |shoeCompTran1| (|x|)
+(DEFUN |shoeCompTran1| (|x| |fluidVars| |locVars| |dollarVars|)
(PROG (|n| |elts| |newbindings| |r| |ISTMP#2| |l| |zs| |y| |ISTMP#1| U)
- (DECLARE (SPECIAL |$dollarVars| |$locVars| |$fluidVars|))
(RETURN
(COND
((NOT (CONSP |x|))
(COND
((AND (|isDynamicVariable| |x|)
- (NOT (|symbolMember?| |x| |$dollarVars|)))
- (SETQ |$dollarVars| (CONS |x| |$dollarVars|))))
+ (NOT (|symbolMember?| |x| (|deref| |dollarVars|))))
+ (SETF (|deref| |dollarVars|) (CONS |x| (|deref| |dollarVars|)))))
|x|)
(T (SETQ U (CAR |x|))
(COND ((EQ U 'QUOTE) |x|)
@@ -1826,12 +1827,14 @@
(SETQ |y| (CAR |ISTMP#1|))
(SETQ |zs| (CDR |ISTMP#1|))
T))))
- (SETF (CADR |x|) (|shoeCompTran1| |y|))
+ (SETF (CADR |x|)
+ (|shoeCompTran1| |y| |fluidVars| |locVars| |dollarVars|))
(LOOP
(COND ((NOT |zs|) (RETURN NIL))
(T
(SETF (CADR (CAR |zs|))
- (|shoeCompTran1| (CADR (CAR |zs|))))
+ (|shoeCompTran1| (CADR (CAR |zs|)) |fluidVars|
+ |locVars| |dollarVars|))
(SETQ |zs| (CDR |zs|)))))
|x|)
((AND (CONSP |x|) (EQ (CAR |x|) 'L%T)
@@ -1843,24 +1846,28 @@
(SETQ |ISTMP#2| (CDR |ISTMP#1|))
(AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
(PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))))
- (RPLACA |x| 'SETQ) (SETF (CADDR |x|) (|shoeCompTran1| |r|))
+ (RPLACA |x| 'SETQ)
+ (SETF (CADDR |x|)
+ (|shoeCompTran1| |r| |fluidVars| |locVars| |dollarVars|))
(COND
((SYMBOLP |l|)
(COND
((|bfBeginsDollar| |l|)
(COND
- ((NOT (|symbolMember?| |l| |$dollarVars|))
- (SETQ |$dollarVars| (CONS |l| |$dollarVars|))))
+ ((NOT (|symbolMember?| |l| (|deref| |dollarVars|)))
+ (SETF (|deref| |dollarVars|)
+ (CONS |l| (|deref| |dollarVars|)))))
|x|)
(T
(COND
- ((NOT (|symbolMember?| |l| |$locVars|))
- (SETQ |$locVars| (CONS |l| |$locVars|))))
+ ((NOT (|symbolMember?| |l| (|deref| |locVars|)))
+ (SETF (|deref| |locVars|) (CONS |l| (|deref| |locVars|)))))
|x|)))
((AND (CONSP |l|) (EQ (CAR |l|) '|%Dynamic|))
(COND
- ((NOT (|symbolMember?| (CADR |l|) |$fluidVars|))
- (SETQ |$fluidVars| (CONS (CADR |l|) |$fluidVars|))))
+ ((NOT (|symbolMember?| (CADR |l|) (|deref| |fluidVars|)))
+ (SETF (|deref| |fluidVars|)
+ (CONS (CADR |l|) (|deref| |fluidVars|)))))
(RPLACA (CDR |x|) (CADR |l|)) |x|)))
((EQ U '|%Leave|) (RPLACA |x| 'RETURN) |x|)
((|symbolMember?| U '(PROG LAMBDA)) (SETQ |newbindings| NIL)
@@ -1870,17 +1877,19 @@
((OR (NOT (CONSP |bfVar#1|))
(PROGN (SETQ |y| (CAR |bfVar#1|)) NIL))
(RETURN NIL))
- ((NOT (|symbolMember?| |y| |$locVars|))
+ ((NOT (|symbolMember?| |y| (|deref| |locVars|)))
(IDENTITY
(PROGN
- (SETQ |$locVars| (CONS |y| |$locVars|))
+ (SETF (|deref| |locVars|) (CONS |y| (|deref| |locVars|)))
(SETQ |newbindings| (CONS |y| |newbindings|))))))
(SETQ |bfVar#1| (CDR |bfVar#1|))))
- (RPLACD (CDR |x|) (|shoeCompTran1| (CDDR |x|)))
- (SETQ |$locVars|
+ (RPLACD (CDR |x|)
+ (|shoeCompTran1| (CDDR |x|) |fluidVars| |locVars|
+ |dollarVars|))
+ (SETF (|deref| |locVars|)
(LET ((|bfVar#3| NIL)
(|bfVar#4| NIL)
- (|bfVar#2| |$locVars|)
+ (|bfVar#2| (|deref| |locVars|))
(|y| NIL))
(LOOP
(COND
@@ -1905,17 +1914,23 @@
(COND ((EQ |elts| 'NIL) (RPLACA |x| 'VECTOR) (RPLACD |x| NIL))
((AND (CONSP |elts|) (EQ (CAR |elts|) 'LIST))
(RPLACA |x| 'VECTOR)
- (RPLACD |x| (|shoeCompTran1| (CDR |elts|))))
+ (RPLACD |x|
+ (|shoeCompTran1| (CDR |elts|) |fluidVars|
+ |locVars| |dollarVars|)))
((NOT (CONSP |elts|))
- (SETQ |elts| (|shoeCompTran1| |elts|))
+ (SETQ |elts|
+ (|shoeCompTran1| |elts| |fluidVars| |locVars|
+ |dollarVars|))
(RPLACA |x| 'MAKE-ARRAY)
(RPLACD |x|
(LIST (LIST 'LIST-LENGTH |elts|) :INITIAL-CONTENTS
|elts|)))
(T (RPLACA |x| 'COERCE)
(RPLACD |x|
- (LIST (|shoeCompTran1| |elts|)
- (|quote| 'VECTOR)))))
+ (LIST
+ (|shoeCompTran1| |elts| |fluidVars| |locVars|
+ |dollarVars|)
+ (|quote| 'VECTOR)))))
|x|)
((AND (CONSP |x|) (EQ (CAR |x|) '|%Namespace|)
(PROGN
@@ -1924,11 +1939,17 @@
(PROGN (SETQ |n| (CAR |ISTMP#1|)) T))))
(COND ((EQ |n| 'DOT) '*PACKAGE*)
(T (LIST 'FIND-PACKAGE (SYMBOL-NAME |n|)))))
- (T (RPLACA |x| (|shoeCompTran1| (CAR |x|)))
- (RPLACD |x| (|shoeCompTran1| (CDR |x|))) |x|)))))))
+ (T
+ (RPLACA |x|
+ (|shoeCompTran1| (CAR |x|) |fluidVars| |locVars|
+ |dollarVars|))
+ (RPLACD |x|
+ (|shoeCompTran1| (CDR |x|) |fluidVars| |locVars|
+ |dollarVars|))
+ |x|)))))))
(DEFUN |bfTagged| (|a| |b|)
- (DECLARE (SPECIAL |$op| |$typings|))
+ (DECLARE (SPECIAL |$typings| |$op|))
(COND ((NULL |$op|) (|%Signature| |a| |b|))
((SYMBOLP |a|)
(COND ((EQ |b| '|local|) (|bfLET| (|compFluid| |a|) NIL))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index dd1d4dfd..a03b67b9 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -10,7 +10,7 @@
(PROVIDE "parser")
(DEFUN |bpFirstToken| ()
- (DECLARE (SPECIAL |$inputStream| |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok| |$inputStream|))
(PROGN
(SETQ |$stok|
(COND
@@ -21,7 +21,7 @@
T))
(DEFUN |bpFirstTok| ()
- (DECLARE (SPECIAL |$inputStream| |$stok| |$ttok| |$bpParenCount| |$bpCount|))
+ (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$ttok| |$stok| |$inputStream|))
(PROGN
(SETQ |$stok|
(COND
@@ -48,11 +48,11 @@
(DEFUN |bpRequire| (|f|) (OR (APPLY |f| NIL) (|bpTrap|)))
(DEFUN |bpState| ()
- (DECLARE (SPECIAL |$inputStream| |$stack| |$bpParenCount| |$bpCount|))
+ (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
(LIST |$inputStream| |$stack| |$bpParenCount| |$bpCount|))
(DEFUN |bpRestore| (|x|)
- (DECLARE (SPECIAL |$inputStream| |$stack| |$bpParenCount| |$bpCount|))
+ (DECLARE (SPECIAL |$bpCount| |$bpParenCount| |$stack| |$inputStream|))
(PROGN
(SETQ |$inputStream| (CAR |x|))
(|bpFirstToken|)
@@ -66,7 +66,7 @@
(SETQ |$stack| (CONS |x| |$stack|)))
(DEFUN |bpPushId| ()
- (DECLARE (SPECIAL |$ttok| |$stack|))
+ (DECLARE (SPECIAL |$stack| |$ttok|))
(SETQ |$stack| (CONS (|bfReName| |$ttok|) |$stack|)))
(DEFUN |bpPop1| ()
@@ -92,7 +92,7 @@
(DEFUN |bpIndentParenthesized| (|f|)
(PROG (|$bpCount| |a|)
- (DECLARE (SPECIAL |$stok| |$bpParenCount| |$inputStream| |$bpCount|))
+ (DECLARE (SPECIAL |$bpCount| |$inputStream| |$bpParenCount| |$stok|))
(RETURN
(PROGN
(SETQ |$bpCount| 0)
@@ -252,15 +252,15 @@
(COND ((|bpEqKey| 'BACKSET) (|bpEqKey| 'ELSE)) (T (|bpEqKey| 'ELSE))))
(DEFUN |bpEqPeek| (|s|)
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|)))
(DEFUN |bpEqKey| (|s|)
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|) (|bpNext|)))
(DEFUN |bpEqKeyNextTok| (|s|)
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (EQ |s| |$ttok|)
(|bpNextToken|)))
@@ -303,7 +303,7 @@
(DEFUN |bpListAndRecover| (|f|)
(PROG (|found| |c| |done| |b| |a|)
- (DECLARE (SPECIAL |$stack| |$inputStream|))
+ (DECLARE (SPECIAL |$inputStream| |$stack|))
(RETURN
(PROGN
(SETQ |a| |$stack|)
@@ -345,7 +345,7 @@
(|bpPush| (|reverse!| |b|))))))
(DEFUN |bpMoveTo| (|n|)
- (DECLARE (SPECIAL |$inputStream| |$bpCount| |$bpParenCount|))
+ (DECLARE (SPECIAL |$bpParenCount| |$bpCount| |$inputStream|))
(COND ((NULL |$inputStream|) T)
((|bpEqPeek| 'BACKTAB)
(COND ((EQL |n| 0) T)
@@ -376,7 +376,7 @@
(T NIL)))
(DEFUN |bpConstTok| ()
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(COND
((|symbolMember?| (|shoeTokType| |$stok|) '(INTEGER FLOAT))
(|bpPush| |$ttok|) (|bpNext|))
@@ -392,7 +392,7 @@
(DEFUN |bpChar| ()
(PROG (|ISTMP#1| |s| |a|)
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(RETURN
(COND
((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (EQ |$ttok| '|char|))
@@ -525,7 +525,7 @@
(DEFUN |bpSexpKey| ()
(PROG (|a|)
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(RETURN
(COND
((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (NOT (|bpExceptions|)))
@@ -535,7 +535,7 @@
(T NIL)))))
(DEFUN |bpAnyId| ()
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(OR
(AND (|bpEqKey| 'MINUS)
(OR (AND (CONSP |$stok|) (EQ (CAR |$stok|) 'INTEGER)) (|bpTrap|))
@@ -575,12 +575,12 @@
(DEFUN |bpDot| () (AND (|bpEqKey| 'DOT) (|bpPush| (|bfDot|))))
(DEFUN |bpPrefixOperator| ()
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEPRE)
(|bpPushId|) (|bpNext|)))
(DEFUN |bpInfixOperator| ()
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (GET |$ttok| 'SHOEINF)
(|bpPushId|) (|bpNext|)))
@@ -615,7 +615,7 @@
(DEFUN |bpExpt| () (|bpRightAssoc| '(POWER) #'|bpTagged|))
(DEFUN |bpInfKey| (|s|)
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(AND (CONSP |$stok|) (EQ (CAR |$stok|) 'KEY) (|symbolMember?| |$ttok| |s|)
(|bpPushId|) (|bpNext|)))
@@ -651,7 +651,7 @@
(T NIL)))
(DEFUN |bpString| ()
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|shoeTokType| |$stok|) 'STRING)
(|bpPush| (|quote| (INTERN |$ttok|))) (|bpNext|)))
@@ -660,7 +660,7 @@
(|bpPush| (|bfFunction| (|bpPop1|)))))
(DEFUN |bpThetaName| ()
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(COND
((AND (CONSP |$stok|) (EQ (CAR |$stok|) 'ID) (GET |$ttok| 'SHOETHETA))
(|bpPushId|) (|bpNext|))
@@ -898,7 +898,7 @@
(T (|bpRestore| |a|) NIL)))))))
(DEFUN |bpStoreName| ()
- (DECLARE (SPECIAL |$stack| |$op| |$wheredefs| |$typings|))
+ (DECLARE (SPECIAL |$typings| |$wheredefs| |$op| |$stack|))
(PROGN
(SETQ |$op| (CAR |$stack|))
(SETQ |$wheredefs| NIL)
@@ -1066,7 +1066,7 @@
(|bpBracketConstruct| #'|bpPatternL|)))
(DEFUN |bpBVString| ()
- (DECLARE (SPECIAL |$stok| |$ttok|))
+ (DECLARE (SPECIAL |$ttok| |$stok|))
(AND (EQ (|shoeTokType| |$stok|) 'STRING)
(|bpPush| (LIST 'BVQUOTE (INTERN |$ttok|))) (|bpNext|)))
@@ -1171,7 +1171,7 @@
(DEFUN |bpOutItem| ()
(PROG (|$GenVarCounter| |$op| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
- (DECLARE (SPECIAL |$op| |$GenVarCounter| |$InteractiveMode|))
+ (DECLARE (SPECIAL |$GenVarCounter| |$op| |$InteractiveMode|))
(RETURN
(PROGN
(SETQ |$op| NIL)
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 1df760be..af316d42 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -36,7 +36,7 @@
(DEFUN |shoeNextLine| (|s|)
(PROG (|s1| |a|)
- (DECLARE (SPECIAL |$linepos| |$f| |$r| |$ln| |$n| |$sz|))
+ (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|))
(RETURN
(COND ((|bStreamNull| |s|) NIL)
(T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|))
@@ -55,7 +55,7 @@
(DEFUN |shoeLineToks| (|s|)
(PROG (|$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f| |toks| |dq|
|command|)
- (DECLARE (SPECIAL |$f| |$floatok| |$sz| |$linepos| |$ln| |$r| |$n|))
+ (DECLARE (SPECIAL |$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f|))
(RETURN
(PROGN
(SETQ |$f| NIL)
@@ -87,7 +87,7 @@
(DEFUN |shoeLispToken| (|s| |string|)
(PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
- (DECLARE (SPECIAL |$ln| |$linepos|))
+ (DECLARE (SPECIAL |$linepos| |$ln|))
(RETURN
(PROGN
(COND
@@ -105,7 +105,7 @@
(DEFUN |shoeAccumulateLines| (|s| |string|)
(PROG (|a| |command|)
- (DECLARE (SPECIAL |$n| |$r| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$r| |$n|))
(RETURN
(COND ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|))
((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
@@ -131,7 +131,7 @@
(DEFUN |shoeToken| ()
(PROG (|b| |ch| |n| |linepos|)
- (DECLARE (SPECIAL |$linepos| |$n| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$n| |$linepos|))
(RETURN
(PROGN
(SETQ |linepos| |$linepos|)
@@ -184,7 +184,7 @@
(DEFUN |shoeLispEscape| ()
(PROG (|n| |exp| |a|)
- (DECLARE (SPECIAL |$n| |$sz| |$linepos| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|))
(RETURN
(PROGN
(SETQ |$n| (+ |$n| 1))
@@ -207,7 +207,7 @@
(DEFUN |shoeEsc| ()
(PROG (|n1|)
- (DECLARE (SPECIAL |$n| |$sz| |$r| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$r| |$sz| |$n|))
(RETURN
(COND
((NOT (< |$n| |$sz|))
@@ -225,7 +225,7 @@
(DEFUN |shoeStartsComment| ()
(PROG (|www|)
- (DECLARE (SPECIAL |$n| |$sz| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
(RETURN
(COND
((< |$n| |$sz|)
@@ -238,7 +238,7 @@
(DEFUN |shoeStartsNegComment| ()
(PROG (|www|)
- (DECLARE (SPECIAL |$n| |$sz| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
(RETURN
(COND
((< |$n| |$sz|)
@@ -251,7 +251,7 @@
(DEFUN |shoeNegComment| ()
(PROG (|n|)
- (DECLARE (SPECIAL |$n| |$sz| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
(RETURN
(PROGN
(SETQ |n| |$n|)
@@ -260,7 +260,7 @@
(DEFUN |shoeComment| ()
(PROG (|n|)
- (DECLARE (SPECIAL |$n| |$sz| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
(RETURN
(PROGN
(SETQ |n| |$n|)
@@ -269,7 +269,7 @@
(DEFUN |shoePunct| ()
(PROG (|sss|)
- (DECLARE (SPECIAL |$ln| |$n|))
+ (DECLARE (SPECIAL |$n| |$ln|))
(RETURN
(PROGN
(SETQ |sss| (|shoeMatch| |$ln| |$n|))
@@ -284,7 +284,7 @@
(T (SETQ |$floatok| (NOT (|shoeCloser| |w|))) (|shoeLeafKey| |w|))))
(DEFUN |shoePossFloat| (|w|)
- (DECLARE (SPECIAL |$n| |$sz| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
(COND
((OR (NOT (< |$n| |$sz|)) (NOT (DIGIT-CHAR-P (SCHAR |$ln| |$n|))))
(|shoeLeafKey| |w|))
@@ -292,7 +292,7 @@
(DEFUN |shoeSpace| ()
(PROG (|n|)
- (DECLARE (SPECIAL |$n| |$ln| |$floatok|))
+ (DECLARE (SPECIAL |$floatok| |$ln| |$n|))
(RETURN
(PROGN
(SETQ |n| |$n|)
@@ -302,7 +302,7 @@
(T (|shoeLeafSpaces| (- |$n| |n|))))))))
(DEFUN |shoeString| ()
- (DECLARE (SPECIAL |$n| |$floatok|))
+ (DECLARE (SPECIAL |$floatok| |$n|))
(PROGN
(SETQ |$n| (+ |$n| 1))
(SETQ |$floatok| NIL)
@@ -310,7 +310,7 @@
(DEFUN |shoeS| ()
(PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|)
- (DECLARE (SPECIAL |$n| |$sz| |$linepos| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|))
(RETURN
(COND
((NOT (< |$n| |$sz|))
@@ -345,7 +345,7 @@
(DEFUN |shoeW| (|b|)
(PROG (|bb| |a| |str| |endid| |l| |n1|)
- (DECLARE (SPECIAL |$n| |$sz| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
(RETURN
(PROGN
(SETQ |n1| |$n|)
@@ -378,7 +378,7 @@
(DEFUN |shoeInteger1| (|zro|)
(PROG (|bb| |a| |str| |l| |n|)
- (DECLARE (SPECIAL |$n| |$sz| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
(RETURN
(PROGN
(SETQ |n| |$n|)
@@ -412,7 +412,7 @@
(DEFUN |shoeNumber| ()
(PROG (|w| |n| |a|)
- (DECLARE (SPECIAL |$n| |$sz| |$floatok| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$floatok| |$sz| |$n|))
(RETURN
(PROGN
(SETQ |a| (|shoeInteger|))
@@ -427,7 +427,7 @@
(DEFUN |shoeExponent| (|a| |w|)
(PROG (|c1| |e| |c| |n|)
- (DECLARE (SPECIAL |$n| |$sz| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$sz| |$n|))
(RETURN
(COND ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0))
(T (SETQ |n| |$n|) (SETQ |c| (SCHAR |$ln| |$n|))
@@ -456,7 +456,7 @@
(DEFUN |shoeError| ()
(PROG (|n|)
- (DECLARE (SPECIAL |$n| |$linepos| |$ln|))
+ (DECLARE (SPECIAL |$ln| |$linepos| |$n|))
(RETURN
(PROGN
(SETQ |n| |$n|)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index eec8f45e..31e89d35 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -27,7 +27,7 @@
(DEFUN |genModuleFinalization| (|stream|)
(PROG (|init|)
- (DECLARE (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName|))
+ (DECLARE (SPECIAL |$currentModuleName| |$foreignsDefsForCLisp|))
(RETURN
(COND
((|%hasFeature| :CLISP)
@@ -454,8 +454,8 @@
(DEFUN |shoeOutParse| (|stream|)
(PROG (|found|)
(DECLARE
- (SPECIAL |$inputStream| |$stack| |$stok| |$ttok| |$op| |$wheredefs|
- |$typings| |$returns| |$bpCount| |$bpParenCount|))
+ (SPECIAL |$bpParenCount| |$bpCount| |$returns| |$typings| |$wheredefs|
+ |$op| |$ttok| |$stok| |$stack| |$inputStream|))
(RETURN
(PROGN
(SETQ |$inputStream| |stream|)
@@ -611,8 +611,8 @@
(DEFUN |translateToplevel| (|b| |export?|)
(PROG (|csts| |lhs| |t| |ISTMP#2| |sig| |ns| |n| |ISTMP#1| |xs|)
(DECLARE
- (SPECIAL |$currentModuleName| |$foreignsDefsForCLisp|
- |$constantIdentifiers| |$InteractiveMode| |$activeNamespace|))
+ (SPECIAL |$activeNamespace| |$InteractiveMode| |$constantIdentifiers|
+ |$foreignsDefsForCLisp| |$currentModuleName|))
(RETURN
(COND ((NOT (CONSP |b|)) (LIST |b|))
((AND (CONSP |b|) (EQ (CAR |b|) 'TUPLE)) (SETQ |xs| (CDR |b|))
@@ -808,7 +808,7 @@
(PROG (|$bfClamming| |$bootDefinedTwice| |$bootUsed| |$bootDefined|
|$lispWordTable| |stream|)
(DECLARE
- (SPECIAL |$bootDefined| |$bootUsed| |$bootDefinedTwice| |$bfClamming|
+ (SPECIAL |$bfClamming| |$bootDefinedTwice| |$bootUsed| |$bootDefined|
|$lispWordTable|))
(RETURN
(COND ((NULL |a|) (|shoeNotFound| |fn|))
@@ -827,7 +827,7 @@
(DEFUN |shoeReport| (|stream|)
(PROG (|b| |a|)
- (DECLARE (SPECIAL |$bootDefined| |$bootDefinedTwice| |$bootUsed|))
+ (DECLARE (SPECIAL |$bootUsed| |$bootDefinedTwice| |$bootDefined|))
(RETURN
(PROGN
(|shoeFileLine| "DEFINED and not USED" |stream|)
@@ -885,7 +885,7 @@
(DEFUN |defuse| (|e| |x|)
(PROG (|niens| |nee| |LETTMP#1| |exp| |ISTMP#5| |id| |ISTMP#4| |ISTMP#3|
|body| |bv| |ISTMP#2| |name| |ISTMP#1|)
- (DECLARE (SPECIAL |$used| |$bootDefined| |$bootDefinedTwice| |$bootUsed|))
+ (DECLARE (SPECIAL |$bootUsed| |$bootDefinedTwice| |$bootDefined| |$used|))
(RETURN
(PROGN
(SETQ |x| (|stripm| |x| *PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
@@ -974,7 +974,7 @@
(DEFUN |defuse1| (|e| |y|)
(PROG (|ndol| |dol| |LETTMP#1| |b| |a| |ISTMP#1|)
- (DECLARE (SPECIAL |$used| |$bootDefined|))
+ (DECLARE (SPECIAL |$bootDefined| |$used|))
(RETURN
(COND
((NOT (CONSP |y|))
@@ -1085,7 +1085,7 @@
(PROG (|$bfClamming| |$bootUsed| |$bootDefined| |$lispWordTable| |stream|
|out|)
(DECLARE
- (SPECIAL |$bootDefined| |$bootUsed| |$bfClamming| |$lispWordTable|))
+ (SPECIAL |$bfClamming| |$bootUsed| |$bootDefined| |$lispWordTable|))
(RETURN
(COND ((NULL |a|) (|shoeNotFound| |fn|))
(T (SETQ |$lispWordTable| (|makeTable| #'EQ))
@@ -1198,34 +1198,30 @@
(|shoePCompileTrees| (|shoeTransformString| |string|)))
(DEFUN BOOTLOOP ()
- (PROG (|stream| |b| |a|)
+ (PROG (|stream| |a|)
(RETURN
(PROGN
(SETQ |a| (|readLine| *STANDARD-INPUT*))
(COND
((EQL (LENGTH |a|) 0) (WRITE-LINE "Boot Loop; to exit type ] ")
(BOOTLOOP))
- (T (SETQ |b| (|shoePrefix?| ")console" |a|))
- (COND
- (|b| (SETQ |stream| *TERMINAL-IO*) (PSTTOMC (|bRgen| |stream|))
- (BOOTLOOP))
- ((CHAR= (SCHAR |a| 0) (|char| '])) NIL)
- (T (PSTTOMC (LIST |a|)) (BOOTLOOP)))))))))
+ ((|shoePrefix?| ")console" |a|) (SETQ |stream| *TERMINAL-IO*)
+ (PSTTOMC (|bRgen| |stream|)) (BOOTLOOP))
+ ((CHAR= (SCHAR |a| 0) (|char| '])) NIL)
+ (T (PSTTOMC (LIST |a|)) (BOOTLOOP)))))))
(DEFUN BOOTPO ()
- (PROG (|stream| |b| |a|)
+ (PROG (|stream| |a|)
(RETURN
(PROGN
(SETQ |a| (|readLine| *STANDARD-INPUT*))
(COND
((EQL (LENGTH |a|) 0) (WRITE-LINE "Boot Loop; to exit type ] ")
(BOOTPO))
- (T (SETQ |b| (|shoePrefix?| ")console" |a|))
- (COND
- (|b| (SETQ |stream| *TERMINAL-IO*) (PSTOUT (|bRgen| |stream|))
- (BOOTPO))
- ((CHAR= (SCHAR |a| 0) (|char| '])) NIL)
- (T (PSTOUT (LIST |a|)) (BOOTPO)))))))))
+ ((|shoePrefix?| ")console" |a|) (SETQ |stream| *TERMINAL-IO*)
+ (PSTOUT (|bRgen| |stream|)) (BOOTPO))
+ ((CHAR= (SCHAR |a| 0) (|char| '])) NIL)
+ (T (PSTOUT (LIST |a|)) (BOOTPO)))))))
(DEFUN PSTOUT (|string|)
(LET ((*PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
--
cgit v1.2.3