diff options
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/compiler.boot | 2 | ||||
-rw-r--r-- | src/interp/i-funsel.boot | 6 | ||||
-rw-r--r-- | src/interp/info.boot | 7 | ||||
-rw-r--r-- | src/interp/interop.boot | 4 | ||||
-rw-r--r-- | src/interp/parse.boot | 21 |
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 == |