Getting examples working with GHC generics.

TODO.md

@@ -26,6 +26,7 @@ TODO
 
 * Make SubT from Forest into Tree(?)  More natural and allows to index the head.
 
+
 Won't Do / Can't Do
 -----------------------------------------------
 * Use shrink instances as default for base types.

examples/LambdaCalc.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 -- Copied from <http://augustss.blogspot.com/2007/10/simpler-easier-in-recent-paper-simply.html>
 
@@ -8,6 +9,8 @@ import Data.List
 import Data.Tree
 import Data.Data
 import Control.Monad
+import GHC.Generics
+
 import Test.QuickCheck
 
 import Test.SmartCheck
@@ -18,7 +21,7 @@ data Expr
         = Var Sym
         | App Expr Expr
         | Lam Sym Expr
-        deriving (Eq, Read, Show, Data, Typeable)
+        deriving (Eq, Read, Show, Data, Typeable, Generic)
 
 freeVars :: Expr -> [Sym]
 freeVars (Var s) = [s]
@@ -32,7 +35,6 @@ subst v x b = sub b
         sub (Lam i e) =
             if v == i then
                 Lam i e
-            -- Wrong!
             else if i `elem` fvx then
                 let i' = cloneSym e i
                     e' = substVar i i' e
@@ -76,27 +78,13 @@ test0 = betaEq (app2 plus one two) three
 
 ---------------------------------------------------------------------------------
 
-instance SubTypes Expr where
-  subTypes (Var _)     = []
-  subTypes (App e0 e1) = [ Node (subT e0) (subTypes e0)
-                         , Node (subT e1) (subTypes e1)
-                         ]
-  subTypes (Lam v e) = [ Node (subT v) []
-                       , Node (subT e) (subTypes e) 
-                       ]
-
--- instance (SubTypes a, Data a, SubTypes b, Data b) => SubTypes (a,b) where
---   subTypes (a,b) = subTypes a ++ subTypes b
-
-instance SubTypes Pr where
-  subTypes (Pr a b) = [ Node (subT a) (subTypes a)
-                      , Node (subT b) (subTypes b)
-                      ]
+instance SubTypes Expr
+instance SubTypes Pr
 
 ---------------------------------------------------------------------------------
 
 data Pr = Pr Expr Expr
-  deriving (Read, Show, Data, Typeable)
+  deriving (Read, Show, Data, Typeable, Generic)
 
 instance Arbitrary Expr where
   arbitrary = sized mkE

smartcheck.cabal

@@ -28,7 +28,8 @@ Library
                      mtl >= 2.0.1.0,
                      random >= 1.0.1.1,
                      uniplate >= 1.6.6,
-                     containers >= 0.4
+                     containers >= 0.4,
+                     ghc-prim
 
   default-language:  Haskell2010
 

src/Test/SmartCheck/Types.hs

@@ -145,32 +145,32 @@ instance (Show a, Data a, Q.Arbitrary a, SubTypes a) => GST (K1 i a) where
 ---------------------------------------------------------------------------------
 
 instance SubTypes Bool    where 
-  subTypes _ = []
-  baseType _ = True
-  allSubTypes = subTypes
+  subTypes _    = []
+  baseType _    = True
+  allSubTypes _ = []
 instance SubTypes Int     where 
-  subTypes _ = []
-  baseType _ = True
-  allSubTypes = subTypes
+  subTypes _    = []
+  baseType _    = True
+  allSubTypes _ = []
 instance SubTypes Integer where 
-  subTypes _ = []
-  baseType _ = True
-  allSubTypes = subTypes
+  subTypes _    = []
+  baseType _    = True
+  allSubTypes _ = []
 instance SubTypes Char    where 
-  subTypes _ = []
-  baseType _ = True
-  allSubTypes = subTypes
+  subTypes _    = []
+  baseType _    = True
+  allSubTypes _ = []
 instance SubTypes String where 
-  subTypes _ = []
-  baseType _ = True
-  allSubTypes = subTypes
+  subTypes _    = []
+  baseType _    = True
+  allSubTypes _ = []
 
 -- mkSubT :: (Data a, Q.Arbitrary a, Show a) => a -> Forest SubT
 -- mkSubT i = [ Node (subT i) [] ]
 
 instance (Q.Arbitrary a, SubTypes a) => SubTypes [a] where 
   subTypes   = concatMap subTypes
   baseType _ = False
-  allSubTypes = subTypes
+  allSubTypes = concatMap allSubTypes
 
 ---------------------------------------------------------------------------------