{-
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 TreeUtils"
 -- 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)