From a40ca0675768d44f492c2956c070bea091388a47 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 27 Feb 2011 22:51:14 +0000
Subject: 	* interp/i-analy.boot (bottomUpWithArgModesets): Split out of 
 bottomUp. 	(bottomUp): Call it.

---
 src/ChangeLog           |  6 ++++++
 src/interp/i-analy.boot | 46 +++++++++++++++++++++++++---------------------
 2 files changed, 31 insertions(+), 21 deletions(-)

(limited to 'src')

diff --git a/src/ChangeLog b/src/ChangeLog
index bee2cb4b..90824abc 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2011-02-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/i-analy.boot (bottomUpWithArgModesets): Split out of
+	bottomUp.
+	(bottomUp): Call it.
+
 2011-02-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/Makefile.in (OBJS): Remove i-spec1.$(FASLEXT) and
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index 4949f043..6a645bbc 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -260,32 +260,36 @@ bottomUp t ==
             pushDownTargetInfo(opName,tar,argl)
             argModeSetList:= [bottomUp x for x in argl]
 
-    ms := bottomUpForm(t,op,opName,argl,argModeSetList)
-    -- If this is a type producing form, then we don't want
-    -- to store the representation object in the environment.
-    -- Rather, we want to record the reified canonical form.
-    if ms is [m] and (member(m,$LangSupportTypes) or isCategoryForm(m,$e))
-    then putValue(t,objNew(devaluate objValUnwrap getValue t, m))
-
-    -- given no target or package calling, force integer constants to
-    -- belong to tightest possible subdomain
-
-    op := first t              -- may have changed in bottomUpElt
-    $useIntegerSubdomain and null tar and null dol and
-      isEqualOrSubDomain(first ms,$Integer) =>
-        val := objVal getValue op
-        isWrapped val =>       -- constant if wrapped
-          val := unwrap val
-          bm := getBasicMode val
-          putValue(op,objNewWrap(val,bm))
-          putModeSet(op,[bm])
-        ms
-    ms
+    bottomUpWithArgModesets(t,op,opName,argl,argModeSetList)
   m := getBasicMode t => [m]
   IDENTP (id := getUnname t) =>
     putModeSet(t,bottomUpIdentifier(t,id))
   keyedSystemError("S2GE0016",['"bottomUp",'"unknown object form"])
 
+bottomUpWithArgModesets(t,op,opName,args,argModeSetList) ==
+  ms := bottomUpForm(t,op,opName,args,argModeSetList)
+  -- If this is a type producing form, then we don't want
+  -- to store the representation object in the environment.
+  -- Rather, we want to record the reified canonical form.
+  if ms is [m] and (member(m,$LangSupportTypes) or isCategoryForm(m,$e))
+  then putValue(t,objNew(devaluate objValUnwrap getValue t, m))
+
+  -- given no target or package calling, force integer constants to
+  -- belong to tightest possible subdomain
+  pcall? := getAtree(op,'dollar) and (opName ~= 'construct)
+  op := t.op -- may have changed in bottomUpElt
+  $useIntegerSubdomain and getTarget op = nil and not pcall? and
+    isEqualOrSubDomain(first ms,$Integer) =>
+      val := objVal getValue op
+      isWrapped val =>       -- constant if wrapped
+        val := unwrap val
+        bm := getBasicMode val
+        putValue(op,objNewWrap(val,bm))
+        putModeSet(op,[bm])
+      ms
+  ms
+
+
 computeTypeWithVariablesTarget(p, q) ==
     polyVarlist(p) or polyVarlist(q) =>
         t := resolveTT(p, q)
-- 
cgit v1.2.3