Added the GenTagAST utility that generates the TagAST module full of mSeq functions for easy pattern-matching

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 <http://www.gnu.org/licenses/>.
+-}
+
+-- | 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)

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: