2 files changed, 43 insertions, 6 deletions

diff --git a/src/interp/database.boot b/src/interp/database.boot
index 48e5d1e7..06422176 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -491,15 +491,26 @@ replaceVars(x,oldvars,newvars) ==
     x := substitute(new,old,x)
   x
 
+++ Return the list of qualifying predicates of the system modemap `mm'.
+getConditionListFromMm mm ==
+  [., cond] := mm
+  if cond is ["partial", :c] then cond := c
+  cond is ["AND", :cl] => cl
+  cond is ["OR", ["AND", :cl],:.] => cl  --all cl's should give same info
+  [cond]
+
+
+++ Returns the domain of computation of the modemap `mm'.  This is not
+++ to be confused with `getDomainFromMm' below, which can also return
+++ a category.
+getDCFromSystemModemap mm ==
+  for cond in getConditionListFromMm mm repeat
+    cond is ["isDomain","*1",dom] => return dom
+
 getDomainFromMm mm ==
   -- Returns the Domain (or package or category) of origin from a pattern
   -- modemap
-  [., cond] := mm
-  if cond is ['partial, :c] then cond := c
-  condList :=
-    cond is ['AND, :cl] => cl
-    cond is ['OR, ['AND, :cl],:.] => cl  --all cl's should give same info
-    [cond]
+  condList := getConditionListFromMm mm
   val :=
     for condition in condList repeat
       condition is ['isDomain, "*1", dom] => return opOf dom
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index 26a1309d..45623e50 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -342,8 +342,34 @@ bottomUpIdentifier(t,id) ==
       (isMapExpr expr and [objMode(u)]) or
         keyedSystemError("S2GE0016",
           ['"bottomUpIdentifier",'"cannot evaluate identifier"])
+  m := namedConstant(id,t) => [m]
   bottomUpDefault(t,id,defaultType,getTarget t)
 
+getConstantObject(id,dc,sig) ==
+  mode := substitute(dc,"$",first sig)
+  $genValue =>
+    objNewWrap(SPADCALL compiledLookupCheck(id,sig,evalDomain dc),mode)
+  objNew(["SPADCALL",["compiledLookupCheck",id,sig,["evalDomain",dc]]],mode)
+
+namedConstant(id,t) ==
+  -- for the time being, ignore the case where the target type is imposed.
+  getTarget(t) ^= nil => nil
+  sysmms := getModemapsFromDatabase(id,0) or return nil
+  -- ignore polymorphic constants are not supported yet.
+  doms := [getDCFromSystemModemap sysmm for sysmm in sysmms]
+  candidates := nil
+  for dc in doms | niladicConstructorFromDB first dc repeat
+    LASSOC(id,getOperationAlistFromLisplib first dc) is [[sig,.,.,"CONST"]] =>
+      candidates := [[dc,sig],:candidates]
+  null candidates => nil
+  #candidates = 1 =>
+    [[dc,sig]] := candidates
+    val := getConstantObject(id,dc,sig)
+    putValue(t,val)
+    putMode(t,objMode val)
+    
+  -- error for ambiguity.
+
 bottomUpDefault(t,id,defaultMode,target) ==
   if $genValue
     then bottomUpDefaultEval(t,id,defaultMode,target,nil)