From 85ba8eb449cf6b7e8c37b989021dfb803427ae5c Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 16 Jan 2008 23:17:44 +0000
Subject: 	Fix SF/1848975 	* interp/buildom.boot
 ($commonCategoryAncestors): New. 	($commonCategoryDefaults): Likewise. 
 (Record0): Use it. 	(Union): Likewise. 	(Mapping): Likewise. 
 (Enumeration): Likewise. 	* testsuite/algebra/1848975.input: New.

---
 src/ChangeLog                       | 11 +++++++++++
 src/interp/buildom.boot             | 17 +++++++++++++----
 src/testsuite/algebra/1848975.input |  3 +++
 3 files changed, 27 insertions(+), 4 deletions(-)
 create mode 100644 src/testsuite/algebra/1848975.input

(limited to 'src')

diff --git a/src/ChangeLog b/src/ChangeLog
index 4f404627..1d9d9d9a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2008-01-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	Fix SF/1848975
+	* interp/buildom.boot ($commonCategoryAncestors): New.
+	($commonCategoryDefaults): Likewise.
+	(Record0): Use it.
+	(Union): Likewise.
+	(Mapping): Likewise.
+	(Enumeration): Likewise.
+	* testsuite/algebra/1848975.input: New.
+
 2008-01-16  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	Fix SF/1872564
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 586251b2..228ef863 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -43,6 +43,15 @@ import '"sys-macros"
 $noCategoryDomains == '(Domain Mode SubDomain)
 $nonLisplibDomains == APPEND($Primitives,$noCategoryDomains)
 
+++ Category ancestors for Record, Union, Mapping, and Enumeration domains.
+$commonCategoryAncestors ==
+  ['(SetCategory), '(BasicType), '(CoercibleTo (OutputForm))]
+
+++ Default category packages for Record, Union, Mapping and 
+++ Enumeration domains.
+$commonCategoryDefaults ==
+  ['(SetCategory_&), '(BasicType_&), NIL]
+
 --% Record
 --  Want to eventually have the elts and setelts.
 --  Record is a macro in BUILDOM LISP. It takes out the colons.
@@ -66,7 +75,7 @@ Record0 args ==
     dom.2 := NIL
     dom.3 := ["RecordCategory",:QCDR dom.0]
     dom.4 :=
-          [[ '(SetCategory) ],[ '(SetCategory) ]]
+          [$commonCategoryDefaults, $commonCategoryAncestors]
     dom.5 := [CDR a for a in args]
     dom.6 := [function RecordEqual, :dom]
     dom.7 := [function RecordPrint, :dom]
@@ -131,7 +140,7 @@ Union(:args) ==
     dom.3 :=
       '(SetCategory)
     dom.4 :=
-          [[ '(SetCategory) ],[ '(SetCategory) ]]
+          [$commonCategoryDefaults, $commonCategoryAncestors]
     dom.5 := args
     dom.6 := [function UnionEqual, :dom]
     dom.7 := [function UnionPrint, :dom]
@@ -183,7 +192,7 @@ Mapping(:args) ==
     dom.3 :=
       '(SetCategory)
     dom.4 :=
-          [[ '(SetCategory) ],[ '(SetCategory) ]]
+          [$commonCategoryDefaults, $commonCategoryAncestors]
     dom.5 := args
     dom.6 := [function MappingEqual, :dom]
     dom.7 := [function MappingPrint, :dom]
@@ -214,7 +223,7 @@ Enumeration(:"args") ==
     dom.2 := NIL
     dom.3 := ["EnumerationCategory",:QCDR dom.0]
     dom.4 :=
-          [[ '(SetCategory) ],[ '(SetCategory) ]]
+          [$commonCategoryDefaults, $commonCategoryAncestors]
     dom.5 := args
     dom.6 := [function EnumEqual, :dom]
     dom.7 := [function EnumPrint, :dom]
diff --git a/src/testsuite/algebra/1848975.input b/src/testsuite/algebra/1848975.input
new file mode 100644
index 00000000..ef86b122
--- /dev/null
+++ b/src/testsuite/algebra/1848975.input
@@ -0,0 +1,3 @@
+++ Cotnributed by Luke Wagner
+-- Issue: `Built in' domains should be coercible to OutputForm
+s : List Record(a:INT, b:FLOAT) := []
-- 
cgit v1.2.3