module Ivory.Compile.C.Gen.Const (makeTargetConst, makeTargetConstIf) where
import Data.Loc (noLoc)
import qualified Language.C.Syntax as C
makeTargetConstIf :: Bool -> C.Type -> C.Type
makeTargetConstIf c t = if c then makeTargetConst t else t
makeTargetConst :: C.Type -> C.Type
makeTargetConst = modifyTargetQuals (C.Tconst noLoc :)
modifyTargetQuals :: ([C.TypeQual] -> [C.TypeQual]) -> C.Type -> C.Type
modifyTargetQuals f typ@(C.Type _ decl _) = case decl of
C.Array _ _ decl1 _ -> go decl1
C.Ptr _ decl1 _ -> go decl1
_ -> typ
where
go decl1 = case decl1 of
C.DeclRoot{} ->
(modifyTypeDeclSpec . modifyDeclSpecQuals) f typ
C.Ptr{} ->
(modifyTypeDecl . modifyNestedDecl . modifyPtrQuals) f typ
_ ->
typ
modifyTargetQuals _ typ@C.AntiType{} = internalError typ
modifyDeclSpecQuals
:: ([C.TypeQual] -> [C.TypeQual]) -> C.DeclSpec -> C.DeclSpec
modifyDeclSpecQuals f declSpec = case declSpec of
C.DeclSpec storage quals spec loc -> C.DeclSpec storage (f quals) spec loc
C.AntiDeclSpec{} -> internalError declSpec
C.AntiTypeDeclSpec{} -> internalError declSpec
modifyNestedDecl :: (C.Decl -> C.Decl) -> C.Decl -> C.Decl
modifyNestedDecl f decl0 = case decl0 of
C.Array quals size decl loc -> C.Array quals size (f decl) loc
C.Ptr quals decl loc -> C.Ptr quals (f decl) loc
_ -> decl0
modifyPtrQuals :: ([C.TypeQual] -> [C.TypeQual]) -> C.Decl -> C.Decl
modifyPtrQuals f (C.Ptr quals decl loc) = C.Ptr (f quals) decl loc
modifyPtrQuals _ decl = decl
modifyTypeDecl :: (C.Decl -> C.Decl) -> C.Type -> C.Type
modifyTypeDecl f (C.Type declSpec decl loc) = C.Type declSpec (f decl) loc
modifyTypeDecl _ typ@C.AntiType{} = internalError typ
modifyTypeDeclSpec :: (C.DeclSpec -> C.DeclSpec) -> C.Type -> C.Type
modifyTypeDeclSpec f (C.Type declSpec decl loc) = C.Type (f declSpec) decl loc
modifyTypeDeclSpec _ typ@C.AntiType{} = internalError typ
internalError :: Show a => a -> b
internalError a = error $ "internal language-c-quote data leaked: " ++ show a