6 files changed, 79 insertions, 12 deletions
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 1b957c45..31daea4b 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -153,6 +153,21 @@ getOperationModemapsFromDB: %Symbol -> %List
 getOperationModemapsFromDB op ==
   GETDATABASE(op,"MODEMAPS")
 
+
+getConstructorArity: %Symbol -> %Short
+getConstructorArity ctor ==
+  sig := getConstructorSignature ctor => #rest sig
+  -1
+
+getConstructorKind: %Symbol -> %Maybe %ConstructorKind
+getConstructorKind ctor ==
+  kind := getConstructorKindFromDB ctor =>
+    kind = "domain" and isDefaultPackageName ctor => "package"
+    kind
+  ctor in $DomainNames => "domain"
+  ctor in $CategoryNames => "category"
+  nil
+
 --% Functions for manipulating MODEMAP DATABASE
 
 augLisplibModemapsFromCategory(form is [op,:argl],body,signature) ==
@@ -788,6 +803,26 @@ displayHiddenConstructors() ==
       centerAndHighlight c
 
 
+
+--%
+
+
+++ Return the list of modemaps exported by the category object `c'.
+++ The format of modemap is as found in category objects.
+getCategoryExports: %Shell -> %List
+getCategoryExports c == c.1
+
+++ Return the list of category attribute info for the category object `c'.
+++ A category attribute info is pair of attribute-predicate.
+getCategoryAttributes: %Shell -> %List
+getCategoryAttributes c == c.2
+
+
+getCategoryPrincipalAncestors c == c.4.0
+
+getCategoryParents c == c.4.1
+
+
 --%
 squeezeAll: %List -> %List
 squeezeAll x ==
diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot
index 1541fbc7..91ff077e 100644
--- a/src/interp/i-analy.boot
+++ b/src/interp/i-analy.boot
@@ -320,10 +320,35 @@ bottomUpCompilePredicate(pred, name) ==
   $genValue:local := false
   bottomUpPredicate(pred,name)
 
+
+++ We are in the process of elaborating the identifier `id' into
+++ the  VAT `t'.  Return the modeset of the elaboration if `id'
+++ unambiguously denote a constructor.  Ambiguous constructor
+++ identifiers are precisely those that denote niladic constructors.
+++ By default, the ambiguity is resolved to types. 
+++ See bottomUpIdentifier and isType.
+isUnambiguouslyConstructor(id,t) ==
+  niladicConstructorFromDB id => nil
+  k := getConstructorKindFromDB id or
+        id in $DomainNames => "domain"
+        id in $CategoryNames => "category"
+  k = nil => nil
+  ms := 
+    k = "category" => [$CategoryConstructor]
+    [$DomainConstructor]
+  if not(id in $BuiltinConstructorNames) then 
+    loadIfNecessary id
+  putValue(t,objNewWrap(id,first ms))
+  putModeSet(t,ms)
+  ms
+  
+
+
 bottomUpIdentifier(t,id) ==
+  ms := isUnambiguouslyConstructor(id,t) => ms
   m := isType t => bottomUpType(t, m)
-  EQ(id,'%noMapVal) => throwKeyedMsg('"S2IB0002",NIL)
-  EQ(id,'%noBranch) =>
+  id = "%noMapVal" => throwKeyedMsg('"S2IB0002",NIL)
+  id = "%noBranch" =>
     keyedSystemError("S2GE0016",
       ['"bottomUpIdentifier",'"trying to evaluate %noBranch"])
   transferPropsToNode(id,t)
diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot
index 7850f956..91499994 100644
--- a/src/interp/i-eval.boot
+++ b/src/interp/i-eval.boot
@@ -133,9 +133,7 @@ evaluateType form ==
   form = "$" => form
   $expandSegments : local := nil
   form is ['typeOf,.] =>
-    form' := mkAtree form
-    bottomUp form'
-    objVal getValue(form')
+    objVal getValue elaborateForm form
   form is [op,:argl] =>
     op='CATEGORY =>
       argl is [x,:sigs] => [op,x,:[evaluateSignature(s) for s in sigs]]
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 806aa8a7..15dd641d 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -2601,7 +2601,10 @@ primaryForm2String x ==
   x = nil => '""
   STRINGP x => x
   x = $EmptyMode => specialChar 'quad
-  IDENTP x => SYMBOL_-NAME x
+  IDENTP x => 
+    x = "$" => '"%"
+    x = "$$" => '"%%"
+    SYMBOL_-NAME x
   atom x => WRITE_-TO_-STRING x
   strconc('"(",inputForm2String x, '")")
 
diff --git a/src/interp/property.lisp b/src/interp/property.lisp
index 5046fa48..ebf97157 100644
--- a/src/interp/property.lisp
+++ b/src/interp/property.lisp
@@ -83,9 +83,9 @@
    (|case| " case ")
    (|and| " and ")
    (|or| " or ")
-   (TAG " -> ")
+   (TAG ": ")
    (|+->| " +-> ")
-   (RARROW ": ")
+   (RARROW " -> ")
    (SEGMENT "..")
    (in " in ")
    (|^=|  "^=")
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 74d7f3bf..fc1543e8 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -495,14 +495,20 @@ $Domain ==
 $Mode ==
   '(Mode)
 
+$CategoryConstructor ==
+  '(CategoryConstructor)
+
+$DomainConstructor ==
+  '(DomainConstructor)
+
 
 ++ StringCategory Constructor form
 $StringCategory ==
   '(StringCategory)
 
 
-++ List of categories that do not have entries in the constructor
-++ database. So, they are mostly recognized by their names.
+++ List of category constructors that do not have entries in the 
+++ constructor database. So, they are mostly recognized by their names.
 $CategoryNames ==
   '(Category _
     CATEGORY _
@@ -512,7 +518,7 @@ $CategoryNames ==
     SubsetCategory _
     UnionCategory)
 
-++ List of domains that do not have entries in the constructor
+++ List of domain constructors that do not have entries in the constructor
 ++ database. So, they are mostly recognized by their names.
 ++ See also $CategoryNames.
 $DomainNames ==
@@ -526,7 +532,7 @@ $DomainNames ==
 $BuiltinConstructorNames ==
   [:$CategoryNames,:$DomainNames]
 
-++ List of language support constructor forms.
+++ List of language support type forms.
 $LangSupportTypes ==
   '((Mode) (Domain) (Type) (Category))