diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/basicTypes/Lexeme.hs | 18 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs | 2 |
2 files changed, 17 insertions, 3 deletions
diff --git a/compiler/basicTypes/Lexeme.hs b/compiler/basicTypes/Lexeme.hs index 7012f5afed..dadc79ce21 100644 --- a/compiler/basicTypes/Lexeme.hs +++ b/compiler/basicTypes/Lexeme.hs @@ -156,8 +156,10 @@ okConIdOcc :: String -> Bool okConIdOcc str = okIdOcc str || is_tuple_name1 True str || -- Is it a boxed tuple... - is_tuple_name1 False str - -- ...or an unboxed tuple (Trac #12407)? + is_tuple_name1 False str || + -- ...or an unboxed tuple (Trac #12407)... + is_sum_name1 str + -- ...or an unboxed sum (Trac #12514)? where -- check for tuple name, starting at the beginning is_tuple_name1 True ('(' : rest) = is_tuple_name2 True rest @@ -172,6 +174,18 @@ okConIdOcc str = okIdOcc str || | isSpace ws = is_tuple_name2 boxed rest is_tuple_name2 _ _ = False + -- check for sum name, starting at the beginning + is_sum_name1 ('(' : '#' : rest) = is_sum_name2 False rest + is_sum_name1 _ = False + + -- check for sum tail, only allowing at most one underscore + is_sum_name2 _ "#)" = True + is_sum_name2 underscore ('|' : rest) = is_sum_name2 underscore rest + is_sum_name2 False ('_' : rest) = is_sum_name2 True rest + is_sum_name2 underscore (ws : rest) + | isSpace ws = is_sum_name2 underscore rest + is_sum_name2 _ _ = False + -- | Is this an acceptable symbolic constructor name, assuming it -- starts with an acceptable character? okConSymOcc :: String -> Bool diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 6e028fcf34..ce89e029e4 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -709,7 +709,7 @@ isBuiltInOcc_maybe occ = , Just rest'' <- "_" `stripPrefix` rest' , (pipes2, rest''') <- BS.span (=='|') rest'' , "#)" <- rest''' - -> let arity = BS.length pipes1 + BS.length pipes2 + -> let arity = BS.length pipes1 + BS.length pipes2 + 1 alt = BS.length pipes1 + 1 in Just $ dataConName $ sumDataCon alt arity _ -> Nothing |