From 8b991806e78ba7121c465befd3dbcb73b22660a1 Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Thu, 8 May 2008 16:07:46 +0000
Subject: [PATCH] Clean up GenTagAST so that it just has one list of types.

This meant having it figure out which types are parameterised and
what their prefixes should be automatically. (More work for Typeable.)
---
 GenTagAST.hs | 95 +++++++++++++++++++++++++++++-----------------------
 1 file changed, 54 insertions(+), 41 deletions(-)

diff --git a/GenTagAST.hs b/GenTagAST.hs
index 9c5e6f8..3d53f31 100644
--- a/GenTagAST.hs
+++ b/GenTagAST.hs
@@ -22,6 +22,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- (to stdout).
 module GenTagAST where
 
+import Data.Char
 import Data.Generics
 import Data.List (intersperse)
 
@@ -102,52 +103,64 @@ consParamsFor x = map consParamsFor' (dataTypeConstrs $ dataTypeOf x)
         cons :: [String]
         cons = gmapQ (show . typeOf) (fromConstr con :: a)
 
-items :: [(Int, String)]
+items :: [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.Subscript)
- ,consFor (u :: A.Type)
- ,consFor (u :: A.Variable)
- ,consFor (u :: A.Variant)
- ]
- where
-   u = undefined
-
-struct :: [String]
-struct = concat 
- [consP "P" (undefined :: A.Structured A.Process)
- ,consP "O" (undefined :: A.Structured A.Option)
- ,consP "C" (undefined :: A.Structured A.Choice)
- ,consP "V" (undefined :: A.Structured A.Variant)
- ,consP "A" (undefined :: A.Structured A.Alternative)
- ,consP "EL" (undefined :: A.Structured A.ExpressionList)
- ,consP "AST" (undefined :: A.Structured ())
- ]
+    [ gen (u :: A.Actual)
+    , gen (u :: A.Alternative)
+    , gen (u :: A.ArrayConstr)
+    , gen (u :: A.ArrayElem)
+    , gen (u :: A.Choice)
+    , gen (u :: A.Expression)
+    , gen (u :: A.ExpressionList)
+    , gen (u :: A.Formal)
+    , gen (u :: A.InputItem)
+    , gen (u :: A.InputMode)
+    , gen (u :: A.LiteralRepr)
+    , gen (u :: A.OutputItem)
+    , gen (u :: A.Option)
+    , gen (u :: A.Process)
+    , gen (u :: A.Replicator)
+    , gen (u :: A.Specification)
+    , gen (u :: A.SpecType)
+    , gen (u :: A.Subscript)
+    , gen (u :: A.Type)
+    , gen (u :: A.Variable)
+    , gen (u :: A.Variant)
+    , gen (u :: A.Structured A.Process)
+    , gen (u :: A.Structured A.Option)
+    , gen (u :: A.Structured A.Choice)
+    , gen (u :: A.Structured A.Variant)
+    , gen (u :: A.Structured A.Alternative)
+    , gen (u :: A.Structured A.ExpressionList)
+    , gen (u :: A.Structured ())
+    ]
   where
-    consP prefix w = concatMap (genItem' prefix (show $ typeOf w)) $ consParamsFor w
+    u = undefined
 
+    gen w
+        = case typeRepArgs rep of
+            -- A parameterised type (e.g. Structured Process).
+            [arg] -> genParam arg w
+            -- A normal type (e.g. Process).
+            _ -> genNormal w
+      where
+        rep = typeOf w
+
+    genParam arg w
+        = concatMap (genItem' prefix (show $ typeOf w)) $ consParamsFor w
+      where
+        argS = show arg
+        prefix
+          | argS == "()" = "AST"
+          | otherwise    = filter isUpper (drop (1 + index '.' argS) argS)
+
+        index c s = length (takeWhile (/= c) s)
+
+    genNormal w
+       = concatMap genItem (filterInvalid $ consFor w)
 
 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) ++ struct
+main = putStr $ unlines $ genHeader ++ items