* interp/c-util.boot (getSuccessEnvironment): Move to here from

	compiler.boot.
	(getInverseEnvironment): Likewise.
	* interp/wi2.boot (getSuccessEnvironment): Remove.
	(getInverseEnvironment): Likewise.
	(corrupted?): Likewise.
	(unLet): Likewise.

3 files changed, 43 insertions, 90 deletions

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 4df0052f..aeb37a22 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -44,6 +44,8 @@ module c_-util where
   declareUnusedParameters: (%List,%Code) -> %List
   registerFunctionReplacement: (%Symbol,%Form) -> %Thing
   getFunctionReplacement: %Symbol -> %Form
+  getSuccessEnvironment: (%Form,%Env) -> %Env
+  getInverseEnvironment: (%Form,%Env) -> %Env
 
 
 --% 
@@ -384,7 +386,47 @@ makeCommonEnvironment(e,e') ==
           nx>ny => fn(rest x,y,nx-1,ny)
           nx<ny => fn(x,rest y,nx,ny-1)
           [x,y]
- 
+
+++ Return the lexically leftmost location in an assignment for.
+lhsOfAssignment x ==
+  x is ["%LET",lhs,:.] => lhsOfAssignment lhs
+  x
+
+getSuccessEnvironment(a,e) ==
+  a is ["is",id,m] =>
+    id := lhsOfAssignment id
+    IDENTP id and isDomainForm(m,$EmptyEnvironment) =>
+      e:=put(id,"specialCase",m,e)
+      currentProplist:= getProplist(id,e)
+      [.,.,e] := T := comp(m,$EmptyMode,e) or return nil -- duplicates compIs
+      newProplist:= consProplistOf(id,currentProplist,"value",[m,:rest removeEnv T])
+      addBinding(id,newProplist,e)
+    e
+  a is ["case",x,m] and (x := lhsOfAssignment x) and IDENTP x =>
+    put(x,"condition",[a,:get(x,"condition",e)],e)
+  a is ["and",:args] =>
+    for form in args repeat
+      e := getSuccessEnvironment(form,e)
+    e
+  a is ["not",a'] => getInverseEnvironment(a',e)
+  e
+
+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",LIST MKPF(delete(a,oldpred),"OR"),e)
+    getUnionMode(x,e) is ["Union",:l] =>
+      l':= delete(m,l)
+      for u in l' repeat
+	 if u is ['_:,=m,:.] then l':= delete(u,l')
+      newpred:= MKPF([["case",x,m'] for m' in l'],"OR")
+      put(x,"condition",[newpred,:get(x,"condition",e)],e)
+    e
+  a is ["not",a'] => getSuccessEnvironment(a',e)
+  e
+
 printEnv E ==
   for x in E for i in 1.. repeat
     for y in x for j in 1.. repeat
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 74847aaa..2e0beda4 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1258,40 +1258,6 @@ compPredicate(p,E) ==
   [p',m,E] := comp(p,$Boolean,E) or return nil
   [p',m,getSuccessEnvironment(p,E),getInverseEnvironment(p,E)]
 
-getSuccessEnvironment(a,e) ==
-  a is ["is",id,m] =>
-    IDENTP id and isDomainForm(m,$EmptyEnvironment) =>
-      e:=put(id,"specialCase",m,e)
-      currentProplist:= getProplist(id,e)
-      [.,.,e] := T := comp(m,$EmptyMode,e) or return nil -- duplicates compIs
-      newProplist:= consProplistOf(id,currentProplist,"value",[m,:rest removeEnv T])
-      addBinding(id,newProplist,e)
-    e
-  a is ["case",x,m] and IDENTP x =>
-    put(x,"condition",[a,:get(x,"condition",e)],e)
-  a is ["and",:args] =>
-    for form in args repeat
-      e := getSuccessEnvironment(form,e)
-    e
-  a is ["not",a'] => getInverseEnvironment(a',e)
-  e
-
-getInverseEnvironment(a,e) ==
-  a is ["case",x,m] 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",LIST MKPF(delete(a,oldpred),"OR"),e)
-    getUnionMode(x,e) is ["Union",:l] =>
-      l':= delete(m,l)
-      for u in l' repeat
-	 if u is ['_:,=m,:.] then l':= delete(u,l')
-      newpred:= MKPF([["case",x,m'] for m' in l'],"OR")
-      put(x,"condition",[newpred,:get(x,"condition",e)],e)
-    e
-  a is ["not",a'] => getSuccessEnvironment(a',e)
-  e
-
 getUnionMode(x,e) ==
   m:=
     atom x => getmode(x,e)
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index c66763cf..31983811 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -408,61 +408,6 @@ macroExpand(x,e) ==   --not worked out yet
       ['MI,a,macroExpand(b,e)]
   macroExpandList(x,e)
  
-getSuccessEnvironment(a,e) ==
-  -- the next four lines try to ensure that explicit special-case tests
-  --  prevent implicit ones from being generated
-  a is ["has",x,m] =>
-    x := unLet x   
-    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,e)
-    e
-  a is ["is",id,m] =>
-    id := unLet id
-    IDENTP id and isDomainForm(m,$EmptyEnvironment) =>
-         e:=put(id,"specialCase",m,e)
-         currentProplist:= getProplist(id,e)
-         [.,.,e] := T := comp(m,$EmptyMode,e) or return nil -- duplicates compIs
-         newProplist:= consProplistOf(id,currentProplist,"value",removeEnv T)
-         addBinding(id,newProplist,e)
-    e
-  a is ["case",x,m] and (x := unLet x) and IDENTP x =>
-    put(x,"condition",[a,:get(x,"condition",e)],e)
-  e
- 
-getInverseEnvironment(a,E) ==
-  atom a => E
-  [op,:argl]:= a
--- the next five lines try to ensure that explicit special-case tests
--- prevent implicit ones from being generated
-  op="has" =>
-    [x,m]:= argl
-    x := unLet x
-    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,E)
-    E
-  a is ["case",x,m] and (x := unLet x) and IDENTP x =>
-           --the next two lines are necessary to get 3-branched Unions to work
-           -- old-style unions, that is
-    if corrupted? get(x,"condition",E) then systemError 'condition
-    (get(x,"condition",E) is [["OR",:oldpred]]) and member(a,oldpred) =>
-      put(x,"condition",LIST MKPF(delete(a,oldpred),"OR"),E)
-    getUnionMode(x,E) is ["Union",:l] or systemError 'Union
-    if corrupted? l then systemError 'list
-    l':= delete(m,l)
-    for u in l' repeat
-       if u is ['_:,=m,:.] then l':= delete(u,l')
-    newpred:= MKPF([["case",x,m'] for m' in l'],"OR")
-    put(x,"condition",[newpred,:get(x,"condition",E)],E)
-  E
-
-unLet x ==
-  x is ["%LET",u,:.] => unLet u
-  x
-
-corrupted? u ==
-  u is [op,:r] =>
-    op in '(WI MI PART) => true
-    or/[corrupted? x for x in r]
-  false
-
 --======================================================================
 --                    From apply.boot
 --======================================================================