Skip to content

Inefficient code generated from matching with pattern synonyms

Summary

Pattern matching using pattern synonyms sometimes results in generated code that uses multiple case expressions where one would suffice. This can result in code that's linear time in the number of patterns, instead of constant time.

See also #3755, #3781

Steps to reproduce

Compile the following module with ghc PatternSynonyms.hs -ddump-simpl -dsuppress-all -O2.

{-# language PatternSynonyms #-}
module PatternSynonyms where

pattern FirstZero :: a -> (Int, a)
pattern FirstZero a = (0, a)

pattern FirstOne :: a -> (Int, a)
pattern FirstOne a = (1, a)

pattern FirstTwo :: a -> (Int, a)
pattern FirstTwo a = (2, a)

synonym :: (Int, Either () Int) -> Bool
synonym (FirstZero (Right 0)) = True
synonym (FirstOne (Right 1)) = True
synonym (FirstTwo (Right 2)) = True
synonym _ = False

nonSynonym :: (Int, Either () Int) -> Bool
nonSynonym (0, Right 0) = True
nonSynonym (1, Right 1) = True
nonSynonym (2, Right 2) = True
nonSynonym _ = False

Part of the dumped core is this:

$wsynonym
  = \ ww_sUY ww1_sV0 ->
      join {
        fail_sUN _
          = case ww_sUY of {
              __DEFAULT -> False;
              1# ->
                case ww1_sV0 of {
                  Left ipv_sUy -> False;
                  Right ds2_dUj ->
                    case ds2_dUj of { I# ds3_dUk ->
                    case ds3_dUk of {
                      __DEFAULT -> False;
                      1# -> True
                    }
                    }
                };
              2# ->
                case ww1_sV0 of {
                  Left ipv_sUw -> False;
                  Right ds2_dUm ->
                    case ds2_dUm of { I# ds3_dUn ->
                    case ds3_dUn of {
                      __DEFAULT -> False;
                      2# -> True
                    }
                    }
                }
            } } in
      case ww_sUY of {
        __DEFAULT -> jump fail_sUN (##);
        0# ->
          case ww1_sV0 of {
            Left ipv_sUA -> jump fail_sUN (##);
            Right ds1_dUg ->
              case ds1_dUg of { I# ds2_dUh ->
              case ds2_dUh of {
                __DEFAULT -> jump fail_sUN (##);
                0# -> True
              }
              }
          }
      }

$wnonSynonym
  = \ ww_sV9 ww1_sVb ->
      case ww_sV9 of {
        __DEFAULT -> False;
        0# ->
          case ww1_sVb of {
            Left ipv_sUC -> False;
            Right ds1_dTq ->
              case ds1_dTq of { I# ds2_dTr ->
              case ds2_dTr of {
                __DEFAULT -> False;
                0# -> True
              }
              }
          };
        1# ->
          case ww1_sVb of {
            Left ipv_sUE -> False;
            Right ds1_dTs ->
              case ds1_dTs of { I# ds2_dTt ->
              case ds2_dTt of {
                __DEFAULT -> False;
                1# -> True
              }
              }
          };
        2# ->
          case ww1_sVb of {
            Left ipv_sUG -> False;
            Right ds1_dTu ->
              case ds1_dTu of { I# ds2_dTv ->
              case ds2_dTv of {
                __DEFAULT -> False;
                2# -> True
              }
              }
          }
      }

Expected behavior

Ideally, synonym and nonSynonym would perform the same.

Environment

  • GHC version used: Latest GHC HEAD (ce706fae).
Edited by Simon Peyton Jones
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information