From b1cd408a22e554e9e9a950aef3a89ea9f665a5b6 Mon Sep 17 00:00:00 2001 From: dos-reis 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/ChangeLog | 6 +++ src/boot/ast.boot | 62 ++++++++++----------- src/boot/strap/ast.clisp | 117 +++++++++++++++++++++++----------------- src/boot/strap/parser.clisp | 46 ++++++++-------- src/boot/strap/scanner.clisp | 42 +++++++-------- src/boot/strap/translator.clisp | 44 +++++++-------- 6 files changed, 171 insertions(+), 146 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index d8ac3c9a..190ef488 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2012-05-19 Gabriel Dos Reis + + * boot/ast.boot (shoeCompTran1): Take variable sets by reference. + Remove globals. Adjust caller. + (shoeCompTran): Replace fluid variables by references. + 2012-05-19 Gabriel Dos Reis * boot/tokens.boot: symbolBinding is now builtin. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 3e484e29..a6095248 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -997,19 +997,19 @@ bfInsertLet1(y,body)== shoeCompTran x== [lamtype,args,:body] := x - $fluidVars: local := nil - $locVars: local := nil - $dollarVars: local :=nil - shoeCompTran1 body - $locVars := setDifference(setDifference($locVars,$fluidVars),shoeATOMs args) + fluidVars := ref [] + locVars := ref [] + dollarVars := ref [] + shoeCompTran1(body,fluidVars,locVars,dollarVars) + deref(locVars) := setDifference(setDifference(deref locVars,deref fluidVars),shoeATOMs args) body := - lvars := append($fluidVars,$locVars) - $fluidVars := UNION($fluidVars,$dollarVars) + lvars := append(deref fluidVars,deref locVars) + deref(fluidVars) := setUnion(deref fluidVars,deref dollarVars) body' := body if $typings then body' := [["DECLARE",:$typings],:body'] - if $fluidVars then - fvars := ["DECLARE",["SPECIAL",:$fluidVars]] + if deref fluidVars then + fvars := ["DECLARE",["SPECIAL",:deref fluidVars]] body' := [fvars,:body'] lvars or needsPROG body => shoePROG(lvars,body') body' @@ -1050,44 +1050,46 @@ isDynamicVariable x == true false -shoeCompTran1 x == +shoeCompTran1(x,fluidVars,locVars,dollarVars) == x isnt [.,:.] => - if isDynamicVariable x and not symbolMember?(x,$dollarVars) then - $dollarVars := [x,:$dollarVars] + if isDynamicVariable x and not symbolMember?(x,deref dollarVars) then + deref(dollarVars) := [x,:deref dollarVars] x U := first x U is 'QUOTE => x x is ["CASE",y,:zs] => - second(x) := shoeCompTran1 y + second(x) := shoeCompTran1(y,fluidVars,locVars,dollarVars) while zs ~= nil repeat - second(first zs) := shoeCompTran1 second first zs + second(first zs) := + shoeCompTran1(second first zs,fluidVars,locVars,dollarVars) zs := rest zs x x is ["L%T",l,r] => x.op := "SETQ" - third(x) := shoeCompTran1 r + third(x) := shoeCompTran1(r,fluidVars,locVars,dollarVars) symbol? l => bfBeginsDollar l => - if not symbolMember?(l,$dollarVars) then - $dollarVars := [l,:$dollarVars] + if not symbolMember?(l,deref dollarVars) then + deref(dollarVars) := [l,:deref dollarVars] x - if not symbolMember?(l,$locVars) then - $locVars := [l,:$locVars] + if not symbolMember?(l,deref locVars) then + deref(locVars) := [l,:deref locVars] x l is ['%Dynamic,:.] => - if not symbolMember?(second l,$fluidVars) then - $fluidVars := [second l,:$fluidVars] + if not symbolMember?(second l,deref fluidVars) then + deref(fluidVars) := [second l,:deref fluidVars] x.rest.first := second l x U is "%Leave" => (x.op := "RETURN"; x) U in '(PROG LAMBDA) => newbindings := nil for y in second x repeat - not symbolMember?(y,$locVars)=> - $locVars := [y,:$locVars] + not symbolMember?(y,deref locVars)=> + deref(locVars) := [y,:deref(locVars)] newbindings := [y,:newbindings] - rest(x).rest := shoeCompTran1 CDDR x - $locVars := [y for y in $locVars | not symbolMember?(y,newbindings)] + rest(x).rest := shoeCompTran1(CDDR x,fluidVars,locVars,dollarVars) + deref(locVars) := [y for y in deref locVars | + not symbolMember?(y,newbindings)] x -- literal vectors. x is ['vector,elts] => @@ -1097,19 +1099,19 @@ shoeCompTran1 x == x.args := nil elts is ['LIST,:.] => x.op := 'VECTOR - x.args := shoeCompTran1 elts.args + x.args := shoeCompTran1(elts.args,fluidVars,locVars,dollarVars) elts isnt [.,:.] => - elts := shoeCompTran1 elts + elts := shoeCompTran1(elts,fluidVars,locVars,dollarVars) x.op := 'MAKE_-ARRAY x.args := [['LIST_-LENGTH,elts],KEYWORD::INITIAL_-CONTENTS,elts] x.op := 'COERCE - x.args := [shoeCompTran1 elts,quote 'VECTOR] + x.args := [shoeCompTran1(elts,fluidVars,locVars,dollarVars),quote 'VECTOR] x x is ['%Namespace,n] => n is "DOT" => "*PACKAGE*" ["FIND-PACKAGE",symbolName n] - x.first := shoeCompTran1 first x - x.rest := shoeCompTran1 rest x + x.first := shoeCompTran1(first x,fluidVars,locVars,dollarVars) + x.rest := shoeCompTran1(rest x,fluidVars,locVars,dollarVars) x bfTagged(a,b)== 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