{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -pgmF drift-ghc -F #-}
module DataConstructors(
    AliasType(..),
    boxPrimitive,
    collectDeriving,
    conSlots,
    constructionExpression,
    Constructor(..),
    DataFamily(..),
    DataTable(..),
    DataTableMonad(..),
    dataTablePrims,
    deconstructionExpression,
    deriveClasses,
    extractIO,
    extractIO',
    extractPrimitive,
    ExtTypeInfo(..),
    extTypeInfoExtType,
    followAlias,
    followAliases,
    getConstructor,
    getConstructorArities,
    getProduct,
    getSiblings,
    lookupExtTypeInfo,
    mktBox,
    modBox,
    numberSiblings,
    onlyChild,
    pprintTypeOfCons,
    primitiveAliases,
    removeNewtypes,
    samplePrimitiveDataTable,
    showDataTable,
    Slot(..),
    slotTypes,
    slotTypesHs,
    tAbsurd,
    toDataTable,
    typesCompatable,
    updateLit
    ) where

import Control.Monad.Identity
import Control.Monad.Writer(tell,execWriter)
import Data.Maybe
import Data.Monoid hiding(getProduct)
import Data.List(sortBy)
import qualified Data.Map as Map hiding(map)
import qualified Data.Set as Set hiding(map)

import C.Prims
import Data.Binary
import Doc.DocLike as D
import Doc.PPrint
import Doc.Pretty
import E.Binary()
import E.E
import E.Show
import E.Subst
import E.Traverse
import E.TypeCheck
import E.Values
import FrontEnd.Class(instanceName)
import FrontEnd.HsSyn
import FrontEnd.SrcLoc
import FrontEnd.Syn.Traverse
import FrontEnd.Tc.Type
import GenUtil
import Info.Types
import Name.Id
import Name.Name as Name
import Name.Names
import Name.VConsts
import PackedString
import Support.CanType
import Support.FreeVars
import Support.MapBinaryInstance
import Support.Unparse
import Util.HasSize
import Util.SameShape
import Util.SetLike as S
import Util.VarName
import qualified Cmm.Op as Op
import qualified Util.Graph as G
import qualified Util.Seq as Seq

tipe' (TAp t1 t2) = liftM2 eAp (tipe' t1) (tipe' t2)
tipe' (TArrow t1 t2) =  do
    t1' <- tipe' t1
    t2' <- tipe' t2
    return $ EPi (tVr emptyId (t1')) t2'
tipe' (TCon (Tycon n k)) | Just n' <- Map.lookup n primitiveAliases = return $ ELit litCons { litName = n', litType = kind k }
tipe' (TCon (Tycon n k)) =  return $ ELit litCons { litName = n, litType = kind k }
tipe' (TVar tv@Tyvar { tyvarKind = k}) = do
    v <- lookupName tv
    return $ EVar $ tVr v (kind k)
tipe' (TForAll [] (_ :=> t)) = tipe' t
tipe' (TExists [] (_ :=> t)) = tipe' t
tipe' (TForAll xs (_ :=> t)) = do
    xs' <- flip mapM xs $ \tv -> do
        v <- newName (map anonymous [35 .. ]) () tv
        return $ tVr v (kind $ tyvarKind tv)
    t' <- tipe' t
    return $ foldr EPi t' xs' -- [ tVr n (kind k) | n <- [2,4..] | k <- xs ]
tipe' ~(TExists xs (_ :=> t)) = do
    xs' <- flip mapM xs $ \tv -> do
        --v <- newName [70,72..] () tv
        --return $ tVr v (kind $ tyvarKind tv)
        return $ (kind $ tyvarKind tv)
    t' <- tipe' t
    return $ ELit litCons { litName = unboxedNameTuple TypeConstructor (length xs' + 1), litArgs = (t':xs'), litType = eHash }

kind (KBase KUTuple) = eHash
kind (KBase KHash) = eHash
kind (KBase Star) = eStar
kind (KBase (KNamed t)) = ESort (ESortNamed t)
kind (Kfun k1 k2) = EPi (tVr emptyId (kind k1)) (kind k2)
kind k = error $ "DataConstructors.kind: cannot convert " ++ show k

data AliasType = ErasedAlias | RecursiveAlias
    deriving(Eq,Ord,Show)
    {-! derive: Binary !-}

-- 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 {-# UNPACK #-} !Int -- bounded integral type, argument is maximum number
    | DataNormal [Name]            -- child constructors
    | DataAlias !AliasType
    deriving(Eq,Ord,Show)
    {-! derive: Binary !-}

-- | Record describing a data type.
-- * is also a data type containing the type constructors, which are unlifted, yet boxed.

data Constructor = Constructor {
    conName      :: Name,         -- name of constructor
    conType      :: E,            -- type of constructor
    conExpr      :: E,            -- expression which constructs this value
    conOrigSlots :: [Slot],       -- original slots
    conInhabits  :: Name,         -- what constructor it inhabits, similar to conType, but not quite.
    conVirtual   :: Maybe [Name], -- whether this is a virtual constructor that translates into an enum and its siblings
    conChildren  :: DataFamily,
    conCTYPE     :: Maybe ExtType -- external type
    } deriving(Show)
    {-! derive: Binary !-}

data Slot =
    SlotNormal E
    | SlotUnpacked E !Name [E]
    | SlotExistential TVr
    deriving(Eq,Ord,Show)
    {-! derive: Binary !-}

mapESlot f (SlotExistential t) = SlotExistential t { tvrType = f (tvrType t) }
mapESlot f (SlotNormal e) = SlotNormal $ f e
mapESlot f (SlotUnpacked e n es) = SlotUnpacked (f e) n (map f es)

conSlots s = getSlots $ conOrigSlots s

getSlots ss = concatMap f ss where
    f (SlotNormal e) = [e]
    f (SlotUnpacked _ _ es) = es
    f (SlotExistential e) = [tvrType e]

getHsSlots ss = map f ss where
    f (SlotNormal e) = e
    f (SlotUnpacked e _ es) = e
    f (SlotExistential e) = tvrType e

newtype DataTable = DataTable (Map.Map Name Constructor)
    deriving(Monoid)

instance Binary DataTable where
    put (DataTable dt) = putMap dt
    get = fmap DataTable getMap

emptyConstructor = Constructor {
    conName      = error "emptyConstructor.conName",
    conType      = Unknown,
    conOrigSlots = [],
    conExpr      = Unknown,
    conInhabits  = error "emptyConstructor.conInhabits",
    conVirtual   = Nothing,
    conCTYPE     = Nothing,
    conChildren  = DataNone
    }

instance HasSize DataTable where
    size (DataTable d) = Map.size d

{-# NOINLINE getConstructor #-}
getConstructor :: Monad m => Name -> DataTable -> m Constructor
getConstructor n _ | isJust me = return (emptyConstructor {
    conName = n, conType = e,
    conExpr = foldr ELam (foldl eAp (mktBox e) (map EVar tvrs)) tvrs,
    conInhabits = s_Star, conOrigSlots = map SlotNormal sts }) where
        sts = map tvrType ss
        tvrs = [ tvr { tvrIdent = i , tvrType = t } | i <- anonymousIds | t <- sts ]
        (_,ss) = fromPi e
        me@(~(Just e)) = fromConjured modBox n `mplus` fromConjured modAbsurd n
getConstructor n _ | RawType <- nameType n = return $ primitiveConstructor n
getConstructor n _ | Just v <- fromUnboxedNameTuple n, DataConstructor <- nameType n = return $ snd $ tunboxedtuple v
getConstructor n _ | Just v <- fromUnboxedNameTuple n, TypeConstructor <- nameType n = return $ fst $ tunboxedtuple v
getConstructor n (DataTable map) = case Map.lookup n map of
    Just x -> return x
    Nothing -> fail $ "getConstructor: " ++ show (nameType n,n)

-- | return the single constructor of product types
getProduct :: Monad m => DataTable -> E -> m Constructor
getProduct dataTable e | (ELit LitCons { litName = cn }) <-
    followAliases dataTable e, Just c <- getConstructor cn dataTable = f c where
        f c | DataNormal [x] <- conChildren c = getConstructor x dataTable
            | otherwise = fail "Not Product type"
getProduct _ _ = fail "Not Product type"

tunboxedtuple :: Int -> (Constructor,Constructor)
tunboxedtuple n = (typeCons,dataCons) where
    dataCons = emptyConstructor {
        conName      = dc,
        conType      = dtipe,
        conOrigSlots = map (SlotNormal . EVar) typeVars,
        conExpr      = foldr ($) (ELit litCons
                { litName = dc
                , litArgs = map EVar vars
                , litType = ftipe
                }) (map ELam vars),
        conInhabits  = tc
        }
    typeCons = emptyConstructor {
        conName      = tc,
        conType      = foldr EPi eHash (replicate n tvr { tvrType = eStar }),
        conOrigSlots = replicate n (SlotNormal eStar),
        conExpr      = tipe,
        conInhabits  = s_Hash,
        conChildren  = DataNormal [dc]
        }
    dc = unboxedNameTuple DataConstructor n
    tc = unboxedNameTuple TypeConstructor n
    tipe = foldr ELam ftipe typeVars
    typeVars = take n [ tvr { tvrType = eStar, tvrIdent = v } | v <- anonymousIds ]
    vars =  [ tvr { tvrType = EVar t, tvrIdent = v } | v <- map anonymous [ n + 8, n + 9 ..] | t <- typeVars ]
    ftipe = ELit (litCons { litName = tc, litArgs = map EVar typeVars, litType = eHash })
    dtipe = foldr EPi (foldr EPi ftipe [ v { tvrIdent = emptyId } | v <- vars]) typeVars

-- | conjured data types, these data types are created as needed and can be of any type, their
-- actual type is encoded in their names.
--
-- Absurd - this is a type that it used to default otherwise unconstrained
-- types, it is not special in any particular way but is just an arbitrary type
-- to give to things.
--
-- Box - this type can be used to represent any boxed values. It is considered
-- equivalent to all boxed values so is not a very precise type. It is used in
-- the final stages of compilation before core mangling so that optimizations
-- that were previously blocked by type variables can be carried out.

tAbsurd k = ELit (litCons {
    litName = nameConjured modAbsurd k, litArgs = [], litType = k })
mktBox  k = ELit (litCons {
    litName = nameConjured modBox k, litArgs = [],
    litType = k, litAliasFor = af }) where
        af = case k of
            EPi TVr { tvrType = t1 } t2 -> Just (ELam tvr { tvrType = t1 } (mktBox t2))
            _ -> Nothing

tarrow = emptyConstructor {
            conName = tc_Arrow,
            conType = EPi (tVr emptyId eStar) (EPi (tVr emptyId eStar) eStar),
            conOrigSlots = [SlotNormal eStar,SlotNormal eStar],
            conExpr = ELam (tVr va1 eStar) (ELam (tVr va2 eStar) (EPi (tVr emptyId (EVar $ tVr va1 eStar)) (EVar $ tVr va2 eStar))),
            conInhabits = s_Star,
            conChildren = DataAbstract
        }

primitiveConstructor name = emptyConstructor {
    conName = name,
    conType = eHash,
    conExpr = ELit (litCons { litName = name, litArgs = [], litType = eHash }),
    conInhabits = s_Hash,
    conChildren = DataPrimitive
    }

sortName :: ESort -> Name
sortName s = f s where
    f EStar          = s_Star     -- the sort of boxed lazy types
    f EBang          = s_Bang     -- the sort of boxed strict types
    f EHash          = s_Hash     -- the sort of unboxed types
    f ETuple         = s_Tuple    -- the sort of unboxed tuples
    f EHashHash      = s_HashHash -- the supersort of unboxed types
    f EStarStar      = s_StarStar -- the supersort of boxed types
    f (ESortNamed n) = n          -- user defined sorts

sortConstructor name ss = emptyConstructor {
    conName = name,
    conType = ESort ss,
    conExpr = ESort (ESortNamed name),
    conInhabits = sortName ss
}

typesCompatable :: forall m . Monad m => E -> E -> m ()
typesCompatable a b = f etherealIds a b where
        f :: [Id] -> E -> E -> m ()
        f _ (ESort a) (ESort b) = when (a /= b) $ fail $ "Sorts don't match: " ++ pprint (ESort a,ESort b)
        f _ (EVar a) (EVar b) = when (a /= b) $ fail $ "Vars don't match: " ++ pprint (a,b)
        -- we expand aliases first, because the newtype might have phantom types as arguments
        f c (ELit (LitCons {  litAliasFor = Just af, litArgs = as })) b = do
            f c (foldl eAp af as) b
        f c a (ELit (LitCons {  litAliasFor = Just af, litArgs = as })) = do
            f c a (foldl eAp af as)
        f c (ELit LitCons { litName = n, litArgs = xs, litType = t }) (ELit LitCons { litName = n', litArgs = xs', litType = t' }) | n == n' = do
            f c t t'
            when (not $ sameShape1 xs xs') $ fail "Arg lists don't match"
            zipWithM_ (f c) xs xs'
        f c (EAp a b) (EAp a' b') = do
            f c a a'
            f c b b'
        f c (ELam va ea) (ELam vb eb) = lam va ea vb eb c
        f c (EPi va ea) (EPi vb eb)   = lam va ea vb eb c
        f c (EPi (TVr { tvrIdent = eid, tvrType =  a}) b) (ELit (LitCons { litName = n, litArgs = [a',b'], litType = t })) | eid == emptyId, conName tarrow == n, t == eStar = do
            f c a a'
            f c b b'
        f c (ELit (LitCons { litName = n, litArgs = [a',b'], litType = t })) (EPi (TVr { tvrIdent = eid, tvrType =  a}) b)  | eid == emptyId, conName tarrow == n, t == eStar = do
            f c a a'
            f c b b'
        f _ a b | boxCompat a b || boxCompat b a = return ()
        f _ a b = fail $ "Types don't match:" ++ pprint (a,b)

        lam :: TVr -> E -> TVr -> E -> [Id] -> m ()
        lam va ea vb eb ~(c:cs) = do
            f (c:cs) (tvrType va) (tvrType vb)
            f cs (subst va (EVar va { tvrIdent = c }) ea) (subst vb (EVar vb { tvrIdent = c }) eb)
        boxCompat (ELit (LitCons { litName = n }))  t | Just e <- fromConjured modBox n =  e == getType t
        boxCompat _ _ = False

extractPrimitive :: Monad m => DataTable -> E -> m (E,(ExtType,E))
extractPrimitive dataTable e = case followAliases dataTable (getType e) of
    st@(ELit LitCons { litName = c, litArgs = [], litType = t })
        | t == eHash -> return (e,(ExtType (packString $ show c),st))
        | otherwise -> do
            Constructor { conChildren = DataNormal [cn] }  <- getConstructor c dataTable
            Constructor { conOrigSlots = [SlotNormal st] } <- getConstructor cn dataTable
            (ELit LitCons { litName = n, litArgs = []}) <- return $ followAliases dataTable st
            let tvra = tVr vn st
                (vn:_) = newIds (freeIds e)
            return (eCase e  [Alt (litCons { litName = cn, litArgs = [tvra],
                litType = (getType e) }) (EVar tvra)] Unknown,(ExtType (packString $ show n),st))
    e' -> fail $ "extractPrimitive: " ++ show (e,e')

boxPrimitive ::
    Monad m
    => DataTable
    -> E         -- primitive to box
    -> E         -- what type we want it to have
    -> m (E,(ExtType,E))
boxPrimitive dataTable e et = case followAliases dataTable et of
    st@(ELit LitCons { litName = c, litArgs = [], litType = t })
        | t == eHash -> return (e,(ExtType . packString $ show c,st))
        | otherwise -> do
            Constructor { conChildren = DataNormal [cn] }  <- getConstructor c dataTable
            Constructor { conOrigSlots = [SlotNormal st] } <- getConstructor cn dataTable
            (ELit LitCons { litName = n, litArgs = []}) <- return $ followAliases dataTable st
            let tvra = tVr vn st
                (vn:_) = newIds (freeVars (e,et))
            if isManifestAtomic e then
                return $ (ELit litCons { litName = cn, litArgs = [e], litType = et },(ExtType . packString $ show n,st))
             else
                return $ (eStrictLet tvra e $ ELit litCons { litName = cn, litArgs = [EVar tvra], litType = et },(ExtType . packString $ show n,st))
    e' -> fail $ "boxPrimitive: " ++ show (e,e')

extractIO :: Monad m => E -> m E
extractIO e = f e where
    f (ELit LitCons { litName = c, litArgs = [x] }) | c == tc_IO  = return x
    f (ELit LitCons { litAliasFor = Just af, litArgs = as }) = f (foldl eAp af as)
    f _ = fail "extractIO: not an IO type"

-- extract IO or an unboxed version of it, (ST, World -> (# Wold, a #))
extractIO' :: E -> ([E],Bool,E)
extractIO' e = f e [] where
    f (ELit LitCons { litName = c, litArgs = [x] }) rs | c == tc_IO  = (reverse rs, True,x)
    f (ELit LitCons { litName = c, litArgs = [_,x] }) rs | c == tc_ST  = (reverse rs, True,x)
    f (expandAlias -> Just t) rs = f t rs
    f (fromPi -> (fromUnboxedTuple -> Just [s',x],[getType -> s''])) rs
        | isState_ s' && isState_ s'' = (reverse rs, True,x)
    f (EPi v e) rs = f e (getType v:rs)
    f e rs = (reverse rs, False,e)
--    f (fromPi -> (getType -> s',[getType -> s''])) | isState_ s' && isState_ s'' = (True,tUnit)

data ExtTypeInfo
    = ExtTypeVoid                  -- maps to 'void'
    | ExtTypeRaw ExtType           -- value is an unboxed type suitable for passing with the argument calling convention
    | ExtTypeBoxed Name E ExtType  -- boxed type, name is constructor of box, E is type of the slice, and ExtType is the calling convention to use

extTypeInfoExtType (ExtTypeRaw et) = et
extTypeInfoExtType (ExtTypeBoxed _ _ et) = et
extTypeInfoExtType ExtTypeVoid = "void"

lookupExtTypeInfo :: Monad m => DataTable -> E -> m ExtTypeInfo
lookupExtTypeInfo dataTable oe = f Set.empty oe where
    f :: Monad m => Set.Set Name -> E -> m ExtTypeInfo
    -- handle the void context ones first
    f _ e@(ELit LitCons { litName = c }) | c == tc_Unit || c == tc_State_ = return ExtTypeVoid
    -- if the constructor is in the external type map, replace its external
    -- type with the one in the map
    f seen e@(ELit LitCons { litName = c, litArgs = [ta] }) | c == tc_Ptr = do
        ExtTypeBoxed b t _ <- g seen e  -- we know a pointer is a boxed BitsPtr
        case f seen ta of
            Just (ExtTypeBoxed _ _ (ExtType et)) -> return $ ExtTypeBoxed b t (ExtType $ et `mappend` "*")
            Just (ExtTypeRaw (ExtType et)) -> return $ ExtTypeBoxed b t (ExtType $ et `mappend` "*")
            _ -> return $ ExtTypeBoxed b t "HsPtr"
    f seen e@(ELit LitCons { litName = c, litArgs = [ta] }) | c == tc_Complex = do
        case f seen ta of
            Just (ExtTypeRaw (ExtType et)) -> return $ ExtTypeRaw (ExtType $ "_Complex " `mappend` et)
            _ -> fail "invalid _Complex type"
    f seen e@(ELit LitCons { litName = c }) | Just (conCTYPE -> Just et) <- getConstructor c dataTable = do
        return $ case g seen e of
            Just (ExtTypeBoxed b t _) -> ExtTypeBoxed b t et
            Just ExtTypeVoid -> ExtTypeVoid
            _ -> ExtTypeRaw et
    f seen e = g seen e
    -- if we are a raw type, we can be foreigned
    g _ (ELit LitCons { litName = c })
        | Just et <- Map.lookup c rawExtTypeMap = return (ExtTypeRaw et)
    -- if we are a single constructor data type with a single foreignable unboxed
    -- slot, we are foreiginable
    g _ (ELit LitCons { litName = c, litAliasFor = Nothing })
        | Just Constructor { conChildren = DataNormal [cn] }  <- getConstructor c dataTable,
          Just Constructor { conOrigSlots = [SlotNormal st] } <- getConstructor cn dataTable,
          Just (ExtTypeRaw et) <- lookupExtTypeInfo dataTable st = return $ ExtTypeBoxed cn st et
    g seen e@(ELit LitCons { litName = n }) | Just e' <- followAlias dataTable e,
        n `Set.notMember` seen = f (Set.insert n seen) e'
    g _ e = fail $ "lookupExtTypeInfo: " ++ show (oe,e)

expandAlias :: Monad m => E -> m E
expandAlias (ELit LitCons { litAliasFor = Just af, litArgs = as }) = return (foldl eAp af as)
expandAlias  _ = fail "expandAlias: not alias"

followAlias :: Monad m => DataTable -> E -> m E
followAlias _ (ELit LitCons { litAliasFor = Just af, litArgs = as }) = return (foldl eAp af as)
followAlias _  _ = fail "followAlias: not alias"

followAliases :: DataTable -> E -> E
followAliases _dataTable e = f e where
    f (ELit LitCons { litAliasFor = Just af, litArgs = as }) = f (foldl eAp af as)
    f e = e

dataTablePrims = DataTable $ Map.fromList ([ (conName x,x) | x <- [tarrow] ])

deriveClasses :: IdMap Comb -> DataTable -> [(SrcLoc,Name,Name)] -> [(TVr,E)]
deriveClasses cmap dt@(DataTable mp) ctd = concatMap f ctd where
    f (_,cd,t) | Just c <- getConstructor t dt, TypeConstructor == nameType (conName c), Just is <- conVirtual c = g is c cd
    f _ = []
    g is c cl = h cl where
        lupvar v = EVar (combHead comb) where
            Just comb = mlookup (toId v) cmap
        typ = conExpr c
        DataNormal [con] = conChildren c
        Just conr = getConstructor con (DataTable mp)
        [it@(ELit LitCons { litName = it_name })] = conSlots conr
        Just itr = getConstructor it_name (DataTable mp)
        DataEnum mv = conChildren itr
        v1 = tvr { tvrIdent = anonymous 1,  tvrType = typ }
        v2 = tvr { tvrIdent = anonymous 2,  tvrType = typ }
        i1 = tvr { tvrIdent = anonymous 3,  tvrType = it }
        i2 = tvr { tvrIdent = anonymous 4,  tvrType = it }
        b3 = tvr { tvrIdent = anonymous 5,  tvrType = tBoolzh }
        val1 = tvr { tvrIdent = anonymous 7, tvrType = typ }
        unbox e = ELam v1 (ELam v2 (ec (EVar v1) i1 (ec (EVar v2) i2 e)))  where
            ec v i e = eCase v [Alt (litCons { litName = con, litArgs = [i], litType = typ }) e] Unknown
        h cl | cl == class_Eq = [mkCmpFunc v_equals Op.Eq]
        h cl | cl == class_Ord = [
                mkCmpFunc v_geq Op.UGte,
                mkCmpFunc v_leq Op.ULte,
                mkCmpFunc v_lt  Op.ULt,
                mkCmpFunc v_gt  Op.UGt]
        h cl | Just ans <- lookup cl mthds = ans where
            mthds = [(class_Enum,[
                    (iv_te,ib_te),
                    (iv_fe,ib_fe),
                    iv v_succ succ_body,
                    iv v_pred pred_body,
                    iv v_enumFrom from_body,
                    iv v_enumFromTo fromTo_body,
                    iv v_enumFromThen fromThen_body,
                    iv v_enumFromThenTo fromThenTo_body
                ]),
                (class_Ix,[
                    iv v_range range_body,
--                    iv v_inRange inRange_body,
                    iv v_index index_body
                ])]
            iv_te = setProperty prop_INSTANCE tvr { tvrIdent = toId $ instanceName v_toEnum (nameName $ conName c), tvrType = getType ib_te }
            iv_fe = setProperty prop_INSTANCE tvr { tvrIdent = toId $ instanceName v_fromEnum (nameName $ conName c), tvrType = getType ib_fe }
            iv fname body = (setProperty prop_INSTANCE tvr { tvrIdent = toId $ instanceName fname (nameName $ conName c), tvrType = getType body },body)
            succ_body = foldl EAp (lupvar v_enum_succ) [typ, box, debox, max]
            pred_body = foldl EAp (lupvar v_enum_pred) [typ, box, debox]
            from_body = foldl EAp (lupvar v_enum_from) [typ, box, debox, max]
            fromTo_body = foldl EAp (lupvar v_enum_fromTo) [typ, box, debox]
            fromThen_body = foldl EAp (lupvar v_enum_fromThen) [typ, box, debox, max]
            fromThenTo_body = foldl EAp (lupvar v_enum_fromThenTo) [typ, box, debox]
            range_body = foldl EAp (lupvar v_ix_range) [typ, box, debox]
            --inRange_body = foldl EAp (lupvar v_ix_inRange) [typ, box, debox]
            index_body = foldl EAp (lupvar v_ix_index) [typ, box, debox]

            ib_te = foldl EAp (lupvar v_enum_toEnum) [typ, box, toEzh (mv - 1)]
            ib_fe = ELam val1 (create_uintegralCast_toInt con tEnumzh (EVar val1))

            max = ELit (LitInt (fromIntegral $ mv - 1) tEnumzh)

            box = ELam i1 (ELit (litCons { litName = con, litArgs = [EVar i1], litType = typ }))
            debox = ELam v1 (ec (EVar v1) i1 (EVar i1))  where
                ec v i e = eCase v [Alt (litCons { litName = con, litArgs = [i], litType = typ }) e] Unknown

        h _ = []
        mkCmpFunc fname op = (iv_eq,ib_eq) where
            ib_eq = unbox (eStrictLet b3 (oper_IIB op (EVar i1) (EVar i2)) (ELit (litCons { litName = dc_Boolzh, litArgs = [EVar b3], litType = tBool })))
            iv_eq = setProperty prop_INSTANCE tvr { tvrIdent = toId $ instanceName fname (nameName $ conName c), tvrType = getType ib_eq }
    oper_IIB op a b = EPrim (Op (Op.BinOp op Op.bits16 Op.bits16) Op.bits16) [a,b] tBoolzh

create_integralCast conv c1 t1 c2 t2 e t = eCase e [Alt (litCons { litName = c1, litArgs = [tvra], litType = te }) cc] Unknown  where
    te = getType e
    ELit LitCons { litName = n1, litArgs = [] } = t1
    ELit LitCons { litName = n2, litArgs = [] } = t2
    Just n1' = nameToOpTy n1
    Just n2' = nameToOpTy n2
    tvra =  tVr va2 t1
    tvrb =  tVr va3 t2
    cc = if n1 == n2 then ELit (litCons { litName = c2, litArgs = [EVar tvra], litType = t }) else
        eStrictLet  tvrb (EPrim (Op (Op.ConvOp conv n1') n2') [EVar tvra] t2)  (ELit (litCons { litName = c2, litArgs = [EVar tvrb], litType = t }))

nameToOpTy n = do RawType <- return $ nameType n; Op.readTy (show n)

create_uintegralCast_toInt c1 t1 e = create_integralCast Op.U2U c1 t1 dc_Int tIntzh e tInt

updateLit :: DataTable -> Lit e t -> Lit e t
updateLit _ l@LitInt {} = l
updateLit dataTable lc@LitCons { litAliasFor = Just {} } = lc
updateLit dataTable lc@LitCons { litName = n } =  lc { litAliasFor = af } where
    af = do
        Constructor { conChildren = DataNormal [x], conOrigSlots = cs } <- getConstructor n dataTable
        Constructor { conChildren = DataAlias ErasedAlias, conOrigSlots = [SlotNormal sl] } <- getConstructor x dataTable
        return (foldr ELam sl [ tVr i s | s <- getSlots cs | i <- anonymousIds])

removeNewtypes :: DataTable -> E -> E
removeNewtypes dataTable e = runIdentity (f e) where
    f ec@ECase {} = emapEGH f f return ec { eCaseAlts = map g (eCaseAlts ec) } where
        g (Alt l e) = Alt (gl $ updateLit dataTable l) e
    f (ELit l) = emapEGH f f return (ELit (gl $ updateLit dataTable l))
    f e = emapEGH f f return e
    gl lc@LitCons { litAliasFor = Just e }  = lc { litAliasFor = Just $ removeNewtypes dataTable e }
    gl l = l

collectDeriving :: [HsDecl] -> [(SrcLoc,Name,Name)]
collectDeriving ds = concatMap f ds where
    f decl@HsDataDecl {} = g decl
    f decl@HsDeclDeriving {} = h decl
    f _ = []
    g decl = [(hsDeclSrcLoc decl, toName ClassName c,
        toName TypeConstructor (hsDeclName decl)) | c <- hsDeclDerives decl ]
    h decl@(hsDeclClassHead -> ch) | [(ltc -> Just t)] <- hsClassHeadArgs ch = [(hsDeclSrcLoc decl,toName ClassName (hsClassHead ch), t)] where
            ltc (HsTyApp t1 _) = ltc t1
            ltc (HsTyCon n) = Just (toName TypeConstructor n)
            ltc x = Nothing
    h _ = []

{-# NOINLINE toDataTable #-}
toDataTable :: (Map.Map Name Kind) -> (Map.Map Name Type) -> [HsDecl] -> DataTable -> DataTable
toDataTable km cm ds currentDataTable = newDataTable  where
    newDataTable = DataTable (Map.mapWithKey fixupMap $
        Map.fromList [ (conName x,procNewTypes x) | x <- ds', conName x `notElem` keys primitiveAliases ])
    fullDataTable = (newDataTable `mappend` currentDataTable)
    procNewTypes c = c { conExpr = f (conExpr c), conType = f (conType c), conOrigSlots = map (mapESlot f) (conOrigSlots c) } where
        f = removeNewtypes fullDataTable
    fixupMap k _ | Just n <- getConstructor k dataTablePrims = n
    fixupMap _ n = n
    ds' = Seq.toList $ execWriter (mapM_ f ds)
    newtypeLoopBreakers = map fst $ fst $  G.findLoopBreakers (const 0) (const True) (G.newGraph newtypeDeps fst snd) where
        newtypeDeps = [ (n,concatMap (fm . hsBangType) $ hsConDeclArgs c) |
            HsDataDecl { hsDeclDeclType = DeclTypeNewtype, hsDeclName = n, hsDeclCons = (head -> c) } <- ds ]
        fm t = execWriter $ f t
        f HsTyCon { hsTypeName = n } = tell [n]
        f t = traverseHsType_ f t
    f decl@HsDataDecl { hsDeclDeclType = DeclTypeNewtype,  hsDeclName = nn, hsDeclCons = cs } =
        dt decl (if nn `elem` newtypeLoopBreakers then DataAlias RecursiveAlias else DataAlias ErasedAlias) cs
    f decl@HsDataDecl { hsDeclDeclType = DeclTypeKind } = dkind decl
    f decl@HsDataDecl { hsDeclCons = cs } = dt decl DataNone cs
    f _ = return ()
    dt decl DataNone cs@(_:_:_) | all null (map hsConDeclArgs cs) = do
        let virtualCons'@(fc:_) = map (makeData DataNone typeInfo) cs
            typeInfo@(theType,_,_) = makeType decl (hsDeclCTYPE decl)
            virt = Just (map conName virtualCons')
            f (n,vc) = vc { conExpr = ELit (litCons { litName = consName, litArgs = [ELit (LitInt (fromIntegral n) rtype)], litType = conType vc }), conVirtual = virt }
            virtualCons = map f (zip [(0 :: Int) ..] virtualCons')
            consName =  mapName (id,(++ "#")) $ toName DataConstructor (nameName (conName theType))
            rtypeName =  mapName (id,(++ "#")) $ toName TypeConstructor (nameName (conName theType))
            rtype = ELit litCons { litName = rtypeName, litType = eHash, litAliasFor = Just tEnumzh }
            dataCons = fc { conName = consName, conType = getType (conExpr dataCons), conOrigSlots = [SlotNormal rtype], conExpr = ELam (tVr (anonymous 3) rtype) (ELit (litCons { litName = consName, litArgs = [EVar (tVr (anonymous 6) rtype)], litType =  conExpr theType })) }
            rtypeCons = emptyConstructor {
                conName = rtypeName,
                conType = eHash,
                conExpr = rtype,
                conInhabits = s_Hash,
                conChildren = DataEnum (length virtualCons)
                }
        tell (Seq.fromList virtualCons)
        tell (Seq.singleton dataCons)
        tell (Seq.singleton rtypeCons)
        tell $ Seq.singleton theType { conChildren = DataNormal [consName], conVirtual = virt }
        return ()

    dt decl alias cs = do
        let dataCons = map (makeData alias typeInfo) cs
            typeInfo@(theType,_,_) = makeType decl (hsDeclCTYPE decl)
        tell (Seq.fromList dataCons)
        tell $ Seq.singleton theType { conChildren = DataNormal (map conName dataCons) }

    dkind HsDataDecl { .. } = do
        tell $ Seq.singleton $ (sortConstructor hsDeclName EHashHash) {
            conChildren = DataNormal (map hsConDeclName hsDeclCons) }
        flip mapM_  hsDeclCons $ \ HsConDecl { .. } -> do
            let Just theKind = kind `fmap` (Map.lookup hsConDeclName km)
                (theTypeFKind,theTypeKArgs') = fromPi theKind
                theTypeArgs = [ tvr { tvrIdent = x } | tvr  <- theTypeKArgs' | x <- anonymousIds ]
                theTypeExpr = ELit litCons {
                    litName = hsConDeclName,
                    litArgs = map EVar theTypeArgs,
                    litType = theTypeFKind }
            tell $ Seq.singleton emptyConstructor {
                conName      = hsConDeclName,
                conType      = theKind,
                conOrigSlots = map (SlotNormal . tvrType) theTypeArgs,
                conExpr      = foldr ($) theTypeExpr (map ELam theTypeArgs),
                conInhabits  = hsDeclName
            }
    dkind _ = error "dkind passed bad decl"

    makeData alias (theType,theTypeArgs,theTypeExpr) x = theData where
        theData = emptyConstructor {
            conName = dataConsName,
            conType =foldr ($) (getType theExpr) (map EPi theTypeArgs),
            conOrigSlots = origSlots,
            conExpr = theExpr,
            conInhabits = conName theType,
            conChildren = alias
            }
        dataConsName =  toName Name.DataConstructor (hsConDeclName x)

        theExpr =  foldr ELam (strictize tslots $ ELit litCons { litName = dataConsName, litArgs = map EVar dvars, litType = theTypeExpr }) hsvars

        strictize tslots con = E.Subst.subst tvr { tvrIdent = sillyId } Unknown $ f tslots con where
            f (Left (v,False):rs) con = f rs con
            f (Left (v,True):rs) con = eStrictLet v (EVar v) (f rs con)
            f (Right (v,dc,rcs):rs) con = eCase (EVar v) [Alt pat (f rs con)] Unknown where
                pat = litCons { litName = dc, litArgs = rcs, litType = (getType v) }
            f [] con = con

        -- substitution is only about substituting type variables
        (ELit LitCons { litArgs = thisTypeArgs }, origArgs) = fromPi $ runVarName $ do
            let (vs,ty) = case Map.lookup dataConsName cm of Just (TForAll vs (_ :=> ty)) -> (vs,ty); ~(Just ty) -> ([],ty)
            mapM_ (newName anonymousIds ()) vs
            tipe' ty
        subst = substMap $ fromList [ (tvrIdent tv ,EVar $ tv { tvrIdent = p }) | EVar tv <- thisTypeArgs | p <- anonymousIds ]

        origSlots = map SlotExistential existentials ++ map f tslots where
            f (Left (e,_)) = SlotNormal (getType e)
            f (Right (e,n,es)) = SlotUnpacked (getType e) n (map getType es)
        hsvars = existentials ++ map f tslots where
            f (Left (e,_)) = e
            f (Right (e,_,_)) = e
        dvars = existentials ++ concatMap f tslots where
            f (Left (e,_)) = [e]
            f (Right (_,_,es)) = es
        tslots = f (newIds fvset) (map isHsBangedTy (hsConDeclArgs x)) origArgs where
            f (i:is) (False:bs) (e:es) = Left (e { tvrIdent = i, tvrType = subst (tvrType e) },False):f is bs es
            f (i:j:is) (True:bs) (e:es) = maybe  (Left (e { tvrIdent = i, tvrType = subst (tvrType e) },True):f is bs es) id $ g e (tvrType e) where
                g e te = do
                    ELit LitCons { litName = n } <- return $ followAliases fullDataTable te
                    Constructor { conChildren = DataNormal [dc] } <- getConstructor n fullDataTable
                    con <- getConstructor dc fullDataTable
                    case (conChildren con,slotTypes fullDataTable dc te) of
                        (DataAlias ErasedAlias,[nt]) -> g e nt
                        (_,[st]) -> do
                            let nv = tvr { tvrIdent = j, tvrType = st }
                            return $ Right (e { tvrIdent = i, tvrType = subst (tvrType e)},dc,[nv]):f is bs es
                        _ -> fail "not unboxable"
            f _ [] [] = []
            f _ _ _ = error "DataConstructors.tslots"
            fvset = freeVars (thisTypeArgs,origArgs) `mappend` fromList (take (length theTypeArgs + 2) anonymousIds)

        -- existentials are free variables in the arguments, that arn't bound in the type
        existentials = values $ freeVars (map getType origArgs) S.\\ (freeVars thisTypeArgs :: IdMap TVr)

        -- arguments that the front end passes or pulls out of this constructor
        --hsArgs = existentials ++ [ tvr {tvrIdent = x} | tvr <- origArgs | x <- drop (5 + length theTypeArgs) [2,4..] ]

    makeType decl ct = (theType,theTypeArgs,theTypeExpr) where
        theTypeName = toName Name.TypeConstructor (hsDeclName decl)
        Just theKind = kind `fmap` (Map.lookup theTypeName km)
        (theTypeFKind,theTypeKArgs') = fromPi theKind
        theTypeArgs = [ tvr { tvrIdent = x } | tvr  <- theTypeKArgs' | x <- anonymousIds ]
        theTypeExpr = ELit litCons { litName = theTypeName, litArgs = map EVar theTypeArgs, litType = theTypeFKind }
        theType = emptyConstructor {
            conCTYPE     = fmap (ExtType . packString) ct,
            conExpr      = foldr ($) theTypeExpr (map ELam theTypeArgs),
            conInhabits  = if theTypeFKind == eStar then s_Star else s_Hash,
            conName      = theTypeName,
            conOrigSlots = map (SlotNormal . tvrType) theTypeArgs,
            conType      = theKind,
            conVirtual   = Nothing
            }

isHsBangedTy HsBangedTy {} = True
isHsBangedTy _ = False

getConstructorArities  :: DataTable -> [(Name,Int)]
getConstructorArities (DataTable dt) = [ (n,length $ conSlots c) | (n,c) <- Map.toList dt]

constructionExpression ::
    DataTable -- ^ table of data constructors
    -> Name   -- ^ name of said constructor
    -> E      -- ^ type of eventual constructor
    -> E      -- ^ saturated lambda calculus term
constructionExpression dataTable n typ@(ELit LitCons { litName = pn, litArgs = xs })
    | DataAlias ErasedAlias <- conChildren mc = ELam var (EVar var)
    | DataAlias RecursiveAlias <- conChildren mc = let var' = var { tvrType = st } in ELam var' (prim_unsafeCoerce (EVar var') typ)
    | pn == conName pc = sub (conExpr mc) where
    ~[st] = slotTypes dataTable n typ
    var = tvr { tvrIdent = vid, tvrType = typ }
    (vid:_) = newIds (freeVars typ)
    Just mc = getConstructor n dataTable
    Just pc = getConstructor (conInhabits mc) dataTable
    sub = substMap $ fromDistinctAscList [ (i,sl) | sl <- xs | i <- anonymousIds ]
constructionExpression wdt n e | Just fa <- followAlias wdt e  = constructionExpression wdt n fa
constructionExpression _ n e = error $ "constructionExpression: error in " ++ show n ++ ": " ++ show e

deconstructionExpression ::
    UniqueProducer m
    => DataTable  -- ^ table of data constructors
    -> Name       -- ^ name of said constructor
    -> E          -- ^ type of pattern
    -> [TVr]      -- ^ variables to be bound
    -> E          -- ^ body of alt
    -> m (Alt E)  -- ^ resulting alternative
deconstructionExpression dataTable name typ@(ELit LitCons { litName = pn, litArgs = xs }) vs  e | pn == conName pc = ans where
    Just mc = getConstructor name dataTable
    Just pc = getConstructor (conInhabits mc) dataTable
    sub = substMap $ fromDistinctAscList [ (i,sl) | sl <- xs | i <- anonymousIds ]
    ans = case conVirtual mc of
        Just _ -> return $ let ELit LitCons {  litArgs = [ELit (LitInt n t)] } = conExpr mc in Alt (LitInt n t) e
        Nothing -> do
            let f vs (SlotExistential t:ss) rs ls = f vs ss (t:rs) ls
                f (v:vs) (SlotNormal _:ss) rs ls = f vs ss (v:rs) ls
                f (v:vs) (SlotUnpacked e n es:ss) rs ls = do
                    let g t = do
                            s <- newUniq
                            return $ tVr (anonymous s) t
                    as <- mapM g (map sub es)
                    f vs ss (reverse as ++ rs) ((v,ELit litCons { litName = n, litArgs = map EVar as, litType = sub e }):ls)
                f [] [] rs ls = return $ Alt (litCons { litName = name, litArgs = reverse rs, litType = typ }) (eLetRec ls e)
                f _ _ _ _ = error "DataConstructors.deconstructuonExpression.f"
            f vs (conOrigSlots mc) [] []
deconstructionExpression wdt n ty vs e | Just fa <- followAlias wdt ty  = deconstructionExpression wdt n fa vs e
deconstructionExpression _ n e _ _ = error $ "deconstructionExpression: error in " ++ show n ++ ": " ++ show e

slotTypes ::
    DataTable -- ^ table of data constructors
    -> Name   -- ^ name of constructor
    -> E      -- ^ type of value
    -> [E]    -- ^ type of each slot
slotTypes wdt n (ELit LitCons { litName = pn, litArgs = xs, litType = _ })
    | pn == conName pc = [sub x | x <- conSlots mc ]
    where
    Identity mc = getConstructor n wdt
    Identity pc = getConstructor (conInhabits mc) wdt
    sub = substMap $ fromDistinctAscList [ (i,sl) | sl <- xs | i <- anonymousIds ]
slotTypes wdt n kind
    | sortKindLike kind, (e,ts) <- fromPi kind = take (length (conSlots mc) - length ts) (conSlots mc)
    ---- | sortKindLike kind, (e,ts) <- fromPi kind = (conSlots mc)
    where Identity mc = getConstructor n wdt
slotTypes wdt n e | Just fa <- followAlias wdt e  = slotTypes wdt n fa
slotTypes _ n e = error $ "slotTypes: error in " ++ show n ++ ": " ++ show e

slotTypesHs ::
    DataTable -- ^ table of data constructors
    -> Name   -- ^ name of constructor
    -> E      -- ^ type of value
    -> [E]    -- ^ type of each slot
slotTypesHs wdt n (ELit LitCons { litName = pn, litArgs = xs, litType = _ })
    | pn == conName pc = [sub x | x <- getHsSlots $ conOrigSlots mc ]
    where
    Identity mc = getConstructor n wdt
    Identity pc = getConstructor (conInhabits mc) wdt
    sub = substMap $ fromDistinctAscList [ (i,sl) | sl <- xs | i <- anonymousIds ]
slotTypesHs wdt n kind
    | sortKindLike kind, (e,ts) <- fromPi kind = take (length (conSlots mc) - length ts) (conSlots mc)
    where Identity mc = getConstructor n wdt
slotTypesHs wdt n e | Just fa <- followAlias wdt e  = slotTypes wdt n fa
slotTypesHs _ n e = error $ "slotTypesHs: error in " ++ show n ++ ": " ++ show e

{-# NOINLINE showDataTable #-}
showDataTable (DataTable mp) = vcat xs where
    c con = vcat [t,e,cs,vt,ih,ch,mc] where
        t  = text "::"        <+> ePretty conType
        e  = text "="         <+> ePretty conExpr
        cs = text "slots:"    <+> tupled (map ePretty (conSlots con))
        vt = text "virtual:"  <+> tshow conVirtual
        ih = text "inhabits:" <+> tshow conInhabits
        ch = text "children:" <+> tshow conChildren
        mc = text "CTYPE:"    <+> tshow conCTYPE
        Constructor { .. } = con
    xs = [text x <+> hang 0 (c y) | (x,y) <- ds ]
    ds = sortBy (\(x,_) (y,_) -> compare x y) [(show x,y)  | (x,y) <-  Map.toList mp]

{-# NOINLINE samplePrimitiveDataTable #-}
samplePrimitiveDataTable :: DataTable
samplePrimitiveDataTable = DataTable $ Map.fromList [ (x,c) | x <- xs, c <- getConstructor x mempty] where
    nt v = map (flip unboxedNameTuple (v::Int)) [DataConstructor, TypeConstructor]
    xs = nt 0 ++ nt 3 ++ [nameConjured modAbsurd eStar,nameConjured modBox hs, nameConjured modAbsurd hs', nameConjured modBox hs',rt_bits16,rt_bits_ptr_]
    hs = EPi (tVr emptyId eHash) eStar
    hs' = tFunc eStar (tFunc (tFunc eStar eHash) eStar)

getSiblings :: DataTable -> Name -> Maybe [Name]
getSiblings dt n
    | Just c <- getConstructor n dt, Just Constructor { conChildren = DataNormal cs } <- getConstructor (conInhabits c) dt = Just cs
    | otherwise =  Nothing

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"

pprintTypeOfCons :: (Monad m,DocLike a) => DataTable -> Name -> m a
pprintTypeOfCons dataTable name = do
    c <- getConstructor name dataTable
    return $ pprintTypeAsHs (conType c)

pprintTypeAsHs :: DocLike a => E -> a
pprintTypeAsHs e = unparse $ runVarName (f e) where
    f e | e == eStar = return $ atom $ text "*"
        | e == eHash = return $ atom $ text "#"
    f (EPi (TVr { tvrIdent = eid, tvrType = t1 }) t2) | eid == emptyId = do
        t1 <- f t1
        t2 <- f t2
        return $ t1 `arr` t2
    f (ELit LitCons { litName = n, litArgs = as }) | (a:as') <- reverse as = f $ EAp (ELit litCons { litName = n, litArgs = reverse as' }) a
    f (ELit LitCons { litName = n, litArgs = [] }) = return $ atom $ text $ show n
    f (EAp a b) = do
        a <- f a
        b <- f b
        return $ a `app` b
    f (EVar v) = do
        vo <- newLookupName ['a' .. ] () (tvrIdent v)
        return $ atom $ char vo
    f v | (e,ts@(_:_)) <- fromPi v = do
        ts' <- mapM (newLookupName ['a'..] () . tvrIdent) ts
        r <- f e
        return $ fixitize (N,-3) $ pop (text "forall" <+> hsep (map char ts') <+> text ". ")  (atomize r)
    f e = error $ "printTypeAsHs: " ++ show e
    arr = bop (R,0) (space D.<> text "->" D.<> space)
    app = bop (L,100) (text " ")

class Monad m => DataTableMonad m where
    getDataTable :: m DataTable
    getDataTable = return mempty

instance DataTableMonad Identity

-- | list of declared data types that map
-- directly to primitive real types

primitiveAliases :: Map.Map Name Name
primitiveAliases = Map.fromList [
    (tc_Bits1,    rt_bool),
    (tc_Bits8,    rt_bits8),
    (tc_Bits16,   rt_bits16),
    (tc_Bits32,   rt_bits32),
    (tc_Bits64,   rt_bits64),
    (tc_Bits128,  rt_bits128),
    (tc_BitsPtr,  rt_bits_ptr_),
    (tc_BitsMax,  rt_bits_max_),
    (tc_Float32,  rt_float32),
    (tc_Float64,  rt_float64),
    (tc_Float80,  rt_float80),
    (tc_Float128, rt_float128)
    ]

-- mapping of primitive types to the C calling convention used
-- when passing to/from foreign functions

rawExtTypeMap :: Map.Map Name ExtType
rawExtTypeMap = Map.fromList [
    (rt_bool,      "bool"),
    (rt_bits8,     "uint8_t"),
    (rt_bits16,    "uint16_t"),
    (rt_bits32,    "uint32_t"),
    (rt_bits64,    "uint64_t"),
    (rt_bits128,   "uint128_t"),
    (rt_bits_ptr_, "uintptr_t" ),
    (rt_bits_max_, "uintmax_t"),
    (rt_float32,   "float"),
    (rt_float64,   "double"),
    (rt_float80,   "long double"),
    (rt_float128,  "__float128")
    ]