From de2c2df64f452b8b50f94ebc1aec30830b6cc1e0 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 5 May 2010 13:56:53 +0000
Subject: 	* interp/compiler.boot (compSetq1): Call self, not compSetq. 
 * interp/c-util.boot (isAtomicForm): Move to g-util.boot. 	*
 interp/g-opt.boot (optSEQ): Splice toplevel PROGN forms. 	*
 interp/g-util.boot (isAtomicForm): Move from c-util.boot.  Export.

---
 src/interp/c-util.boot   | 5 -----
 src/interp/compiler.boot | 5 +++--
 src/interp/g-opt.boot    | 6 +++++-
 src/interp/g-util.boot   | 5 +++++
 4 files changed, 13 insertions(+), 8 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 58f830df..46417f08 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1098,11 +1098,6 @@ eqSubst(args,parms,body) ==
   NSUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ)
 
 
-++ returns true if `form' does not really induce computations.
-isAtomicForm: %Form -> %Boolean
-isAtomicForm form ==
-  atom form or first form = "QUOTE"
-
 ++ Walk `form' and replace simple functions as appropriate.
 replaceSimpleFunctions form ==
   isAtomicForm form => form
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 15edaf3c..96661790 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -788,7 +788,7 @@ compSetq1(form,val,m,E) ==
   IDENTP form => setqSingle(form,val,m,E)
   form is [":",x,y] =>
     [.,.,E']:= compMakeDeclaration(x,y,E)
-    compSetq(["%LET",x,val],m,E')
+    compSetq1(x,val,m,E')
   form is [op,:l] =>
     op="CONS"  => setqMultiple(uncons form,val,m,E)
     op="%Comma" => setqMultiple(l,val,m,E)
@@ -854,7 +854,8 @@ assignError(val,m',form,m) ==
 setqMultiple(nameList,val,m,e) ==
   val is ["CONS",:.] and m=$NoValueMode =>
     setqMultipleExplicit(nameList,uncons val,m,e)
-  val is ["%Comma",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
+  val is ["%Comma",:l] and m=$NoValueMode => 
+    setqMultipleExplicit(nameList,l,m,e)
   -- 1. create a gensym, %add to local environment, compile and assign rhs
   g:= genVariable()
   e:= addBinding(g,nil,e)
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index aedaa218..cfaa3730 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -315,7 +315,11 @@ optCONDtail l ==
   [frst,:optCONDtail l']
  
 optSEQ ["SEQ",:l] ==
-  tryToRemoveSEQ SEQToCOND getRidOfTemps l where
+  tryToRemoveSEQ SEQToCOND getRidOfTemps splicePROGN l where
+    splicePROGN l ==
+      isAtomicForm l => l
+      l is [["PROGN",:stmts],:l'] => [:stmts,:l']
+      rplac(rest l, splicePROGN rest l)
     getRidOfTemps l ==
       null l => nil
       l is [["%LET",g,x,:.],:r] and GENSYMP g and 2>numOfOccurencesOf(g,r) =>
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 6e81bee5..a2815575 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -38,6 +38,7 @@ import sys_-utility
 namespace BOOT
 
 module g_-util where
+  isAtomicForm: %Form -> %Boolean
   getTypeOfSyntax: %Form -> %Mode
   pairList: (%List,%List) -> %List
   mkList: %List -> %List
@@ -66,6 +67,10 @@ isSharpVarWithNum x ==
     ok := DIGITP d => c := 10*c + DIG2FIX d
   if ok then c else nil
 
+++ Returns true if `form' is either an atom or a quotation.
+isAtomicForm form ==
+  atom form or first form = "QUOTE"
+
 
 --% Sub-domains information handlers
 
-- 
cgit v1.2.3