aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog11
-rw-r--r--src/interp/c-util.boot28
-rw-r--r--src/interp/compiler.boot40
-rw-r--r--src/interp/wi1.boot2
4 files changed, 51 insertions, 30 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index daa58a45..e5045df1 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2011-02-14 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/compiler.boot (getUnionMode): Remove.
+ (isUnionMode): Move to c-util.boot.
+ (coerceExtraHard): Rework.
+ (belongsTo?): Remove.
+ * interp/c-util.boot (isUnionMode): Moved from compiler.boot.
+ (unionLike?): New.
+ (unionProperty): Likewise.
+ (getInverseEnvironment): Use unionProperty instead of getUnionMode.
+
2011-02-13 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/c-util.boot (getSuccessEnvironment): Follow through
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 05915075..5820b091 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -441,13 +441,39 @@ getSuccessEnvironment(a,e) ==
symbol? a and (T := get(a,"value",e)) => getSuccessEnvironment(T.expr,e)
e
+isUnionMode(m,e) ==
+ m is ["Union",:.] => m
+ v := get(RepIfRepHack m,"value",e) =>
+ (v.expr is ["Union",:.] => v.expr; nil)
+ nil
+
+++ Return the UnionCategory of `m' in the environment `e', if known.
+unionLike?(m,e) ==
+ isUnionMode(m,e) is ['Union,:branches] => ['UnionCategory,:branches]
+ -- Take a cheap approximation at domains with Union-like flavour.
+ T := compForMode(m,$EmptyMode,e) or return nil
+ T.expr is ['Union,:branches] => ['UnionCategory,:T.expr.args]
+ T.mode is ['UnionCategory,:.] => T.mode
+ T.mode is ['UnionType] => ['UnionCategory]
+ T.mode isnt ['Join,:cats,['CATEGORY,.,:sigs]] => nil
+ member(['UnionType],cats) =>
+ ['UnionCategory,
+ :[b for ['SIGNATURE,"case",[=$Boolean,'$,["[||]",b]]] in sigs]]
+ nil
+
+++ If `x' designates a store with multiple views, e.g. Union, return
+++ the collection of those modes.
+unionProperty(x,e) ==
+ atom x => unionLike?(getmode(x,e),e)
+ nil
+
getInverseEnvironment(a,e) ==
a is ["case",x,m] and (x := lhsOfAssignment x) and IDENTP x =>
--the next two lines are necessary to get 3-branched Unions to work
-- old-style unions, that is
(get(x,"condition",e) is [["OR",:oldpred]]) and member(a,oldpred) =>
put(x,"condition",[MKPF(delete(a,oldpred),"OR")],e)
- getUnionMode(x,e) is ["Union",:l] =>
+ unionProperty(x,e) is ['UnionCategory,:l] =>
l':= delete(m,l)
for u in l' repeat
if u is ['_:,=m,:.] then l':= delete(u,l')
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 940c296d..73f7410d 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1300,19 +1300,6 @@ compPredicate(p,E) ==
[p',m,E] := comp(p,$Boolean,E) or return nil
[p',m,getSuccessEnvironment(p,E),getInverseEnvironment(p,E)]
-getUnionMode(x,e) ==
- m:=
- atom x => getmode(x,e)
- return nil
- isUnionMode(m,e)
-
-isUnionMode(m,e) ==
- m is ["Union",:.] => m
- (m':= getmode(m,e)) is ["Mapping",["UnionCategory",:.]] => second m'
- v:= get(RepIfRepHack m,"value",e) =>
- (v.expr is ["Union",:.] => v.expr; nil)
- nil
-
compFromIf(a,m,E) ==
a="%noBranch" => ["%noBranch",m,E]
comp(a,m,E)
@@ -1710,14 +1697,20 @@ coerceHard(T,m) ==
coerceExtraHard: (%Triple,%Mode) -> %Maybe %Triple
coerceExtraHard(T is [x,m',e],m) ==
- T':= autoCoerceByModemap(T,m) => T'
- (t:= hasType(x,e)) and isUnionMode(m',e) is ["Union",:l] and
- member(t,l) and (T':= autoCoerceByModemap(T,t)) and
- (T'':= coerce(T',m)) => T''
+ -- Allow implicit injection into Union, if that is
+ -- clear from the context
+ isUnionMode(m,e) is ['Union,:l] and member(m',l) =>
+ autoCoerceByModemap(T,m)
+ -- For values from domains satisfying Union-like properties, apply
+ -- implicit retraction if clear from context.
+ (t := hasType(x,e)) and unionLike?(m',e) is ['UnionCategory,:l]
+ and member(t,l) => coerce(autoCoerceByModemap(T,t),m)
+ -- Give it one last chance.
+ -- FIXME: really, we shouldn't. Codes relying on this are
+ -- FIXME: inherently difficult to comprehend and likely broken.
+ T' := autoCoerceByModemap(T,m) => T'
m' is ['Record,:.] and m = $Expression =>
[['coerceRe2E,x,['ELT,COPY m',0]],m,e]
- hasUniqueCaseView(x,m,e) and belongsTo?(m',["UnionType"],e) =>
- autoCoerceByModemap(T,m)
-- Domain instantiations are first class objects
m = $Domain =>
m' = $Category => nil
@@ -1725,15 +1718,6 @@ coerceExtraHard(T is [x,m',e],m) ==
nil
nil
-++ returns true if mode `m' is known to belong to category `cat' in
-++ the environment `e'. This function is different from its cousines
-++ `ofCategory', or `has'. The latter perform runtime checks. Here,
-++ we are interested in a static approximation. So, use with care.
-belongsTo?(m,cat,e) ==
- c := get(m,"mode",e)
- c isnt ["Join",:cats] => nil
- member(cat,cats)
-
coerceable(m,m',e) ==
m=m' => m
tryCourtesyCoercion(["$fromCoerceable$",m,e],m') => m'
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
index 508213c5..943515eb 100644
--- a/src/interp/wi1.boot
+++ b/src/interp/wi1.boot
@@ -882,7 +882,7 @@ coerceHard(T,m) ==
coerceExtraHard(T is [x,m',e],m) ==
T':= autoCoerceByModemap(T,m) => T'
- isUnionMode(m',e) is ["Union",:l] and (t:= hasType(x,e)) and
+ unionLike?(m',e) is ['UnionCategory,:l] and (t:= hasType(x,e)) and
member(t,l) and (T':= autoCoerceByModemap(T,t)) and
(T'':= coerce(T',m)) => T''
m' is ['Record,:.] and m = $Expression =>