tock-mirror/pregen/GenNavAST.hs

82 lines
3.0 KiB
Haskell

{-
Tock: a compiler for parallel languages
Copyright (C) 2008 University of Kent
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation, either version 2 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
General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program. If not, see <http://www.gnu.org/licenses/>.
-}
-- | Utilities for metaprogramming.
module GenNavAST where
import Data.List
import System.Environment
import qualified Data.Set as Set
import Data.Generics.Polyplate.GenInstances
import qualified AST
import qualified CompState
import qualified Errors
main :: IO ()
main = do
[instFileName, spineInstFileName] <- getArgs
writeInstancesToSep GenWithOverlapped GenClassPerType
[ genInstance (undefined :: AST.AST)
, genInstance (undefined :: CompState.CompState)
-- All the maps that are in CompState:
, genMapInstance (undefined :: String) (undefined :: CompState.PreprocDef)
, genMapInstance (undefined :: String) (undefined :: AST.NameDef)
, genMapInstance (undefined :: String) (undefined :: String)
, genMapInstance (undefined :: String) (undefined :: [AST.Type])
, genMapInstance (undefined :: String) (undefined :: [AST.Actual])
, genMapInstance (undefined :: String) (undefined :: Set.Set CompState.NameAttr)
-- All the sets that are in CompState:
, genSetInstance (undefined :: Errors.WarningType)
, genSetInstance (undefined :: String)
, genSetInstance (undefined :: AST.Name)
, genSetInstance (undefined :: CompState.NameAttr)
]
(header False (findModuleName instFileName), header True (findModuleName spineInstFileName))
(instFileName, spineInstFileName)
where
findModuleName moduleFileName
| not (".hs" `isSuffixOf` moduleFileName)
= error "file name does not end in .hs"
| otherwise
= (reverse . takeWhile (/= '/') . drop 3 . reverse) $ moduleFileName
header isSpine moduleName =
["{-# OPTIONS_GHC -fallow-overlapping-instances -fwarn-overlapping-patterns -fwarn-unused-matches -fwarn-unused-binds #-}"
,"-- | This module is auto-generated by Polyplate. DO NOT EDIT."
,"module " ++ moduleName ++ " () where"
,""
,"import Data.Generics.Polyplate"
,if isSpine then "" else "import Data.Generics.Polyplate.Route"
,""
,"import Data.Map (Map)"
,"import qualified Data.Map as Map"
,"import Data.Maybe"
,"import Data.Set (Set)"
,"import qualified Data.Set as Set"
,if isSpine then "import Data.Tree" else ""
,""
,"import qualified AST"
,"import qualified CompState"
,"import qualified Errors"
,"import qualified Metadata"
,""
]