Make GenOrdAST and GenTagAST use Typeable.

This simplifies the code quite a bit, since Typeable knows about
parameters to types; you don't have to do magic to handle
Structured Thingy any more.

GenOrdAST.hs

@@ -53,7 +53,7 @@ ordFor' typeName x = process $ map processConstr $ dataTypeConstrs $ dataTypeOf
     process :: [(String, String, String, [String])] -> [String]
     process [] = []
     process items =
-      ["instance Ord " ++ typeName ++ " where"]
+      ["instance Ord (" ++ typeName ++ ") where"]
       ++ concat [ [ "  compare (" ++ name ++ headL ++ ") (" ++ name ++ headR ++ ") = " ++
                     --Shortcut:
                     if null comparisons then "EQ" else
@@ -100,21 +100,20 @@ items = concat
  ,ordFor (u :: A.Replicator)
  ,ordFor (u :: A.Specification)
  ,ordFor (u :: A.SpecType)
- --TODO define a new function for doing a parameterised Ord
- ,ordFor' "(AST.Structured AST.Process)" (u :: A.Structured A.Process)
- ,ordFor' "(AST.Structured AST.Choice)" (u :: A.Structured A.Choice)
- ,ordFor' "(AST.Structured AST.Option)" (u :: A.Structured A.Option)
- ,ordFor' "(AST.Structured AST.Alternative)" (u :: A.Structured A.Alternative)
- ,ordFor' "(AST.Structured AST.Variant)" (u :: A.Structured A.Variant)
- ,ordFor' "(AST.Structured AST.ExpressionList)" (u :: A.Structured A.ExpressionList)
- ,ordFor' "(AST.Structured ())" (u :: A.Structured ())
+ ,ordFor (u :: A.Structured A.Process)
+ ,ordFor (u :: A.Structured A.Choice)
+ ,ordFor (u :: A.Structured A.Option)
+ ,ordFor (u :: A.Structured A.Alternative)
+ ,ordFor (u :: A.Structured A.Variant)
+ ,ordFor (u :: A.Structured A.ExpressionList)
+ ,ordFor (u :: A.Structured ())
  ,ordFor (u :: A.Subscript)
  ,ordFor (u :: A.Type)
  ,ordFor (u :: A.Variable)
  ,ordFor (u :: A.Variant)
  ]
  where
-   ordFor x = ordFor' (dataTypeName $ dataTypeOf x) x
+   ordFor x = ordFor' (show $ typeOf x) x
  
    u = undefined
 

GenTagAST.hs

@@ -30,7 +30,7 @@ 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."
+ ,"-- For most AST.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."
@@ -38,7 +38,6 @@ genHeader = [
  ,"import Data.Generics"
  ,""
  ,"import qualified AST"
- ,"import qualified AST as A"
  ,"import qualified Metadata"
  ,"import Pattern"
  ,"import TreeUtils"
@@ -63,7 +62,7 @@ genHeader = [
 genItem :: (Int, String) -> [String]
 genItem (num, name)
   = [mname ++ "' :: F" ++ n
-    ,mname ++ "' = tag" ++ n ++ " A." ++ name
+    ,mname ++ "' = tag" ++ n ++ " AST." ++ name
     ,mname ++ " :: F" ++ show (num - 1)
     ,mname ++ " = " ++ mname ++ "' DontCare"]
   where
@@ -73,19 +72,14 @@ genItem (num, name)
 genItem' :: String -> String -> (Int, String, [String]) -> [String]
 genItem' suffix typeName (num, name, paramTypes)
   = [mname ++ "' :: F" ++ n ++ typeSuffix
-    ,mname ++ "' = tag" ++ n ++ " (A." ++ name ++ " :: " ++ params ++ ")"
+    ,mname ++ "' = tag" ++ n ++ " (AST." ++ name ++ " :: " ++ params ++ ")"
     ,mname ++ " :: F" ++ show (num - 1) ++ typeSuffix
     ,mname ++ " = " ++ mname ++ "' DontCare"]
   where
---    typeSuffix = "' (" ++ typeName ++ ")"
     typeSuffix = ""
-    
-    params = concat $ intersperse " -> " $
-      [case p of
-         "AST.Structured" -> typeName
-         "[AST.Structured]" -> "[" ++ typeName ++ "]"
-         _ -> p | p <- paramTypes] ++ [typeName]
-  
+
+    params = concat $ intersperse " -> " $ paramTypes ++ [typeName]
+
     n = show num
     mname = "m" ++ name ++ suffix
 
@@ -106,16 +100,7 @@ consParamsFor x = map consParamsFor' (dataTypeConstrs $ dataTypeOf x)
     consParamsFor' con = (length cons, showConstr con, cons)
       where
         cons :: [String]
-        cons = gmapQ showDataType (fromConstr con :: a)
-        
-        -- Hack to handle various types:
-        showDataType :: Data b => b -> String
-        showDataType y = case n of
-          "Prelude.[]" -> "[" ++ (dataTypeName $ dataTypeOf x) ++ "]"
-          "Prelude.()" -> "()"
-          _ -> n
-          where
-            n = dataTypeName $ dataTypeOf y
+        cons = gmapQ (show . typeOf) (fromConstr con :: a)
 
 items :: [(Int, String)]
 items = concat
@@ -146,14 +131,16 @@ items = concat
 
 struct :: [String]
 struct = concat 
- [concatMap (genItem' "P" "A.Structured A.Process") $ consParamsFor (undefined :: A.Structured A.Process)
- ,concatMap (genItem' "O" "A.Structured A.Option") $ consParamsFor (undefined :: A.Structured A.Option)
- ,concatMap (genItem' "C" "A.Structured A.Choice") $ consParamsFor (undefined :: A.Structured A.Choice)
- ,concatMap (genItem' "V" "A.Structured A.Variant") $ consParamsFor (undefined :: A.Structured A.Variant)
- ,concatMap (genItem' "A" "A.Structured A.Alternative") $ consParamsFor (undefined :: A.Structured A.Alternative)
- ,concatMap (genItem' "EL" "A.Structured A.ExpressionList") $ consParamsFor (undefined :: A.Structured A.ExpressionList)
- ,concatMap (genItem' "AST" "A.Structured ()") $ consParamsFor (undefined :: A.Structured ())
+ [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 ())
  ]
+  where
+    consP prefix w = concatMap (genItem' prefix (show $ typeOf w)) $ consParamsFor w
 
 
 filterInvalid :: [(Int, a)] -> [(Int, a)]

Makefile.am

@@ -1,4 +1,5 @@
 GHC_OPTS = \
+	-prof -auto-all \
 	-fglasgow-exts \
 	-fwarn-deprecations \
 	-fwarn-duplicate-exports \