{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

-- This is in a separate file due to GHC's phase restriction

#ifdef ONLY_ONE_LANGUAGE
module Cubix.Language.C.Parametric.Full.Names () where
#else
module Cubix.Language.C.Parametric.Full.Names (
    origASTTypes
  , newASTTypes
  , cSigNames
  , makeSubsts
  ) where

import           Data.Map ( Map )
import qualified Data.Map as Map

import           Language.Haskell.TH hiding ( Name )
import qualified Language.Haskell.TH as TH
import           Language.C

import           Data.Comp.Trans ( runCompTrans, generateNameLists, getTypeParamVars )

import           Cubix.Language.Parametric.Syntax.Base
import           Cubix.Language.Parametric.Syntax.Functor

runCompTrans $ generateNameLists ''CTranslationUnit

cSigNames :: [TH.Name]
cSigNames :: [Name]
cSigNames = [Name]
newASTTypes [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [''PairF, ''TripleF, ''ListF, ''MaybeF, ''EitherF, ''BoolF, ''IntF, ''IntegerF, ''UnitF]

makeSubsts :: Q (Map TH.Name Type)
makeSubsts :: Q (Map Name Type)
makeSubsts = do
  [Name]
vars <- CompTrans [Name] -> Q [Name]
forall a. CompTrans a -> Q a
runCompTrans (CompTrans [Name] -> Q [Name]) -> CompTrans [Name] -> Q [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> CompTrans [Name]
getTypeParamVars [Name]
origASTTypes
  let substs :: Map Name Type
substs = [(Name, Type)] -> Map Name Type
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Name] -> [Type] -> [(Name, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
vars (Type -> [Type]
forall a. a -> [a]
repeat (Type -> [Type]) -> Type -> [Type]
forall a b. (a -> b) -> a -> b
$ Int -> Type
TupleT 0))
  Info
inf <- Name -> Q Info
reify ''Flags
  TyConI (NewtypeD _ _ [KindedTV f :: Name
f StarT] _ _ _) <- Name -> Q Info
reify ''Flags
  Map Name Type -> Q (Map Name Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Name Type -> Q (Map Name Type))
-> Map Name Type -> Q (Map Name Type)
forall a b. (a -> b) -> a -> b
$ Name -> Type -> Map Name Type -> Map Name Type
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
f (Name -> Type
ConT ''CIntFlag) Map Name Type
substs
#endif