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/ChangeLog | 12 ++++++++++++
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 -----
6 files changed, 24 insertions(+), 14 deletions(-)
(limited to 'src')
diff --git a/src/ChangeLog b/src/ChangeLog
index 614d802a..a0a2950a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,15 @@
+2009-05-05 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ 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.
+
2009-04-28 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/define.boot (canCacheLocalDomain): Remove dead code.
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