Skip to content
Browse files

Getting examples working with GHC generics.

  • Loading branch information...
1 parent 4e68d1e commit 66f87cd530c22a4c964119547be0abdbb516c038 @leepike committed May 15, 2012
Showing with 26 additions and 36 deletions.
  1. +1 −0 TODO.md
  2. +7 −19 examples/LambdaCalc.hs
  3. +2 −1 smartcheck.cabal
  4. +16 −16 src/Test/SmartCheck/Types.hs
View
1 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.
View
26 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
View
3 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
View
32 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
---------------------------------------------------------------------------------

0 comments on commit 66f87cd

Please sign in to comment.
Something went wrong with that request. Please try again.