From ac2f74a3dc5293da393f513a8677513043e1e1d7 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 5 May 2009 15:08:14 +0000
Subject: 	Fix SF/2785271 	* interp/sys-constants.boot ($Primitives):
 Remove. 	* interp/br-con.boot (conOpPage1): Replace $Primitives by 
 $DomainNames. 	(dbShowConsDoc1): Likewise. 	* interp/buildom.boot
 ($nonLisplibDomains): Likewise. 	* interp/br-op2.boot
 (kFormatSlotDomain): isConstructorName. 	* interp/br-saturn.boot
 (bfConform1): Handle string literals as 	constructor arguments.

---
 src/interp/br-con.boot        |  4 ++--
 src/interp/br-op2.boot        |  3 +--
 src/interp/br-saturn.boot     | 12 ++++++++----
 src/interp/buildom.boot       |  2 +-
 src/interp/sys-constants.boot |  5 -----
 5 files changed, 12 insertions(+), 14 deletions(-)

(limited to 'src/interp')

diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index 423ea272..b6c9f566 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -738,7 +738,7 @@ conOpPage1(conform,:options) ==
 --constructors    Cname\#\E\sig \args   \abb \comments (C is C, D, P, X)
   bindingsAlist := IFCAR options
   conname       := opOf conform
-  MEMQ(conname,$Primitives) =>
+  MEMQ(conname,$DomainNames) =>
      dbSpecialOperations conname
   domname         :=                        --> !!note!! <--
     null atom conform => conform
@@ -1055,7 +1055,7 @@ dbShowConsDoc(htPage,conlist) ==
 
 dbShowConsDoc1(htPage,conform,indexOrNil) ==
   [conname,:conargs] := conform
-  MEMQ(conname,$Primitives) =>
+  MEMQ(conname,$DomainNames) =>
     conname := htpProperty(htPage,'conname)
     [["constructor",["NIL",doc]],:.] := GETL(conname,'documentation)
     sig := '((CATEGORY domain) (SetCategory) (SetCategory))
diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot
index f4d259dd..c1f8ac28 100644
--- a/src/interp/br-op2.boot
+++ b/src/interp/br-op2.boot
@@ -424,8 +424,7 @@ kFormatSlotDomain x == fn formatSlotDomain x where fn x ==
   (op := CAR x) = '_$ => '_$
   op = 'local => CADR x
   op = ":" => [":",CADR x,fn CADDR x]
-  MEMQ(op,$Primitives) or constructor? op =>
-    [fn y for y in x]
+  isConstructorName op => [fn y for y in x]
   INTEGERP op => op
   op = 'QUOTE and atom CADR x => CADR x
   x
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index 3880cebc..272fb6e6 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -1245,7 +1245,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate,
   $conargs   : local := rest conform
   if which = '"operation" then
     $signature : local :=
-      MEMQ(conname,$Primitives) => nil
+      MEMQ(conname,$DomainNames) => nil
       CDAR getConstructorModemapFromDB conname
     --RDJ: this next line is necessary until compiler bug is fixed
     --that forgets to substitute #variables for t#variables;
@@ -1629,14 +1629,18 @@ bcConform1 form == main where
     hd form
   hd form ==
     atom form =>
-      not MEMQ(form,$Primitives) and null constructor? form =>
-        s := STRINGIMAGE form
+      -- string literals, e.g. "failed", are constructor arguments
+      -- too, until we fix that.
+      STRINGP form or not isConstructorName form =>
+        s := 
+          STRINGP form => strconc("_"",form,"_"")
+          STRINGIMAGE form
         (s.0 = char '_#) =>
            (n := POSN1(form, $FormalFunctionParameterList)) =>
               htSay form2HtString ($FormalMapVariableList . n)
            htSay '"\"
            htSay form
-        htSay escapeSpecialChars STRINGIMAGE form
+        htSay escapeSpecialChars s
       s := STRINGIMAGE form
       $italicHead? => htSayItalics s
       $bcMultipleNames =>
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 11a86a37..bc417364 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -44,7 +44,7 @@ import sys_-macros
 namespace BOOT
 
 $noCategoryDomains == '(Mode SubDomain)
-$nonLisplibDomains == APPEND($Primitives,$noCategoryDomains)
+$nonLisplibDomains == APPEND($DomainNames,$noCategoryDomains)
 
 ++ Category ancestors for Record, Union, Mapping, and Enumeration domains.
 $commonCategoryAncestors ==
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index f7cdc25f..ab119c84 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -473,11 +473,6 @@ $NoValueMode ==
 $ExitMode ==
   "$ExitMode"
 
-
-+++ List of domains that are (currently) built-in into the system.
-$Primitives == 
-  '(Union Record Mapping Enumeration)
-
 --%
   
 ++ Category constructor form
-- 
cgit v1.2.3