diff options
| author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-07-21 19:59:05 +0000 |
|---|---|---|
| committer | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-07-21 19:59:18 +0000 |
| commit | 8265c783dc26cb72e74a8fe89101049bb94c6db5 (patch) | |
| tree | 476f09aaba42b71ab051e431761ec10504f7c130 /compiler/basicTypes/Unique.hs | |
| parent | 6a4dc891fa7a8024d8f9f03b98ad675ff5fcbd91 (diff) | |
| download | haskell-8265c783dc26cb72e74a8fe89101049bb94c6db5.tar.gz | |
Fix and document Unique generation for sum TyCon and DataCons
Test Plan: validate
Reviewers: bgamari, austin
Reviewed By: bgamari
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2420
Diffstat (limited to 'compiler/basicTypes/Unique.hs')
| -rw-r--r-- | compiler/basicTypes/Unique.hs | 28 |
1 files changed, 24 insertions, 4 deletions
diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs index 800198bc95..545ea9f1ba 100644 --- a/compiler/basicTypes/Unique.hs +++ b/compiler/basicTypes/Unique.hs @@ -329,11 +329,9 @@ mkAlphaTyVarUnique :: Int -> Unique mkPreludeClassUnique :: Int -> Unique mkPreludeTyConUnique :: Int -> Unique mkTupleTyConUnique :: Boxity -> Arity -> Unique -mkSumTyConUnique :: Arity -> Unique mkCTupleTyConUnique :: Arity -> Unique mkPreludeDataConUnique :: Arity -> Unique mkTupleDataConUnique :: Boxity -> Arity -> Unique -mkSumDataConUnique :: ConTagZ -> Arity -> Unique mkPrimOpIdUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique mkPArrDataConUnique :: Int -> Unique @@ -351,7 +349,6 @@ mkPreludeTyConUnique i = mkUnique '3' (2*i) mkTupleTyConUnique Boxed a = mkUnique '4' (2*a) mkTupleTyConUnique Unboxed a = mkUnique '5' (2*a) mkCTupleTyConUnique a = mkUnique 'k' (2*a) -mkSumTyConUnique a = mkUnique 'z' (2*a) tyConRepNameUnique :: Unique -> Unique tyConRepNameUnique u = incrUnique u @@ -372,12 +369,35 @@ tyConRepNameUnique u = incrUnique u mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic mkTupleDataConUnique Boxed a = mkUnique '7' (3*a) -- ditto (*may* be used in C labels) mkTupleDataConUnique Unboxed a = mkUnique '8' (3*a) + +-------------------------------------------------- +-- Sum arities start from 2. A sum of arity N has N data constructors, so it +-- occupies N+1 slots: 1 TyCon + N DataCons. +-- +-- So arity 2 sum takes uniques 0 (tycon), 1, 2 (2 data cons) +-- arity 3 sum takes uniques 3 (tycon), 4, 5, 6 (3 data cons) +-- etc. + +mkSumTyConUnique :: Arity -> Unique +mkSumTyConUnique arity = mkUnique 'z' (sumUniqsOccupied arity) + +mkSumDataConUnique :: ConTagZ -> Arity -> Unique mkSumDataConUnique alt arity | alt >= arity = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity) | otherwise - = mkUnique 'z' (2 * alt * arity) + = mkUnique 'z' (sumUniqsOccupied arity + alt + 1 {- skip the tycon -}) + +-- How many unique slots occupied by sum types (including constructors) up to +-- the given arity? +sumUniqsOccupied :: Arity -> Int +sumUniqsOccupied arity + = ASSERT(arity >= 2) + -- 3 + 4 + ... + arity + ((arity * (arity + 1)) `div` 2) - 3 +{-# INLINE sumUniqsOccupied #-} +-------------------------------------------------- dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique dataConWorkerUnique u = incrUnique u dataConRepNameUnique u = stepUnique u 2 |