diff --git a/GenTagAST.hs b/GenTagAST.hs new file mode 100644 index 0000000..6ba1818 --- /dev/null +++ b/GenTagAST.hs @@ -0,0 +1,106 @@ +{- +Tock: a compiler for parallel languages +Copyright (C) 2007 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 . +-} + +-- | Generates the TagAST module. Template Haskell was a bit too heavyweight +-- for this. Uses Data.Generics to pick out all the constructors for the +-- given types, work out their "arity" and write out the TagAST module +-- (to stdout). +module GenTagAST where + +import Data.Generics + +import qualified AST as A + +genHeader :: [String] +genHeader = [ + "-- | Contains lots of helper functions for matching AST elements." + ,"-- For most A.Blah items, there is an mBlah and mBlah' definition here." + ,"-- mBlah is without the Meta tag pattern (DontCare is used), mBlah' is with a Meta tag pattern." + ,"--" + ,"-- NOTE: This file is auto-generated by the GenTagAST program, and should not be edited directly." + ,"module TagAST where" + ,"import Data.Generics" + ,"" + ,"import qualified AST as A" + ,"import Pattern" + ,"import TreeUtil" + -- Could probably auto-generate these, too: + ,"type F0 = Pattern" + ,"type F1 = (Data a0) => a0 -> Pattern" + ,"type F2 = (Data a0, Data a1) => a0 -> a1 -> Pattern" + ,"type F3 = (Data a0, Data a1, Data a2) => a0 -> a1 -> a2 -> Pattern" + ,"type F4 = (Data a0, Data a1, Data a2, Data a3) => a0 -> a1 -> a2 -> a3 -> Pattern" + ,"type F5 = (Data a0, Data a1, Data a2, Data a3, Data a4) => a0 -> a1 -> a2 -> a3 -> a4 -> Pattern" + ,"type F6 = (Data a0, Data a1, Data a2, Data a3, Data a4, Data a5) => a0 -> a1 -> a2 -> a3 -> a4 -> a5 -> Pattern" + ,"" + ] + +genItem :: (Int, String) -> [String] +genItem (num, name) + = [mname ++ "' :: F" ++ n + ,mname ++ "' = tag" ++ n ++ " A." ++ name + ,mname ++ " :: F" ++ show (num - 1) + ,mname ++ " = " ++ mname ++ "' DontCare"] + where + n = show num + mname = "m" ++ name + +consFor :: forall a. Data a => a -> [(Int, String)] +consFor x = map consFor' (dataTypeConstrs $ dataTypeOf x) + where + -- The way I work out how many arguments a constructor takes is crazy, but + -- I can't see a better way given the Data.Generics API + consFor' :: Constr -> (Int, String) + consFor' con = (length (gmapQ (const undefined) (fromConstr con :: a)), showConstr con) + +items :: [(Int, String)] +items = concat + [consFor (u :: A.Actual) + ,consFor (u :: A.Alternative) + ,consFor (u :: A.ArrayConstr) + ,consFor (u :: A.ArrayElem) + ,consFor (u :: A.Choice) + ,consFor (u :: A.Expression) + ,consFor (u :: A.ExpressionList) + ,consFor (u :: A.Formal) + ,consFor (u :: A.InputItem) + ,consFor (u :: A.InputMode) + ,consFor (u :: A.LiteralRepr) + ,consFor (u :: A.OutputItem) + ,consFor (u :: A.Option) + ,consFor (u :: A.Process) + ,consFor (u :: A.Replicator) + ,consFor (u :: A.Specification) + ,consFor (u :: A.SpecType) + ,consFor (u :: A.Structured) + ,consFor (u :: A.Subscript) + ,consFor (u :: A.Type) + ,consFor (u :: A.Variable) + ,consFor (u :: A.Variant) + ] + where + u = undefined + +filterInvalid :: [(Int, a)] -> [(Int, a)] +filterInvalid = filter (\(n,_) -> n > 0) + +joinLines :: [String] -> String +joinLines xs = concat [x ++ "\n" | x <- xs] + +main :: IO () +main = putStr $ joinLines $ genHeader ++ concatMap genItem (filterInvalid items) diff --git a/Makefile.am b/Makefile.am index edbc734..a6e5b24 100644 --- a/Makefile.am +++ b/Makefile.am @@ -15,6 +15,9 @@ tocktest$(EXEEXT): $(BUILT_SOURCES) $(tocktest_SOURCES) @MKDIR_P@ obj ghc $(GHC_OPTS) -o tocktest$(EXEEXT) -main-is TestMain --make TestMain -odir obj -hidir obj +GenTagAST$(EXEEXT): $(GenTagAST_SOURCES) + @MKDIR_P@ obj + ghc $(GHC_OPTS) -o GenTagAST$(EXEEXT) -main-is GenTagAST --make GenTagAST -odir obj -hidir obj TOCK_CFLAGS = @gnu89_inline@ -O2 -g -Wall `kroc --cflags` `kroc --ccincpath` @@ -42,7 +45,10 @@ frontends/LexOccam.hs: frontends/LexOccam.x frontends/LexRain.hs: frontends/LexRain.x alex frontends/LexRain.x -BUILT_SOURCES = frontends/LexOccam.hs frontends/LexRain.hs CompilerCommands.hs +common/TagAST.hs: GenTagAST$(EXEEXT) + ./GenTagAST$(EXEEXT) > common/TagAST.hs + +BUILT_SOURCES = frontends/LexOccam.hs frontends/LexRain.hs CompilerCommands.hs common/TagAST.hs CLEANFILES = $(BUILT_SOURCES) tock_SOURCES_hs = transformations/SimplifyExprs.hs transformations/SimplifyTypes.hs @@ -54,6 +60,7 @@ tock_SOURCES_hs += common/Pass.hs common/TreeUtil.hs common/Intrinsics.hs common tock_SOURCES_hs += common/Pattern.hs common/Errors.hs common/ShowCode.hs common/PrettyShow.hs tock_SOURCES_hs += common/EvalConstants.hs common/Utils.hs common/CompState.hs common/Types.hs tock_SOURCES_hs += common/Metadata.hs common/AST.hs common/FlowGraph.hs common/FlowAlgorithms.hs +tock_SOURCES_hs += common/TagAST.hs tock_SOURCES_hs += backends/TLP.hs backends/BackendPasses.hs backends/AnalyseAsm.hs tock_SOURCES_hs += backends/GenerateC.hs backends/GenerateCPPCSP.hs tock_SOURCES_hs += Main.hs @@ -68,9 +75,11 @@ tocktest_SOURCES += common/TestUtil.hs common/CommonTest.hs common/FlowGraphTest tocktest_SOURCES += frontends/ParseRainTest.hs frontends/RainPassesTest.hs frontends/RainTypesTest.hs tocktest_SOURCES += TestMain.hs +GenTagAST_SOURCES = GenTagAST.hs + #The programs to actually build: bin_PROGRAMS = tock -noinst_PROGRAMS = tocktest +noinst_PROGRAMS = tocktest GenTagAST clean-local: