diff options
| -rw-r--r-- | src/ChangeLog | 11 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 28 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 40 | ||||
| -rw-r--r-- | src/interp/wi1.boot | 2 |
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 => |