* interp/g-opt.boot (resetTo): New.

	(optCatch): Use it.
	(optCall): Likewise.
	(optSpecialCall): Likewise.
	(simplifyVMForm): Handle simple cases here.
	* interp/macros.lisp (RPLACW): Remove.

3 files changed, 17 insertions, 10 deletions

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)