diff options
| -rw-r--r-- | src/ChangeLog | 4 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 50 |
2 files changed, 31 insertions, 23 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 37e87fe7..c17550cc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,9 @@ 2009-07-13 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/g-opt.boot (optCatch): Lift nested functions. + +2009-07-13 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/metalex.lisp: "break" is now a keyword. * interp/fnewmeta.lisp (PARSE-Jump): New. * interp/compiler.boot (compAtom): Dipatch compilation of "break" diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index f3a29f81..9e08d9a8 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -114,36 +114,40 @@ subrname u == COMPILED_-FUNCTION_-P u or MBPIP u => BPINAME u nil +changeThrowToExit(s,g) == + atom s or MEMQ(first s,'(QUOTE SEQ REPEAT COLLECT)) => nil + s is ["THROW", =g,:u] => (rplac(first s,"EXIT"); rplac(rest s,u)) + changeThrowToExit(first s,g) + changeThrowToExit(rest s,g) + +hasNoThrows(a,g) == + a is ["THROW", =g,:.] => false + atom a => true + hasNoThrows(first a,g) and hasNoThrows(rest a,g) + +changeThrowToGo(s,g) == + atom s or first s='QUOTE => nil + s is ["THROW", =g,u] => + changeThrowToGo(u,g) + rplac(first s,"PROGN") + rplac(rest s,[["%LET",second g,u],["GO",second g]]) + changeThrowToGo(first s,g) + changeThrowToGo(rest s,g) + optCatch (x is ["CATCH",g,a]) == $InteractiveMode => x atom a => a if a is ["SEQ",:s,["THROW", =g,u]] then - changeThrowToExit(s,g) where - changeThrowToExit(s,g) == - atom s or MEMQ(first s,'(QUOTE SEQ REPEAT COLLECT)) => nil - s is ["THROW", =g,:u] => (rplac(first s,"EXIT"); rplac(rest s,u)) - changeThrowToExit(first s,g) - changeThrowToExit(rest s,g) + changeThrowToExit(s,g) rplac(rest a,[:s,["EXIT",u]]) ["CATCH",y,a]:= optimize x - if hasNoThrows(a,g) where - hasNoThrows(a,g) == - a is ["THROW", =g,:.] => false - atom a => true - hasNoThrows(first a,g) and hasNoThrows(rest a,g) - then (rplac(first x,first a); rplac(rest x,rest a)) - else - changeThrowToGo(a,g) where - changeThrowToGo(s,g) == - atom s or first s='QUOTE => nil - s is ["THROW", =g,u] => - changeThrowToGo(u,g) - rplac(first s,"PROGN") - rplac(rest s,[["%LET",CADR g,u],["GO",CADR g]]) - changeThrowToGo(first s,g) - changeThrowToGo(rest s,g) + if hasNoThrows(a,g) then + rplac(first x,first a) + rplac(rest x,rest a) + else + changeThrowToGo(a,g) rplac(first x,"SEQ") - rplac(rest x,[["EXIT",a],CADR g,["EXIT",CADR g]]) + rplac(rest x,[["EXIT",a],second g,["EXIT",second g]]) x optSPADCALL(form is ['SPADCALL,:argl]) == |