instant-generics (empty) → 0.1
raw patch · 12 files changed
+797/−0 lines, 12 filesdep +basesetup-changed
Dependencies added: base
Files
- LICENSE +28/−0
- Setup.hs +3/−0
- examples/GMapAssoc.hs +83/−0
- examples/Test.hs +148/−0
- instant-generics.cabal +46/−0
- src/Generics/Instant.hs +21/−0
- src/Generics/Instant/Base.hs +82/−0
- src/Generics/Instant/Functions.hs +23/−0
- src/Generics/Instant/Functions/Empty.hs +106/−0
- src/Generics/Instant/Functions/Eq.hs +63/−0
- src/Generics/Instant/Functions/Show.hs +85/−0
- src/Generics/Instant/Instances.hs +109/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2010 Universiteit Utrecht+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of Universiteit Utrecht nor the names of its contributors+ may be used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ examples/GMapAssoc.hs view
@@ -0,0 +1,83 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++module Main where++import Prelude hiding (lookup)+import Char (ord)+import qualified Data.Map as Map+import Control.Monad ((>=>))+import Generics.Instant++-- Generalized tries, as from http://www.haskell.org/haskellwiki/GHC/Type_families#An_associated_data_type_example++class Representable k => GMapKey k where+ data GMap k :: * -> *+ empty :: GMap k v+ lookup :: k -> GMap k v -> Maybe v+ insert :: k -> v -> GMap k v -> GMap k v++instance GMapKey Int where+ data GMap Int v = GMapInt (Map.Map Int v)+ empty = GMapInt Map.empty+ lookup k (GMapInt m) = Map.lookup k m+ insert k v (GMapInt m) = GMapInt (Map.insert k v m)++instance GMapKey Char where+ data GMap Char v = GMapChar (GMap Int v)+ empty = GMapChar empty+ lookup k (GMapChar m) = lookup (ord k) m+ insert k v (GMapChar m) = GMapChar (insert (ord k) v m)++instance GMapKey U where+ data GMap U v = GMapUnit (Maybe v)+ empty = GMapUnit Nothing+ lookup U (GMapUnit v) = v+ insert U v (GMapUnit _) = GMapUnit $ Just v+ +instance (GMapKey a, GMapKey b) => GMapKey (a :*: b) where+ data GMap (a :*: b) v = GMapProd (GMap a (GMap b v))+ empty = GMapProd empty+ lookup (a :*: b) (GMapProd gm) = lookup a gm >>= lookup b + insert (a :*: b) v (GMapProd gm) = + GMapProd $ case lookup a gm of+ Nothing -> insert a (insert b v empty) gm+ Just gm2 -> insert a (insert b v gm2 ) gm++instance (GMapKey a, GMapKey b) => GMapKey (a :+: b) where+ data GMap (a :+: b) v = GMapSum (GMap a v) (GMap b v)+ empty = GMapSum empty empty+ lookup (L a) (GMapSum gm1 _gm2) = lookup a gm1+ lookup (R b) (GMapSum _gm1 gm2 ) = lookup b gm2+ insert (L a) v (GMapSum gm1 gm2) = GMapSum (insert a v gm1) gm2+ insert (R a) v (GMapSum gm1 gm2) = GMapSum gm1 (insert a v gm2)++-- Uninteresting cases, but necessary+instance (GMapKey a) => GMapKey (C c a) where+ data GMap (C c a) v = GMapCon (GMap a v)+ empty = GMapCon empty+ lookup (C c) (GMapCon m) = lookup c m+ insert (C c) v (GMapCon m) = GMapCon (insert c v m)++instance (GMapKey a) => GMapKey (Var a) where+ data GMap (Var a) v = GMapVar (GMap a v)+ empty = GMapVar empty+ lookup (Var x) (GMapVar m) = lookup x m+ insert (Var x) v (GMapVar m) = GMapVar (insert x v m)++instance (GMapKey a) => GMapKey (Rec a) where+ data GMap (Rec a) v = GMapRec (GMap a v)+ empty = GMapRec empty+ lookup (Rec x) (GMapRec m) = lookup x m+ insert (Rec x) v (GMapRec m) = GMapRec (insert x v m)+ +-- Boilerplate code, but unavoidable (for now)+instance GMapKey k => GMapKey [k] where+ data GMap [k] v = GMapList (GMap (Rep [k]) v)+ + empty = GMapList empty+ lookup k (GMapList m) = lookup (from k) m+ insert k v (GMapList m) = GMapList (insert (from k) v m)++-- Example+t1 :: Maybe String+t1 = lookup [1,2,3] $ insert ([1..3] :: [Int]) "[1,2,3]" $ empty
+ examples/Test.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE EmptyDataDecls #-} + +import Generics.Instant +import Generics.Instant.Functions +import Prelude hiding (Eq, Show(..)) +import qualified Prelude as P (Show(..)) + +------------------------------------------------------------------------------- +-- Simple Datatype +------------------------------------------------------------------------------- + +-- Example datatype +data Exp = Const Int | Plus Exp Exp + +data Const +data Plus + +instance Constructor Const where conName _ = "Const" +instance Constructor Plus where conName _ = "Plus" + +-- Representable instance +instance Representable Exp where + type Rep Exp = C Const (Var Int) :+: C Plus (Rec Exp :*: Rec Exp) + + from (Const n) = L (C (Var n)) + from (Plus e e') = R (C (Rec e :*: Rec e')) + + to (L (C (Var n))) = Const n + to (R (C (Rec e :*: Rec e'))) = Plus e e' + +exp1 = Plus (Const 1) (Const 2) +exp2 = Plus exp1 (Const 3) + +instance Eq Exp where eq' = eq + +testExp1 :: (Bool, Bool) +testExp1 = (eq exp2 exp2, eq exp1 exp2) + +instance Empty Exp where empty' = empty + +testExp2 :: Exp +testExp2 = empty + +instance Show Exp where show' = show +instance P.Show Exp where show = show -- convenience + +testExp3 :: String +testExp3 = show exp2 +{- +instance Update Exp where update' = update +instance MapOn Int where mapOn = (+1) + +testExp4 :: Exp +testExp4 = update exp2 +-} +------------------------------------------------------------------------------- +-- Mutually recursive datatypes +------------------------------------------------------------------------------- + +data Decl = None | Seq Decl Decl | Assign String Expr + +data Expr = V String | Lam String Expr | App Expr Expr | Let Decl Expr + +data None +data Seq +data Assign +data V +data Lam +data App +data Let + +instance Constructor None where conName _ = "None" +instance Constructor Seq where conName _ = "Seq" +instance Constructor Assign where conName _ = "Assign" +instance Constructor V where conName _ = "V" +instance Constructor Lam where conName _ = "Lam" +instance Constructor App where conName _ = "App" +instance Constructor Let where conName _ = "Let" + +instance Representable Decl where + type Rep Decl = C None U + :+: C Seq (Rec Decl :*: Rec Decl) + :+: C Assign (Var String :*: Rec Expr) + + from None = L (C U) + from (Seq d1 d2) = R (L (C (Rec d1 :*: Rec d2))) + from (Assign v e) = R (R (C (Var v :*: Rec e))) + + to (L (C U)) = None + to (R (L (C (Rec d1 :*: Rec d2)))) = Seq d1 d2 + to (R (R (C (Var v :*: Rec e)))) = Assign v e + +instance Representable Expr where + type Rep Expr = C V (Var String) + :+: C Lam (Var String :*: Rec Expr) + :+: C App (Rec Expr :*: Rec Expr) + :+: C Let (Rec Decl :*: Rec Expr) + + from (V x) = L (C (Var x)) + from (Lam v e) = R (L (C (Var v :*: Rec e))) + from (App f e) = R (R (L (C (Rec f :*: Rec e)))) + from (Let d e) = R (R (R (C (Rec d :*: Rec e)))) + + to (L (C (Var x))) = V x + to (R (L (C (Var v :*: Rec e)))) = Lam v e + to (R (R (L (C (Rec f :*: Rec e))))) = App f e + to (R (R (R (C (Rec d :*: Rec e))))) = Let d e + +decls = Seq (Assign "x" (Lam "z" (V "z"))) (Assign "y" (V "x")) +expr = Let decls (App (V "x") (V "y")) + +instance Show Expr where show' = show +instance Show Decl where show' = show +instance P.Show Expr where show = show -- convenience +instance P.Show Decl where show = show -- convenience + +testAST1 :: String +testAST1 = show expr + +instance Empty Expr where empty' = empty +instance Empty Decl where empty' = empty + +testAST2 :: Expr +testAST2 = empty + +testAST3 :: Decl +testAST3 = empty + +instance Eq Expr where eq' = eq +instance Eq Decl where eq' = eq + +testAST4 :: Bool +testAST4 = eq expr expr +{- +instance Update Decl where update' = update +instance Update Expr where update' = update +instance MapOn [Char] where mapOn _ = "a" + +testAST5 :: Decl +testAST5 = update decls + +testAST6 :: Expr +testAST6 = update expr +-}
+ instant-generics.cabal view
@@ -0,0 +1,46 @@+category: Generics+copyright: (c) 2010 Universiteit Utrecht+name: instant-generics+version: 0.1+license: BSD3+license-file: LICENSE+author: Manuel Chakravarty, Gabriel Ditu, Roman Leshchinskiy,+ Jose Pedro Magalhaes+maintainer: generics@haskell.org+synopsis: Generic programming library with a sum of products view+description: ++ This is a generic programming library based on type classes and type families+ first described by Chakravarty et al. (see + <http://www.cse.unsw.edu.au/~chak/project/generics/>). The current release+ is a simplified version mostly to support the rewriting library described + in the paper:+ .+ * Thomas van Noort, Alexey Rodriguez Yakushev, Stefan Holdermans, + Johan Jeuring, Bastiaan Heeren, Jose Pedro Magalhaes.+ /A Lightweight Approach to Datatype-Generic Rewriting./+ Journal of Functional Programming, Special Issue on Generic Programming, + 2010.++stability: experimental+build-type: Simple+homepage: http://www.cs.uu.nl/wiki/GenericProgramming/InstantGenerics+cabal-version: >= 1.2.3+tested-with: GHC == 6.8.3, GHC == 6.10.4, GHC == 6.12.1+extra-source-files: examples/GMapAssoc.hs+ examples/Test.hs++library+ hs-source-dirs: src+ build-depends: base >= 3.0 && < 5+ exposed-modules: Generics.Instant,+ Generics.Instant.Base,+ Generics.Instant.Instances,+ Generics.Instant.Functions,+ Generics.Instant.Functions.Show,+ Generics.Instant.Functions.Empty,+ Generics.Instant.Functions.Eq+ extensions: FlexibleContexts, FlexibleInstances,+ TypeSynonymInstances, TypeFamilies, TypeOperators,+ OverlappingInstances+ ghc-options: -Wall
+ src/Generics/Instant.hs view
@@ -0,0 +1,21 @@+----------------------------------------------------------------------------- +-- | +-- Module : Generics.Instant +-- Copyright : (c) 2010, Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Top-level module which re-exports the basic combinators and the generic +-- instances for common datatypes. +-- +----------------------------------------------------------------------------- + +module Generics.Instant ( + module Generics.Instant.Base, + ) where + +import Generics.Instant.Base +import Generics.Instant.Instances ()
+ src/Generics/Instant/Base.hs view
@@ -0,0 +1,82 @@+ +----------------------------------------------------------------------------- +-- | +-- Module : Generics.Instant.Base +-- Copyright : (c) 2010, Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- This module defines the basic representation types and the conversion +-- functions 'to' and 'from'. A typical instance for a user-defined datatype +-- would be: +-- +-- > -- Example datatype +-- > data Exp = Const Int | Plus Exp Exp +-- > +-- > -- Auxiliary datatypes for constructor representations +-- > data Const +-- > data Plus +-- > +-- > instance Constructor Const where conName _ = "Const" +-- > instance Constructor Plus where conName _ = "Plus" +-- > +-- > -- Representable instance +-- > instance Representable Exp where +-- > type Rep Exp = C Const (Var Int) :+: C Plus (Rec Exp :*: Rec Exp) +-- > +-- > from (Const n) = L (C (Var n)) +-- > from (Plus e e') = R (C (Rec e :*: Rec e')) +-- > +-- > to (L (C (Var n))) = Const n +-- > to (R (C (Rec e :*: Rec e'))) = Plus e e' +-- +----------------------------------------------------------------------------- + +module Generics.Instant.Base ( + U(..), (:+:)(..), (:*:)(..), C(..), Var(..), Rec(..) + , Constructor(..), Fixity(..), Associativity(..) + , Representable(..) + ) where + +infixr 5 :+: +infixr 6 :*: + +data U = U deriving (Show, Read) +data a :+: b = L a | R b deriving (Show, Read) +data a :*: b = a :*: b deriving (Show, Read) +data C c a = C a deriving (Show, Read) +data Var a = Var a deriving (Show, Read) +data Rec a = Rec a deriving (Show, Read) + +-- | Class for datatypes that represent data constructors. +-- For non-symbolic constructors, only 'conName' has to be defined. +class Constructor c where + conName :: t c a -> String + conFixity :: t c a -> Fixity + conFixity = const Prefix + conIsRecord :: t c a -> Bool + conIsRecord = const False + +-- | Datatype to represent the fixity of a constructor. An infix declaration +-- directly corresponds to an application of 'Infix'. +data Fixity = Prefix | Infix Associativity Int + deriving (Eq, Show, Ord, Read) + +-- | Datatype to represent the associativy of a constructor. +data Associativity = LeftAssociative | RightAssociative | NotAssociative + deriving (Eq, Show, Ord, Read) + + +class Representable a where + type Rep a + to :: Rep a -> a + from :: a -> Rep a + -- defaults + {- + type Rep a = a -- type synonyms defaults are not yet implemented! + to = id + from = id + -}
+ src/Generics/Instant/Functions.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module : Generics.Instant.Functions+-- Copyright : (c) 2010, Universiteit Utrecht+-- License : BSD3+--+-- Maintainer : generics@haskell.org+-- Stability : experimental+-- Portability : non-portable+--+-- This module simply reexports all the generic functions' modules.+--+-----------------------------------------------------------------------------++module Generics.Instant.Functions (+ module Generics.Instant.Functions.Empty,+ module Generics.Instant.Functions.Show,+ module Generics.Instant.Functions.Eq+ ) where+ +import Generics.Instant.Functions.Empty+import Generics.Instant.Functions.Show+import Generics.Instant.Functions.Eq
+ src/Generics/Instant/Functions/Empty.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Generics.Instant.Functions.Empty +-- Copyright : (c) 2010, Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Generically produce a single finite value of a datatype. +-- +----------------------------------------------------------------------------- + +module Generics.Instant.Functions.Empty ( + Empty(..), empty, + HasRec(..) + ) where + +import Generics.Instant.Base +import Generics.Instant.Instances () + +-- Generic empty on Representable (worker) +class Empty a where + empty' :: a + +instance Empty U where + empty' = U + +instance (HasRec a, Empty a, Empty b) => Empty (a :+: b) where + empty' = if hasRec' (empty' :: a) then R empty' else L empty' + +instance (Empty a, Empty b) => Empty (a :*: b) where + empty' = empty' :*: empty' + +instance (Empty a) => Empty (C c a) where + empty' = C empty' + +instance (Empty a) => Empty (Var a) where + empty' = Var empty' + +instance (Empty a) => Empty (Rec a) where + empty' = Rec empty' + +instance Empty Int where + empty' = 0 + +instance Empty Integer where + empty' = 0 + +instance Empty Float where + empty' = 0 + +instance Empty Double where + empty' = 0 + +instance Empty Char where + empty' = '\NUL' + +instance Empty Bool where + empty' = False + + +-- Dispatcher +empty :: (Representable a, Empty (Rep a)) => a +empty = to empty' + +-- Adhoc instances +-- none + +-- Generic instances +instance (Empty a) => Empty (Maybe a) where empty' = empty +instance (Empty a) => Empty [a] where empty' = empty +instance (Empty a, Empty b) => Empty (a,b) where empty' = empty + + +-------------------------------------------------------------------------------- +-- | We use 'HasRec' to check for recursion in the structure. This is used +-- to avoid selecting a recursive branch in the sum case for 'Empty'. +class HasRec a where + hasRec' :: a -> Bool + hasRec' _ = False + +instance HasRec U +instance HasRec (Var a) + +instance (HasRec a, HasRec b) => HasRec (a :*: b) where + hasRec' (a :*: b) = hasRec' a || hasRec' b + +instance (HasRec a, HasRec b) => HasRec (a :+: b) where + hasRec' (L x) = hasRec' x + hasRec' (R x) = hasRec' x + +instance (HasRec a) => HasRec (C c a) where + hasRec' (C x) = hasRec' x + +instance HasRec (Rec a) where + hasRec' _ = True + +instance HasRec Int +instance HasRec Integer +instance HasRec Float +instance HasRec Double +instance HasRec Char
+ src/Generics/Instant/Functions/Eq.hs view
@@ -0,0 +1,63 @@+ +----------------------------------------------------------------------------- +-- | +-- Module : Generics.Instant.Functions.Eq +-- Copyright : (c) 2010, Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- The equality function. +-- +----------------------------------------------------------------------------- + +module Generics.Instant.Functions.Eq (Eq(..), eq) where + +import Generics.Instant.Base +import Generics.Instant.Instances () + +import Prelude hiding (Eq) + +-- Generic eq on Representable (worker) +class Eq a where + eq' :: a -> a -> Bool + +instance Eq U where + eq' U U = True + +instance (Eq a, Eq b) => Eq (a :+: b) where + eq' (L x) (L x') = eq' x x' + eq' (R x) (R x') = eq' x x' + eq' _ _ = False + +instance (Eq a, Eq b) => Eq (a :*: b) where + eq' (a :*: b) (a' :*: b') = eq' a a' && eq' b b' + +instance (Eq a) => Eq (C c a) where + eq' (C a) (C a') = eq' a a' + +instance Eq a => Eq (Var a) where + eq' (Var x) (Var x') = eq' x x' + +instance (Eq a) => Eq (Rec a) where + eq' (Rec x) (Rec x') = eq' x x' + +-- Dispatcher +eq :: (Representable a, Eq (Rep a)) => a -> a -> Bool +eq x y = eq' (from x) (from y) + + +-- Adhoc instances +instance Eq Int where eq' = (==) +instance Eq Integer where eq' = (==) +instance Eq Float where eq' = (==) +instance Eq Double where eq' = (==) +instance Eq Char where eq' = (==) +instance Eq Bool where eq' = (==) + +-- Generic instances +instance (Eq a) => Eq (Maybe a) where eq' = eq +instance (Eq a) => Eq [a] where eq' = eq +instance (Eq a, Eq b) => Eq (a, b) where eq' = eq
+ src/Generics/Instant/Functions/Show.hs view
@@ -0,0 +1,85 @@+ +----------------------------------------------------------------------------- +-- | +-- Module : Generics.Instant.Functions.Show +-- Copyright : (c) 2010, Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Simplified generic show function. +-- +----------------------------------------------------------------------------- + +module Generics.Instant.Functions.Show (Show(..), show) where + +import Generics.Instant.Base +import Generics.Instant.Instances () + +import Prelude hiding (Show, show) +import qualified Prelude as P (Show, show) +import Data.List (intersperse) + +-- Generic show on Representable (worker) +class Show a where + show' :: a -> String + +instance Show U where + show' U = "" + +instance (Show a, Show b) => Show (a :+: b) where + show' (L x) = show' x + show' (R x) = show' x + +instance (Show a, Show b) => Show (a :*: b) where + show' (a :*: b) = show' a `space` show' b + +instance (Show a, Constructor c) => Show (C c a) where + show' c@(C a) | show' a == "" = paren $ conName c + | otherwise = paren $ (conName c) `space` show' a + +instance Show a => Show (Var a) where + show' (Var x) = show' x + +instance Show a => Show (Rec a) where + show' (Rec x) = show' x + + +-- Dispatcher +show :: (Representable a, Show (Rep a)) => a -> String +show = show' . from + + +-- Adhoc instances +instance Show Int where show' = P.show +instance Show Integer where show' = P.show +instance Show Float where show' = P.show +instance Show Double where show' = P.show +instance Show Char where show' = P.show +instance Show Bool where show' = P.show + +instance Show a => Show [a] where + show' = concat . wrap "[" "]" . intersperse "," . map show' + +instance Show [Char] where + show' = P.show + +instance (Show a, Show b) => Show (a, b) where + show' (a,b) = "(" ++ show' a ++ "," ++ show' b ++ ")" + + +-- Generic instances +instance (Show a) => Show (Maybe a) where show' = show + + +-- Utilities +space :: String -> String -> String +space a b = a ++ " " ++ b + +paren :: String -> String +paren x = "(" ++ x ++ ")" + +wrap :: a -> a -> [a] -> [a] +wrap h t l = h:l++[t]
+ src/Generics/Instant/Instances.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE EmptyDataDecls #-} +{-# OPTIONS -fno-warn-orphans #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Generics.Instant.Instances +-- Copyright : (c) 2010, Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- This module defines instances of the 'Representable' class for a number of +-- basic Prelude types. +-- +----------------------------------------------------------------------------- + +module Generics.Instant.Instances () where + +import Generics.Instant.Base + +instance Representable Int where + type Rep Int = Int + to = id + from = id + +instance Representable Char where + type Rep Char = Char + to = id + from = id + +instance Representable Bool where + type Rep Bool = Bool + to = id + from = id + +instance Representable Float where + type Rep Float = Float + to = id + from = id + +instance Representable U where + type Rep U = U + to = id + from = id + +instance (Representable a, Representable b) => Representable (a :*: b) where + type Rep (a :*: b) = a :*: b + to = id + from = id + +instance (Representable a, Representable b) => Representable (a :+: b) where + type Rep (a :+: b) = a :+: b + to = id + from = id + +instance Representable a => Representable (C c a) where + type Rep (C c a) = C c a + to = id + from = id + +instance Representable a => Representable (Var a) where + type Rep (Var a) = Var a + to = id + from = id + +instance Representable a => Representable (Rec a) where + type Rep (Rec a) = Rec a + to = id + from = id + +-- Lists +instance Representable [a] where + type Rep [a] = C List_Nil_ U :+: C List_Cons_ (Var a :*: Rec [a]) + from [] = L (C U) + from (a:as) = R (C (Var a :*: Rec as)) + to (L (C U)) = [] + to (R (C (Var a :*: Rec as))) = (a:as) + +data List_Nil_ +instance Constructor List_Nil_ where conName _ = "[]" +data List_Cons_ +instance Constructor List_Cons_ where + conName _ = ":" + conFixity _ = Infix RightAssociative 5 + +-- Maybe +instance Representable (Maybe a) where + type Rep (Maybe a) = C Maybe_Nothing_ U :+: C Maybe_Just_ (Var a) + from Nothing = L (C U) + from (Just x) = R (C (Var x)) + to (L (C U)) = Nothing + to (R (C (Var x))) = Just x + +data Maybe_Nothing_ +instance Constructor Maybe_Nothing_ where conName _ = "Nothing" +data Maybe_Just_ +instance Constructor Maybe_Just_ where conName _ = "Just" + +-- Pairs +instance Representable (a,b) where + type Rep (a,b) = C Tuple_Pair_ (Var a :*: Var b) + from (a,b) = C (Var a :*: Var b) + to (C (Var a :*: Var b)) = (a,b) + + +data Tuple_Pair_ +instance Constructor Tuple_Pair_ where conName _ = "," -- Prefix?