Allowed the different instances for the Polyplate classes to be written out to separate files (to help GHC's memory usage down a bit)

Makefile.am

@@ -111,7 +111,10 @@ config/Paths.hs: config/Paths.hs.in
 	  | sed -e 's,@@tocklibdir@@,$(TOCKLIBDIR),g' >config/Paths.hs
 
 data/NavAST.hs: GenNavAST$(EXEEXT)
-	./GenNavAST$(EXEEXT) > data/NavAST.hs
+	./GenNavAST$(EXEEXT) data/NavAST.hs data/NavASTSpine.hs
+
+data/NavASTSpine.hs: GenNavAST$(EXEEXT)
+	./GenNavAST$(EXEEXT) data/NavAST.hs data/NavASTSpine.hs
 
 data/OrdAST.hs: GenOrdAST$(EXEEXT)
 	./GenOrdAST$(EXEEXT) > data/OrdAST.hs
@@ -124,6 +127,7 @@ config_sources += config/Paths.hs
 config_sources += config/TypeSizes.hs
 
 BUILT_SOURCES = data/NavAST.hs
+BUILT_SOURCES += data/NavASTSpine.hs
 BUILT_SOURCES += data/OrdAST.hs
 BUILT_SOURCES += data/TagAST.hs
 BUILT_SOURCES += frontends/LexOccam.hs

polyplate/Data/Generics/Polyplate/GenInstances.hs

@@ -19,7 +19,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 module Data.Generics.Polyplate.GenInstances
   (GenOverlappedOption(..), GenClassOption(..),
    GenInstance, genInstance, genMapInstance, genSetInstance, genInstances,
-   writeInstances, writeInstancesTo) where
+   writeInstances, writeInstancesTo, writeInstancesToSep) where
 
 import Control.Monad.State
 import Data.Char
@@ -597,28 +597,40 @@ spineInstancesFrom genOverlapped genClass boxes w
 
 -- | Generates all the given instances (eliminating any duplicates)
 -- with the given options.
-genInstances :: GenOverlappedOption -> GenClassOption -> [GenInstance] -> IO [String]
+genInstances :: GenOverlappedOption -> GenClassOption -> [GenInstance] ->
+  IO ([String], [String])
 genInstances op1 op2 insts
   =  do typeMap <- flip execStateT Map.empty (sequence [g | GenInstance g <- insts])
-        liftM concat $ sequence [liftM2 (++)
+        let (inst, spineInst) = unzip [
-                                   (instancesFrom op1 op2 (justBoxes typeMap) w)
+                                   (instancesFrom op1 op2 (justBoxes typeMap) w
-                                   (spineInstancesFrom op1 op2 (justBoxes typeMap) w)
+                                   ,spineInstancesFrom op1 op2 (justBoxes typeMap) w)
                                 | DataBox w <- map witness $ justBoxes typeMap]
-
+        inst' <- sequence inst
+        spineInst' <- sequence spineInst
+        return (concat inst', concat spineInst')
 -- | Generates the instances according to the options and writes it to stdout with
 -- the given header.
 writeInstances :: GenOverlappedOption -> GenClassOption -> [GenInstance] -> [String] -> IO ()
 writeInstances op1 op2 inst header
-  = do instLines <- genInstances op1 op2 inst
+  = do (instLines, spineInstLines) <- genInstances op1 op2 inst
-       putStr (unlines (header ++ instLines))
+       putStr (unlines (header ++ instLines ++ spineInstLines))
+
+-- | Generates the instances according to the options and writes it to stdout with
+-- the given header.
+writeInstancesToSep :: GenOverlappedOption -> GenClassOption -> [GenInstance] -> ([String],
+  [String]) -> (FilePath, FilePath) -> IO ()
+writeInstancesToSep op1 op2 inst (header1, header2) (fileName1, fileName2)
+  = do (instLines, spineInstLines) <- genInstances op1 op2 inst
+       writeFile fileName1 (unlines (header1 ++ instLines))
+       writeFile fileName2 (unlines (header2 ++ spineInstLines))
 
 -- | Generates the instances according to the options and writes it to a file with
 -- the given header.
 writeInstancesTo :: GenOverlappedOption -> GenClassOption -> [GenInstance] -> [String]
   -> FilePath -> IO ()
 writeInstancesTo op1 op2 inst header fileName
-  = do instLines <- genInstances op1 op2 inst
+  = do (instLines, spineInstLines) <- genInstances op1 op2 inst
-       writeFile fileName (unlines (header ++ instLines))
+       writeFile fileName (unlines (header ++ instLines ++ spineInstLines))
 
 
 --{{{ Various SYB-based functions that we don't export, for discovering contained types:

pregen/GenNavAST.hs

@@ -19,6 +19,9 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- | Utilities for metaprogramming.
 module GenNavAST where
 
+import Data.List
+import System.Environment
+
 import Data.Generics.Polyplate.GenInstances
 
 import qualified AST
@@ -148,8 +151,9 @@ instancesFrom w
             = "  transformM (_, rest) ops b v = transformM rest ops b v"
 
 main :: IO ()
-main
+main = do
-  = writeInstances GenWithoutOverlapped GenClassPerType
+  [instFileName, spineInstFileName] <- getArgs
+  writeInstancesToSep GenWithoutOverlapped GenClassPerType
       [ genInstance (undefined :: AST.AST)
       , genInstance (undefined :: CompState.CompState)
       -- All the maps that are in CompState:
@@ -163,9 +167,19 @@ main
       , genSetInstance (undefined :: String)
       , genSetInstance (undefined :: AST.Name)
       ]
+      (header False (findModuleName instFileName), header True (findModuleName spineInstFileName))
+      (instFileName, spineInstFileName)
+  where
+    findModuleName moduleFileName
+      | not (".hs" `isSuffixOf` moduleFileName)
+         = error "file name does not end in .hs"
+      | otherwise
+         = (reverse . takeWhile (/= '/') . drop 3 . reverse) $ moduleFileName
+    
+    header useTree moduleName =
       ["{-# OPTIONS_GHC -Werror -fwarn-overlapping-patterns -fwarn-unused-matches -fwarn-unused-binds -fwarn-incomplete-patterns #-}"
       ,"-- | This module is auto-generated by Polyplate.  DO NOT EDIT."
-      ,"module NavAST where"
+      ,"module " ++ moduleName ++ " where"
       ,""
       ,"import Data.Generics.Polyplate"
       ,""
@@ -173,6 +187,7 @@ main
       ,"import qualified Data.Map as Map"
       ,"import Data.Set (Set)"
       ,"import qualified Data.Set as Set"
+      ,if useTree then "import Data.Tree" else ""
       ,""
       ,"import qualified AST"
       ,"import qualified CompState"