* interp/parse.boot (parseHas): Preserve unnamed category forms.

	* interp/i-funsel.boot (hasCaty): Recursively look into Joins.
	* interp/interop.boot (newHasCategory): Likewise.
	* interp/compiler.boot (compHasFormat): Handle unnamed categories.
	* interp/info.boot (knownInfo): Likewise.

5 files changed, 25 insertions, 15 deletions

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 357e8564..201e925f 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1162,6 +1162,8 @@ compHasFormat (pred is ["has",olda,b]) ==
   b is ["SIGNATURE",op,sig,:.] =>
      ["HasSignature",a,
        mkList [MKQ op,mkList [mkTypeForm type for type in sig]]]
+  b is ["Join",:l] or b is ["CATEGORY",.,:l] => 
+     ["AND",:[compHasFormat ["has",olda,c] for c in l]]
   isCategoryForm(b,$e) => ["HasCategory",a,mkTypeForm b]
   stackAndThrow('"Second argument to %1b must be a category, or a signature or an attribute",["has"])
 
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index a4f279b6..89942903 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -1477,6 +1477,10 @@ hasCaty(d,cat,SL) ==
   cat is ['SIGNATURE,foo,sig] =>
     hasSig(d,foo,subCopy(sig,constructSubst d),SL)
   cat is ['ATTRIBUTE,a] => hasAtt(d,subCopy(a,constructSubst d),SL)
+  cat is ["Join",:.] =>
+    for c in rest cat while SL ^= "failed" repeat
+      SL := hasCaty(d,c,SL)
+    SL
   x:= hasCat(opOf d,opOf cat) =>
     y:= KDR cat =>
       S  := constructSubst d
diff --git a/src/interp/info.boot b/src/interp/info.boot
index 23a15dfc..293b1e40 100644
--- a/src/interp/info.boot
+++ b/src/interp/info.boot
@@ -174,10 +174,15 @@ knownInfo pred ==
   pred is ["has",name,cat] =>
     cat is ["ATTRIBUTE",:a] => knownInfo ["ATTRIBUTE",name,:a]
     cat is ["SIGNATURE",:a] => knownInfo ["SIGNATURE",name,:a]
+    -- unnamed category expressions imply structural checks.
+    cat is ["Join",:.] => and/[knownInfo ["has",name,c] for c in rest cat]
+    cat is ["CATEGORY",.,:atts] =>
+      and/[knownInfo hasToInfo ["has",name,att] for att in atts]
     name is ['Union,:.] => false
+    -- we have a named category expression
     v:= compForMode(name,$EmptyMode,$e) or return
           stackAndThrow('"can't find category of %1pb",[name])
-    vmode := second v
+    vmode := v.mode
     cat = vmode => true
     vmode is ["Join",:l] and member(cat,l) => true
     [vv,.,.]:= compMakeCategoryObject(vmode,$e) or return
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index fde42557..839ab1d1 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -568,6 +568,8 @@ newHasAttribute(domain,attrib) ==
 
 newHasCategory(domain,catform) ==
   catform = $Type or catform = $Category => true  
+  catform is ["Join",:cats] => 
+    and/[newHasCategory(domain,cat) for cat in cats]
   slot4 := domain.4
   auxvec := CAR slot4
   catvec := CADR slot4
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index 278de20e..6daf3ea3 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -197,22 +197,19 @@ parseAtAt t ==
 parseHas: %ParseForm -> %Form 
 parseHas t ==
   t isnt ["has",x,y] => systemErrorHere ["parseHas",t]
-  mkand [["has",x,u] for u in fn y] where
-    mkand x ==
-      x is [a] => a
-      ["and",:x]
+  ["has",x,fn y] where
     fn y ==
       y is [":" ,op,["Mapping",:map]] =>
          op:= (STRINGP op => INTERN op; op)
-         [["SIGNATURE",op,map]]
-      y is ["Join",:u] => "append"/[fn z for z in u]
-      y is ["CATEGORY",:u] => "append"/[fn z for z in u]
+         ["SIGNATURE",op,map]
+      y is ["Join",:u] => ["Join",:[fn z for z in u]]
+      y is ["CATEGORY",kind,:u] => ["CATEGORY",kind,:[fn z for z in u]]
       kk:= getConstructorKindFromDB opOf y
-      kk = "domain" or kk = "category" => [makeNonAtomic y]
-      y is ["ATTRIBUTE",:.] => [y]
-      y is ["SIGNATURE",:.] => [y]
-      y is [":",op,type] => [["SIGNATURE",op,[type],"constant"]]
-      [["ATTRIBUTE",y]]
+      kk = "domain" or kk = "category" => makeNonAtomic y
+      y is ["ATTRIBUTE",:.] => y
+      y is ["SIGNATURE",:.] => y
+      y is [":",op,type] => ["SIGNATURE",op,[type],"constant"]
+      ["ATTRIBUTE",y]
  
 parseDEF: %ParseForm -> %Form
 parseDEF t ==