Fix pretty-printing of out-of-scope variable references

tomsmeding · Oct 12, 2020 · 3f7cc56 · 3f7cc56
1 parent afee939
commit 3f7cc56
Show file tree

Hide file tree

Showing 3 changed files with 8 additions and 8 deletions.
diff --git a/src/Data/Array/Accelerate/Trafo/AD/Acc.hs b/src/Data/Array/Accelerate/Trafo/AD/Acc.hs
@@ -278,7 +278,7 @@ showsAcc _ d (Aarg ty idx) = showParen (d > 0) $
 showsAcc se _ (Avar (A.Var _ idx)) =
     case drop (idxToInt idx) (seAenv se) of
         descr : _ -> showString descr
-        [] -> showString ("tA_UP" ++ show (1 + idxToInt idx))
+        [] -> showString ("tA_UP" ++ show (1 + idxToInt idx - length (seAenv se)))
 showsAcc se d (Alabel lab) = showParen (d > 0) $
     showString ('L' : seAlabf se (labelLabel lab) ++ " :: " ++ show (labelType lab))
 

diff --git a/src/Data/Array/Accelerate/Trafo/AD/Exp.hs b/src/Data/Array/Accelerate/Trafo/AD/Exp.hs
@@ -151,7 +151,7 @@ showsExp se d (Shape (Left (A.Var _ idx))) =
         showString "shape " .
         (case drop (idxToInt idx) (seAenv se) of
             descr : _ -> showString descr
-            [] -> showString ("tA_UP" ++ show (1 + idxToInt idx)))
+            [] -> showString ("tA_UP" ++ show (1 + idxToInt idx - length (seAenv se))))
 showsExp se d (Shape (Right lab)) =
     showParen (d > 10) $
         showString "shape " .
@@ -160,7 +160,7 @@ showsExp se d (Index (Left (A.Var _ idx)) e) =
     showParen (d > 10) $
         (case drop (idxToInt idx) (seAenv se) of
             descr : _ -> showString descr
-            [] -> showString ("tA_UP" ++ show (1 + idxToInt idx)))
+            [] -> showString ("tA_UP" ++ show (1 + idxToInt idx - length (seAenv se))))
         . showString " ! " . showsExp se 11 e
 showsExp se d (Index (Right lab) e) =
     showParen (d > 10) $
@@ -190,7 +190,7 @@ showsExp _ d (Arg ty idx) = showParen (d > 0) $
 showsExp se _ (Var (A.Var _ idx)) =
     case drop (idxToInt idx) (seEnv se) of
         descr : _ -> showString descr
-        [] -> showString ("tE_UP" ++ show (1 + idxToInt idx))
+        [] -> showString ("tE_UP" ++ show (1 + idxToInt idx - length (seEnv se)))
 showsExp se d (Label lab) = showParen (d > 0) $
     showString ('L' : seLabf se (labelLabel lab) ++ " :: " ++ show (labelType lab))
 

diff --git a/src/Data/Array/Accelerate/Trafo/AD/Pretty.hs b/src/Data/Array/Accelerate/Trafo/AD/Pretty.hs
@@ -123,15 +123,15 @@ layoutExp se d (Shape (Left (A.Var _ idx))) =
         lprefix "shape "
             (case drop (idxToInt idx) (seAenv se) of
                 descr : _ -> string descr
-                [] -> string ("tA_UP" ++ show (1 + idxToInt idx)))
+                [] -> string ("tA_UP" ++ show (1 + idxToInt idx - length (seAenv se))))
 layoutExp se d (Shape (Right lab)) =
     parenthesise (d > 10) $
         string $ "shape (L" ++ seAlabf se (labelLabel lab) ++ " :: " ++ show (labelType lab) ++ ")"
 layoutExp se d (Index (Left (A.Var _ idx)) e) =
     parenthesise (d > 10) $ lseq'
         [case drop (idxToInt idx) (seAenv se) of
             descr : _ -> string descr
-            [] -> string ("tA_UP" ++ show (1 + idxToInt idx))
+            [] -> string ("tA_UP" ++ show (1 + idxToInt idx - length (seAenv se)))
         ,string "!", layoutExp se 11 e]
 layoutExp se d (Index (Right lab) e) =
     parenthesise (d > 10) $ lseq'
@@ -163,7 +163,7 @@ layoutExp _ d (Arg ty idx) = parenthesise (d > 0) $
 layoutExp se _ (Var (A.Var _ idx)) =
     case drop (idxToInt idx) (seEnv se) of
         descr : _ -> string descr
-        [] -> string ("tE_UP" ++ show (1 + idxToInt idx))
+        [] -> string ("tE_UP" ++ show (1 + idxToInt idx - length (seEnv se)))
 layoutExp se d (Label lab) = parenthesise (d > 0) $
     string ('L' : seLabf se (labelLabel lab) ++ " :: " ++ show (labelType lab))
 
@@ -262,7 +262,7 @@ layoutAcc _ d (Aarg ty idx) = parenthesise (d > 0) $
 layoutAcc se _ (Avar (A.Var _ idx)) =
     case drop (idxToInt idx) (seAenv se) of
         descr : _ -> string descr
-        [] -> string ("tA_UP" ++ show (1 + idxToInt idx))
+        [] -> string ("tA_UP" ++ show (1 + idxToInt idx - length (seAenv se)))
 layoutAcc se d (Alabel lab) = parenthesise (d > 0) $
     string ('L' : seAlabf se (labelLabel lab) ++ " :: " ++ show (labelType lab))