aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-07-25 05:47:00 +0000
committerdos-reis <gdr@axiomatics.org>2010-07-25 05:47:00 +0000
commit7766e42778a0bfe271b35d6265122ca7103da24c (patch)
treeff6f4e6b4d877c60f6b3162cd07fd335db518fd4
parent32593f2cb2bd9c344b83edec738f81eee3128d34 (diff)
downloadopen-axiom-7766e42778a0bfe271b35d6265122ca7103da24c.tar.gz
* interp/g-opt.boot (resetTo): New.
(optCatch): Use it. (optCall): Likewise. (optSpecialCall): Likewise. (simplifyVMForm): Handle simple cases here. * interp/macros.lisp (RPLACW): Remove.
-rw-r--r--src/ChangeLog9
-rw-r--r--src/interp/g-opt.boot21
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/macros.lisp4
4 files changed, 26 insertions, 10 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 17b9cf46..48770f4c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2010-07-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/g-opt.boot (resetTo): New.
+ (optCatch): Use it.
+ (optCall): Likewise.
+ (optSpecialCall): Likewise.
+ (simplifyVMForm): Handle simple cases here.
+ * interp/macros.lisp (RPLACW): Remove.
+
2010-07-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/g-opt.boot (optIadd): More simplification if either
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 47f3ca2d..5adf1d48 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -138,10 +138,22 @@ optimizeFunctionDef(def) ==
changeVariableDefinitionToStore(body',args)
[name,[slamOrLam,args,groupVariableDefinitions body']]
+resetTo(x,y) ==
+ atom y => x := y
+ EQ(x,y) => x
+ x.first := y.first
+ x.rest := y.rest
+ x
+
++ Like `optimize', except that non-atomic form may be reduced to
++ to atomic forms. In particular, the address of the input may
++ not be the same as that of the output.
simplifyVMForm x ==
+ isAtomicForm x => x
+ x.op = 'CLOSEDFN => x
+ x is [op,vars,body] and op in $AbstractionOperator =>
+ third(x) := simplifyVMForm body
+ x
first optimize [x]
optimize x ==
@@ -214,8 +226,7 @@ optCatch (x is ["CATCH",g,a]) ==
a.rest := [:s,["EXIT",u]]
["CATCH",y,a]:= optimize x
if hasNoThrows(a,g) then
- x.first := first a
- x.rest := rest a
+ resetTo(x,a)
else
changeThrowToGo(a,g)
x.first := "SEQ"
@@ -234,8 +245,8 @@ optCall (x is ['%call,:u]) ==
x:= optimize [u]
-- next should happen only as result of macro expansion
atom first x => first x
- [fn,:a]:= first x
- atom fn => (x.rest := a; x.first := fn)
+ [fn,:a] := u := first x
+ atom fn => resetTo(x,u)
fn is ["applyFun",name] =>
(x.first := "SPADCALL"; x.rest := [:a,name]; x)
fn is [q,R,n] and q in '(getShellEntry ELT QREFELT CONST) =>
@@ -291,7 +302,7 @@ optSpecialCall(x,y,n) ==
x.rest := CDAR x
x.first := fn
if fn is ["XLAM",:.] then x := simplifyVMForm x
- x is ["EQUAL",:args] => RPLACW(x,DEF_-EQUAL args)
+ x is ["EQUAL",:args] => resetTo(x,DEF_-EQUAL args)
--DEF-EQUAL is really an optimiser
x
[fn,:a]:= first x
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 5d6cd5a9..9817e8e4 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -49,7 +49,7 @@ module g_-util where
--%
$AbstractionOperator ==
- '(LAM ILAM SLAM SPADSLAM LAMBDA)
+ '(LAM ILAM SLAM XLAM SPADSLAM LAMBDA)
++ Return true if the symbol 's' is used in the form 'x'.
usedSymbol?(s,x) ==
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index e9fff330..a99b3e4e 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -215,10 +215,6 @@
((EQL (CDR L) TL) (RPLACD L NIL))
((TRUNCLIST-1 (CDR L) TL))))
-; 15.3 Alteration of List Structure
-
-(defun RPLACW (x w) (let (y z) (dsetq (Y . Z) w) (RPLACA X Y) (RPLACD X Z) X))
-
; 15.4 Substitution of Expressions
(DEFUN SUBSTEQ (NEW OLD FORM)