aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/i-funsel.boot6
-rw-r--r--src/interp/info.boot7
-rw-r--r--src/interp/interop.boot4
-rw-r--r--src/interp/parse.boot21
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 ==