From 07dcabdbb3defa6901b423f383d07eb169a68732 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 29 Dec 2017 06:25:12 +0100 Subject: [PATCH] Delete leftover NotCPP file --- NotCPP/Declarations.hs | 188 ----------------------------------------- 1 file changed, 188 deletions(-) delete mode 100644 NotCPP/Declarations.hs diff --git a/NotCPP/Declarations.hs b/NotCPP/Declarations.hs deleted file mode 100644 index e8844d1..0000000 --- a/NotCPP/Declarations.hs +++ /dev/null @@ -1,188 +0,0 @@ --- ghc-mod: Happy Haskell Hacking --- Copyright (C) 2015 Daniel Gröber --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU Affero General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU Affero General Public License for more details. --- --- You should have received a copy of the GNU Affero General Public License --- along with this program. If not, see . - -{-# OPTIONS_GHC -fno-warn-unused-imports #-} -{-# LANGUAGE CPP #-} --- Using CPP so you don't have to :) -module NotCPP.Declarations where - -import Control.Arrow -import Control.Applicative -import Data.Maybe -import Language.Haskell.TH.Syntax - -import NotCPP.LookupValueName - -nT :: Monad m => String -> m Type -cT :: Monad m => String -> m Type -nE :: Monad m => String -> m Exp -nP :: Monad m => String -> m Pat - -nT str = return $ VarT (mkName str) -cT str = return $ ConT (mkName str) -nE str = return $ VarE (mkName str) -nP str = return $ VarP (mkName str) -recUpdE' :: Q Exp -> Name -> Exp -> Q Exp -recUpdE' ex name assign = do - RecUpdE <$> ex <*> pure [(name, assign)] - -lookupName' :: (NameSpace, String) -> Q (Maybe Name) -lookupName' (VarName, n) = lookupValueName n -lookupName' (DataName, n) = lookupValueName n -lookupName' (TcClsName, n) = lookupTypeName n - --- Does this even make sense? -ifelseD :: Q [Dec] -> Q [Dec] -> Q [Dec] -ifelseD if_decls' else_decls = do - if_decls <- if_decls' - alreadyDefined <- definedNames (boundNames `concatMap` if_decls) - case alreadyDefined of - [] -> if_decls' - _ -> else_decls - -ifdefelseD, ifelsedefD :: String -> Q [Dec] -> Q [Dec] -> Q [Dec] -ifelsedefD = ifdefelseD -ifdefelseD ident if_decls else_decls = do - exists <- isJust <$> lookupValueName ident - if exists - then if_decls - else else_decls - -ifdefD :: String -> Q [Dec] -> Q [Dec] -ifdefD ident decls = ifdefelseD ident decls (return []) - -ifndefD :: String -> Q [Dec] -> Q [Dec] -ifndefD ident decls = ifdefelseD ident (return []) decls - --- | Each of the given declarations is only spliced if the identifier it defines --- is not defined yet. --- --- For example: --- --- @$(ifD [[d| someFunctionThatShouldExist x = x+1 |]]@ --- --- If @someFunctionThatShouldExist@ doesn't actually exist the definition given --- in the splice will be the result of the splice otherwise nothing will be --- spliced. --- --- Currently this only works for function declarations but it can be easily --- extended to other kinds of declarations. -ifD :: Q [Dec] -> Q [Dec] -ifD decls' = do - decls <- decls' - concat <$> flip mapM decls (\decl -> do - alreadyDefined <- definedNames (boundNames decl) - case alreadyDefined of - [] -> return [decl] - _ -> return []) - -definedNames :: [(NameSpace, Name)] -> Q [Name] -definedNames ns = catMaybes <$> (lookupName' . second nameBase) `mapM` ns - -boundNames :: Dec -> [(NameSpace, Name)] -boundNames decl = - case decl of - SigD n _ -> [(VarName, n)] - FunD n _cls -> [(VarName, n)] -#if __GLASGOW_HASKELL__ >= 706 - InfixD _ n -> [(VarName, n)] -#endif - ValD p _ _ -> map ((,) VarName) $ patNames p - - TySynD n _ _ -> [(TcClsName, n)] - ClassD _ n _ _ _ -> [(TcClsName, n)] - -#if __GLASGOW_HASKELL__ >= 800 - DataD _ n _ _ ctors _ -> -#else - DataD _ n _ ctors _ -> -#endif - [(TcClsName, n)] ++ map ((,) TcClsName) (conNames `concatMap` ctors) - -#if __GLASGOW_HASKELL__ >= 800 - NewtypeD _ n _ _ ctor _ -> -#else - NewtypeD _ n _ ctor _ -> -#endif - [(TcClsName, n)] ++ map ((,) TcClsName) (conNames ctor) - -#if __GLASGOW_HASKELL__ >= 800 - DataInstD _ _n _ _ ctors _ -> -#else - DataInstD _ _n _ ctors _ -> -#endif - map ((,) TcClsName) (conNames `concatMap` ctors) - -#if __GLASGOW_HASKELL__ >= 800 - NewtypeInstD _ _n _ _ ctor _ -> -#else - NewtypeInstD _ _n _ ctor _ -> -#endif - map ((,) TcClsName) (conNames ctor) - - InstanceD {} -> -- _ _ty _ - error "notcpp: Instance declarations are not supported yet" - ForeignD _ -> - error "notcpp: Foreign declarations are not supported yet" - PragmaD _pragma -> error "notcpp: pragmas are not supported yet" - -#if __GLASGOW_HASKELL__ >= 708 - TySynInstD _n _ -> error "notcpp: TySynInstD not supported yet" -#else - TySynInstD _n _ _ -> error "notcpp: TySynInstD not supported yet" -#endif - -#if __GLASGOW_HASKELL__ >= 708 - RoleAnnotD _n _ -> error "notcpp: RoleAnnotD not supported yet" -#endif - -#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 800 - FamilyD _ n _ _ -> [(TcClsName, n)] -#elif __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800 - ClosedTypeFamilyD n _ _ _ -> [(TcClsName, n)] -#else - OpenTypeFamilyD (TypeFamilyHead n _ _ _) -> [(TcClsName, n)] - ClosedTypeFamilyD (TypeFamilyHead n _ _ _) _ -> [(TcClsName, n)] - -#endif - -conNames :: Con -> [Name] -conNames con = - case con of - NormalC n _ -> [n] - RecC n _ -> [n] - InfixC _ n _ -> [n] - ForallC _ _ c -> conNames c - -patNames :: Pat -> [Name] -patNames p'' = - case p'' of - LitP _ -> [] - VarP n -> [n] - TupP ps -> patNames `concatMap` ps - UnboxedTupP ps -> patNames `concatMap` ps - ConP _ ps -> patNames `concatMap` ps - InfixP p _ p' -> patNames `concatMap` [p,p'] - UInfixP p _ p' -> patNames `concatMap` [p,p'] - ParensP p -> patNames p - TildeP p -> patNames p - BangP p -> patNames p - AsP n p -> n:(patNames p) - WildP -> [] - RecP _ fps -> patNames `concatMap` map snd fps - ListP ps -> patNames `concatMap` ps - SigP p _ -> patNames p - ViewP _ p -> patNames p