[commit: ghc] wip/names3: TysWiredIn: Recognize unboxed sums in isBuiltInOcc_maybe (7df76ec)

git at git.haskell.org git at git.haskell.org
Thu Sep 8 18:52:28 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/names3
Link       : http://ghc.haskell.org/trac/ghc/changeset/7df76ec7e53b332862ee7e6c42711a543874b714/ghc

>---------------------------------------------------------------

commit 7df76ec7e53b332862ee7e6c42711a543874b714
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Tue Aug 23 16:40:28 2016 -0400

    TysWiredIn: Recognize unboxed sums in isBuiltInOcc_maybe


>---------------------------------------------------------------

7df76ec7e53b332862ee7e6c42711a543874b714
 compiler/prelude/TysWiredIn.hs | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 0d53aed..8f35f7b 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -677,17 +677,38 @@ isBuiltInOcc_maybe occ =
     case name of
       "[]" -> Just $ choose_ns listTyConName nilDataConName
       ":"    -> Just consDataConName
+
       "[::]" -> Just parrTyConName
+
+      -- boxed tuple data/tycon
       "()"    -> Just $ tup_name Boxed 0
-      "(##)"  -> Just $ tup_name Unboxed 0
       _ | Just rest <- "(" `stripPrefix` name
         , (commas, rest') <- BS.span (==',') rest
         , ")" <- rest'
              -> Just $ tup_name Boxed (1+BS.length commas)
+
+      -- unboxed tuple data/tycon
+      "(##)"  -> Just $ tup_name Unboxed 0
       _ | Just rest <- "(#" `stripPrefix` name
         , (commas, rest') <- BS.span (==',') rest
         , "#)" <- rest'
              -> Just $ tup_name Unboxed (1+BS.length commas)
+
+      -- unboxed sum tycon
+      _ | Just rest <- "(#" `stripPrefix` name
+        , (pipes, rest') <- BS.span (=='|') rest
+        , "#)" <- rest'
+             -> Just $ tyConName $ sumTyCon (1+BS.length pipes)
+
+      -- unboxed sum datacon
+      _ | Just rest <- "(#" `stripPrefix` name
+        , (pipes1, rest') <- BS.span (=='|') rest
+        , Just rest'' <- "_" `stripPrefix` rest'
+        , (pipes2, rest''') <- BS.span (=='|') rest''
+        , "#)" <- rest'''
+             -> let arity = BS.length pipes1 + BS.length pipes2
+                    alt = BS.length pipes1 + 1
+                in Just $ dataConName $ sumDataCon alt arity
       _ -> Nothing
   where
     -- TODO: Drop when bytestring 0.10.8 can be assumed



More information about the ghc-commits mailing list