[be more explicit about children and siblings of data constructors
John Meacham <john@repetae.net>**20061218225507] hunk ./DataConstructors.hs 6
+    DataFamily(..),
hunk ./DataConstructors.hs 18
+    numberSiblings,
hunk ./DataConstructors.hs 29
+    onlyChild,
hunk ./DataConstructors.hs 36
+import Data.Maybe
hunk ./DataConstructors.hs 114
+-- these apply to types
+data DataFamily =
+    DataAbstract        -- abstract internal type, has children of representation unknown and irrelevant.
+    | DataNone          -- children don't apply. data constructor for instance
+    | DataPrimitive     -- primitive type, children are all numbers.
+    | DataEnum !Int     -- bounded integral type, argument is maximum number
+    | DataNormal [Name] -- child constructors
+    deriving(Eq,Ord,Show)
+    {-! derive: GhcBinary !-}
+
hunk ./DataConstructors.hs 133
-    conAlias    :: AliasType,         -- whether this is a simple alias and has no tag of its own.
+    conAlias    :: AliasType,    -- whether this is a simple alias and has no tag of its own.
hunk ./DataConstructors.hs 136
-    conChildren :: Maybe [Name]  -- if nothing, then type is abstract
+    conChildren :: DataFamily
hunk ./DataConstructors.hs 159
-    f c | Just [x] <- conChildren c = getConstructor x dataTable
+    f c | DataNormal [x] <- conChildren c = getConstructor x dataTable
hunk ./DataConstructors.hs 175
-            conChildren = Nothing
+            conChildren = DataNone
hunk ./DataConstructors.hs 186
-            conChildren = Just [dc]
+            conChildren = DataNormal [dc]
hunk ./DataConstructors.hs 206
-            conChildren = Nothing
+            conChildren = DataNone
hunk ./DataConstructors.hs 221
-            conChildren = Nothing
+            conChildren = DataAbstract
hunk ./DataConstructors.hs 236
-            conChildren = Nothing
+            conChildren = DataAbstract
hunk ./DataConstructors.hs 250
-        conChildren = Nothing
+        conChildren = DataPrimitive
hunk ./DataConstructors.hs 262
-            conChildren = Nothing
+            conChildren = DataNone
hunk ./DataConstructors.hs 273
-            conChildren = Just [dc]
+            conChildren = DataNormal [dc]
hunk ./DataConstructors.hs 324
-            Constructor { conChildren = Just [cn] }  <- getConstructor c dataTable
+            Constructor { conChildren = DataNormal [cn] }  <- getConstructor c dataTable
hunk ./DataConstructors.hs 341
-            Constructor { conChildren = Just [cn] }  <- getConstructor c dataTable
+            Constructor { conChildren = DataNormal [cn] }  <- getConstructor c dataTable
hunk ./DataConstructors.hs 364
-        | Just Constructor { conChildren = Just [cn] }  <- getConstructor c dataTable,
+        | Just Constructor { conChildren = DataNormal [cn] }  <- getConstructor c dataTable,
hunk ./DataConstructors.hs 388
-        Just [con] = conChildren c
+        DataNormal [con] = conChildren c
hunk ./DataConstructors.hs 423
-        Constructor { conChildren = Just [x], conSlots = cs } <- getConstructor n dataTable
+        Constructor { conChildren = DataNormal [x], conSlots = cs } <- getConstructor n dataTable
hunk ./DataConstructors.hs 461
+            rtypeName =  mapName (id,(++ "#")) $ toName TypeConstructor (nameName (conName theType))
hunk ./DataConstructors.hs 465
-        tell $ Seq.singleton theType { conChildren = Just [consName], conVirtual = virt }
+        tell $ Seq.singleton theType { conChildren = DataNormal [consName], conVirtual = virt }
hunk ./DataConstructors.hs 472
-        tell $ Seq.singleton theType { conChildren = Just (map conName dataCons) }
+        tell $ Seq.singleton theType { conChildren = DataNormal (map conName dataCons) }
hunk ./DataConstructors.hs 483
-            conChildren = Nothing
+            conChildren = DataNone
hunk ./DataConstructors.hs 606
-    | Just c <- getConstructor n dt, Just s <- getConstructor (conInhabits c) dt = conChildren s
+    | Just c <- getConstructor n dt, Just Constructor { conChildren = DataNormal cs } <- getConstructor (conInhabits c) dt = Just cs
hunk ./DataConstructors.hs 609
+numberSiblings :: DataTable -> Name -> Maybe Int
+numberSiblings dt n
+    | Just c <- getConstructor n dt, Just Constructor { conChildren = cc } <- getConstructor (conInhabits c) dt = case cc of
+        DataNormal ds -> Just $ length ds
+        DataEnum n -> Just n
+        _ -> Nothing
+    | otherwise =  Nothing
+
+-- whether the type has a single slot
+onlyChild :: DataTable -> Name -> Bool
+onlyChild dt n = isJust ans where
+    ans = do
+        c <- getConstructor n dt
+        case conChildren c of
+            DataNormal [_] -> return ()
+            _ -> do
+                c <- getConstructor (conInhabits c) dt
+                case conChildren c of
+                    DataNormal [_] -> return ()
+                    _ -> fail "not cpr"
+
hunk ./E/Demand.hs 277
-    case getSiblings dataTable h of
-        Just [_] -> do  -- product type
+    case onlyChild dataTable h of
+        True -> do  -- product type
hunk ./E/Demand.hs 322
-    case getSiblings dataTable h of
-        Just [_] -> do  -- product type
+    case onlyChild dataTable h of
+        True -> do  -- product type
hunk ./E/FromHs.hs 794
-                        let (Just Constructor { conChildren = Just [vCons] }) = getConstructor (conInhabits patCons) dataTable
+                        let (Just Constructor { conChildren = DataNormal [vCons] }) = getConstructor (conInhabits patCons) dataTable
hunk ./E/SSimplify.hs 590
-            doCase e t b as@(Alt LitCons { litName = n } _:_) (Just d) | Just ss <- getSiblings (so_dataTable sopts) n, length ss <= length as = do
+            doCase e t b as@(Alt LitCons { litName = n } _:_) (Just d) | Just nsib <- numberSiblings (so_dataTable sopts) n, nsib <= length as = do
hunk ./E/SSimplify.hs 593
-            doCase e t b as (Just d) | te /= tWorld__, (ELit LitCons { litName = cn }) <- followAliases dt te, Just Constructor { conChildren = Just cs } <- getConstructor cn dt, length as == length cs - 1 || (False && length as < length cs && isAtomic d)  = do
+            doCase e t b as (Just d) | te /= tWorld__, (ELit LitCons { litName = cn }) <- followAliases dt te, Just Constructor { conChildren = DataNormal cs } <- getConstructor cn dt, length as == length cs - 1 || (False && length as < length cs && isAtomic d)  = do
hunk ./E/ToHs.hs 136
-        dchildren | Just [] <- childs = empty
-                  | Nothing <- childs = empty
-                  | Just childs <- childs  =  text "=" <+> hcat (punctuate (text " | ") (map dc childs))
+        dchildren | DataNormal [] <- childs = empty
+                  | DataNormal childs <- childs  =  text "=" <+> hcat (punctuate (text " | ") (map dc childs))
+                  | otherwise = empty
hunk ./E/WorkerWrapper.hs 66
-    isCPR n | isBoxed n, (Just [_]) <- getSiblings dataTable n = True
+    isCPR n | isBoxed n, onlyChild dataTable n = True