diff --git a/src/Data/Array/Accelerate/Trafo/AD/Acc.hs b/src/Data/Array/Accelerate/Trafo/AD/Acc.hs index df53bc46b..d3ff7f1bd 100644 --- 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 index ee40b320b..e9352c0cb 100644 --- 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 index 25235afbe..c0d5201dc 100644 --- a/src/Data/Array/Accelerate/Trafo/AD/Pretty.hs +++ b/src/Data/Array/Accelerate/Trafo/AD/Pretty.hs @@ -123,7 +123,7 @@ 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) ++ ")" @@ -131,7 +131,7 @@ 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))