From 4fbe17f6ca64c10f69729c412b7a198da4af65a0 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Mon, 7 Jun 2010 11:18:27 +0000 Subject: * interp/c-util.boot (isLispSpecialVariable): New. (mutateToBackendCode): Use it to record special vars. Be careful with locally bound variables. --- src/ChangeLog | 6 +++ src/algebra/strap/ISTRING.lsp | 2 +- src/algebra/strap/POLYCAT-.lsp | 94 +++++++++++++++++++++--------------------- src/interp/c-util.boot | 17 ++++++-- 4 files changed, 68 insertions(+), 51 deletions(-) (limited to 'src') diff --git a/src/ChangeLog b/src/ChangeLog index c1bf33c4..4a682fdd 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2010-06-07 Gabriel Dos Reis + + * interp/c-util.boot (isLispSpecialVariable): New. + (mutateToBackendCode): Use it to record special vars. + Be careful with locally bound variables. + 2010-06-06 Gabriel Dos Reis * interp/compiler.boot (replaceExitEtc): Tidy. diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index e13365f3..5ff74145 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -670,7 +670,7 @@ (|stringMatch| |pattern| |target| (CHARACTER |wildcard|))) (DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $) - (PROG (|n| |m| |s| #0=#:G1521 |i| |p| |q|) + (PROG (|m| |n| |s| #0=#:G1521 |i| |p| |q|) (RETURN (SEQ (EXIT (SEQ (LETT |n| (SPADCALL |pattern| (|getShellEntry| $ 47)) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index 52d48644..e44c104e 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -142,7 +142,7 @@ |POLYCAT-;convert;SIf;43|)) (DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $) - (PROG (#0=#:G1691 #1=#:G1427 |lvar|) + (PROG (|e| #0=#:G1691 #1=#:G1427 |lvar|) (RETURN (SEQ (COND ((NULL |l|) |p|) @@ -732,11 +732,11 @@ (|getShellEntry| $ 159))))))))))) (DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) - (PROG (|ll| |ch| |l| #0=#:G1722 #1=#:G1723 #2=#:G1583 #3=#:G1581 - #4=#:G1582 #5=#:G1724 |vars| |degs| |nd| #6=#:G1609 - |deg1| |redmons| |llR| |monslist| |ans| #7=#:G1610 |mons| - #8=#:G1730 |m| #9=#:G1731 |i| #10=#:G1605 #11=#:G1603 - #12=#:G1604) + (PROG (#0=#:G1610 #1=#:G1730 #2=#:G1731 #3=#:G1605 #4=#:G1603 + #5=#:G1604 |nd| #6=#:G1609 |ll| |ch| |l| #7=#:G1722 |u| + #8=#:G1723 #9=#:G1583 #10=#:G1581 #11=#:G1582 |mons| |m| + #12=#:G1724 |vars| |degs| |deg1| |redmons| |llR| |monslist| + |ans| |i|) (RETURN (SEQ (EXIT (SEQ (LETT |ll| (SPADCALL @@ -759,52 +759,52 @@ (LETT |ch| (|spadConstant| $ 169) |POLYCAT-;conditionP;MU;27|) (SEQ (LETT |l| NIL |POLYCAT-;conditionP;MU;27|) - (LETT #0# |ll| |POLYCAT-;conditionP;MU;27|) + (LETT #7# |ll| |POLYCAT-;conditionP;MU;27|) G190 (COND - ((OR (ATOM #0#) - (PROGN (SETQ |l| (CAR #0#)) NIL)) + ((OR (ATOM #7#) + (PROGN (SETQ |l| (CAR #7#)) NIL)) (GO G191))) (SEQ (LETT |mons| (PROGN - (LETT #4# NIL + (LETT #11# NIL |POLYCAT-;conditionP;MU;27|) (SEQ (LETT |u| NIL |POLYCAT-;conditionP;MU;27|) - (LETT #1# |l| + (LETT #8# |l| |POLYCAT-;conditionP;MU;27|) G190 (COND - ((OR (ATOM #1#) + ((OR (ATOM #8#) (PROGN - (SETQ |u| (CAR #1#)) + (SETQ |u| (CAR #8#)) NIL)) (GO G191))) (SEQ (EXIT (PROGN - (LETT #2# + (LETT #9# (SPADCALL |u| (|getShellEntry| $ 98)) |POLYCAT-;conditionP;MU;27|) (COND - (#4# - (LETT #3# - (SPADCALL #3# #2# + (#11# + (LETT #10# + (SPADCALL #10# #9# (|getShellEntry| $ 170)) |POLYCAT-;conditionP;MU;27|)) ('T (PROGN - (LETT #3# #2# + (LETT #10# #9# |POLYCAT-;conditionP;MU;27|) - (LETT #4# 'T + (LETT #11# 'T |POLYCAT-;conditionP;MU;27|))))))) - (SETQ #1# (CDR #1#)) (GO G190) + (SETQ #8# (CDR #8#)) (GO G190) G191 (EXIT NIL)) (COND - (#4# #3#) + (#11# #10#) ('T (|IdentityError| '|setUnion|)))) @@ -813,13 +813,13 @@ |POLYCAT-;conditionP;MU;27|) (SEQ (LETT |m| NIL |POLYCAT-;conditionP;MU;27|) - (LETT #5# |mons| + (LETT #12# |mons| |POLYCAT-;conditionP;MU;27|) G190 (COND - ((OR (ATOM #5#) + ((OR (ATOM #12#) (PROGN - (SETQ |m| (CAR #5#)) + (SETQ |m| (CAR #12#)) NIL)) (GO G191))) (SEQ @@ -908,12 +908,12 @@ (SETQ #18# (CDR #18#)) (SETQ #19# (CDR #19#)))) |POLYCAT-;conditionP;MU;27|))) - (SETQ #5# (CDR #5#)) (GO G190) + (SETQ #12# (CDR #12#)) (GO G190) G191 (EXIT NIL)) (EXIT (LETT |monslist| (CONS |redmons| |monslist|) |POLYCAT-;conditionP;MU;27|))) - (SETQ #0# (CDR #0#)) (GO G190) G191 + (SETQ #7# (CDR #7#)) (GO G190) G191 (EXIT NIL)) (LETT |ans| (SPADCALL @@ -937,43 +937,43 @@ (|getShellEntry| $ 6)) (SIZE |monslist|)))) (SEQ - (LETT #7# 0 + (LETT #0# 0 |POLYCAT-;conditionP;MU;27|) (LETT |mons| NIL |POLYCAT-;conditionP;MU;27|) - (LETT #8# |monslist| + (LETT #1# |monslist| |POLYCAT-;conditionP;MU;27|) G190 (COND - ((OR (ATOM #8#) + ((OR (ATOM #1#) (PROGN - (SETQ |mons| (CAR #8#)) + (SETQ |mons| (CAR #1#)) NIL)) (GO G191))) (SEQ (EXIT (|setSimpleArrayEntry| #21# - #7# + #0# (PROGN - (LETT #12# NIL + (LETT #5# NIL |POLYCAT-;conditionP;MU;27|) (SEQ (LETT |m| NIL |POLYCAT-;conditionP;MU;27|) - (LETT #9# |mons| + (LETT #2# |mons| |POLYCAT-;conditionP;MU;27|) G190 (COND - ((OR (ATOM #9#) + ((OR (ATOM #2#) (PROGN (SETQ |m| - (CAR #9#)) + (CAR #2#)) NIL)) (GO G191))) (SEQ (EXIT (PROGN - (LETT #10# + (LETT #3# (SPADCALL |m| (SPADCALL (SPADCALL @@ -989,29 +989,29 @@ 182)) |POLYCAT-;conditionP;MU;27|) (COND - (#12# - (LETT #11# - (SPADCALL #11# - #10# + (#5# + (LETT #4# + (SPADCALL #4# + #3# (|getShellEntry| $ 183)) |POLYCAT-;conditionP;MU;27|)) ('T (PROGN - (LETT #11# #10# + (LETT #4# #3# |POLYCAT-;conditionP;MU;27|) - (LETT #12# 'T + (LETT #5# 'T |POLYCAT-;conditionP;MU;27|))))))) - (SETQ #9# (CDR #9#)) + (SETQ #2# (CDR #2#)) (GO G190) G191 (EXIT NIL)) (COND - (#12# #11#) + (#5# #4#) ('T (|spadConstant| $ 27))))))) - (SETQ #8# - (PROG1 (CDR #8#) - (SETQ #7# (QSADD1 #7#)))) + (SETQ #1# + (PROG1 (CDR #1#) + (SETQ #0# (QSADD1 #0#)))) (GO G190) G191 (EXIT NIL)) #21#))))))))) #6# (EXIT #6#))))) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 307470eb..80016080 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1445,6 +1445,12 @@ pushLocalVariable x == p.1 ~= char "," and not digit? p.1 => nil PUSH(x,$LocalVars) +isLispSpecialVariable x == + s := PNAME x + s.0 = char "$" and #s > 1 and alphabetic? s.1 and not BOUNDP x + +noteSpecialVariable x == + $SpecialVars := insert(x,$SpecialVars) --% --% Middle Env to Back End Transformations. @@ -1518,6 +1524,7 @@ ilTransformInsns form == ++ Replace every middle end sub-forms in `x' with Lisp code. mutateToBackendCode: %Form -> %Void mutateToBackendCode x == + IDENTP x and isLispSpecialVariable x => noteSpecialVariable x isAtomicForm x => nil -- temporarily have TRACELET report MAKEPROPs. if (u := first x) = "MAKEPROP" and $TRACELETFLAG then @@ -1540,13 +1547,15 @@ mutateToBackendCode x == x.first := eval u mutateToBackendCode x u in '(LET LET_*) => + oldVars := $LocalVars vars := nil for [var,init] in second x repeat mutateToBackendCode init $LocalVars := [var,:$LocalVars] vars := [var,:vars] mutateToBackendCode x.rest.rest - $LocalVars := setDifference($LocalVars,vars) + newVars := setDifference($LocalVars,setUnion(vars,oldVars)) + $LocalVars := setUnion(oldVars,newVars) u in '(PROG LAMBDA) => newBindings := [] for y in second x repeat @@ -1619,9 +1628,11 @@ transformToBackendCode x == LISTOFATOMS second x) lvars := [:$FluidVars,:$LocalVars] fluids := S_+($FluidVars,$SpecialVars) - body := + body := fluids ~= nil => - [["PROG",lvars,declareGlobalVariables fluids, ["RETURN",:body]]] + lvars ~= nil or needsPROG? body => + [["PROG",lvars,declareGlobalVariables fluids, ["RETURN",:body]]] + [declareGlobalVariables fluids,:body] lvars ~= nil or needsPROG? body => [["PROG",lvars,["RETURN",:body]]] body -- cgit v1.2.3