packages feed

adaptive-tuple (empty) → 0.1.0

raw patch · 8 files changed

+545/−0 lines, 8 filesdep +basedep +haskell98dep +template-haskellsetup-changed

Dependencies added: base, haskell98, template-haskell, type-level

Files

+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3++All code is copyrighted 2009 by John W. Lato. Usage of this code is governed by the following license.++* Copyright (c) 2009 John W. Lato+*+* All rights reserved.+*+* Redistribution and use in source and binary forms, with or without+* modification, are permitted provided that the following conditions are met:+*     * Redistributions of source code must retain the above copyright+*       notice, this list of conditions and the following disclaimer.+*     * 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.+*     * Neither the name of Tiresias Press 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 John W. Lato ``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 John W. Lato OR ANY 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 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,8 @@+#! /usr/bin/runhaskell++module Main (main) where++import Distribution.Simple (defaultMain)++main :: IO ()+main = defaultMain
+ adaptive-tuple.cabal view
@@ -0,0 +1,59 @@+name:		adaptive-tuple+version:        0.1.0+synopsis:       Self-optimizing tuple types+description:+  Self optimizing tuple types.+  .+  Adaptive tuples are tuple types in which the number of elements is+  determined at run-time.  These structures are designed to combine+  the space-efficiency of tuples with the size flexibility of lists.+  .+  Adaptive tuples provide lazy and strict, unpacked data structures +  for all tuple sizes from 0 to 20 elements.  Adaptive tuples of more than+  20 elements are allowed, however they are stored in an ordinary list.++category:       Data+author:		John W. Lato, jwlato@gmail.com+maintainer:	John W. Lato, jwlato@gmail.com+license:	BSD3+license-file:	LICENSE+homepage:       http://inmachina.net/~jwlato/haskell/+tested-with:    GHC == 6.12.1, GHC == 6.10.4+stability:	experimental+cabal-version:  >= 1.6++build-type:     Simple+extra-source-files:+  LICENSE++flag splitBase+  description: Use the new split-up base package.++library+ hs-source-dirs:+   src++ if flag(splitBase)+   build-depends:+     base >= 3 && < 5+ else+   build-depends:+     base < 3++ build-depends:+   haskell98+   ,type-level >= 0.2 && < 0.3+   ,template-haskell >= 2.0 && < 3++ exposed-modules:+   Data.AdaptiveTuple+   Data.AdaptiveTuple.Reps.Strict+   Data.AdaptiveTuple.Reps.Lazy+ other-modules:+   Data.AdaptiveTuple.AdaptiveTuple+   Data.AdaptiveTuple.TH++ ghc-options: -Wall+ if impl(ghc >= 6.8)+   ghc-options: -fwarn-tabs+
+ src/Data/AdaptiveTuple.hs view
@@ -0,0 +1,179 @@+-- |This module provides support for adaptive tuples.+-- An `AdaptiveTuple` is a tuple type with the size chosen at run-time and+-- minimal overhead.  All elements must be of the same type.  Calculations+-- are generated by combining adaptive tuples, which are then given an+-- initial input with the `reifyTuple` function or its strict variant.+--+-- Example: suppose you have a list of numbers that is either a single list+-- or multiple interleaved lists.  You wish to determine the maximum value+-- of the single list or maximums of all interleaved lists.+--+-- >  -- |The second  argument is a dummy argument to fix the type of c s ()+-- >  -- so this function can be used directly with reifyTuple+-- >  deinterleave :: AdaptiveTuple c s => [Int] -> c s () -> [c s Int]+-- >  deinterleave [] _ = []+-- >  deinterleave xs n = let (h, rest) = splitAt (tupLength n) xs+-- >                      in toATuple h : deinterleave n rest+-- >+-- >  maxVals :: AdaptiveTuple c s => [c s Int] -> c s Int+-- >  maxVals = foldl' (\a b -> max <$> a <*> b) (pure 0)+-- >+-- >  runner :: Int -> [Int] -> [Int]+-- >  runner n xs = reifyStrictTuple n (repeat ())+-- >                  (fromATuple . maxVals . deinterleave xs)+--+-- using AdaptiveTuple is similar to the `ZipList` applicative instance, except+-- without the overhead.++{-# LANGUAGE MultiParamTypeClasses,+             FlexibleInstances,+             FlexibleContexts,+             ScopedTypeVariables,+             Rank2Types,+             GeneralizedNewtypeDeriving,+             TemplateHaskell #-}++{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Data.AdaptiveTuple (+  -- * Types+  -- ** Classes+  AdaptiveTuple (..)+  -- ** Exceptions+  ,AdaptiveTupleException (..)+  -- * Functions+  ,reifyTuple+  ,reifyStrictTuple+  ,invert+  ,mapIndexed+)++where++import Prelude -- hiding (take, drop, splitAt, foldl)+import qualified Prelude as P++import Data.AdaptiveTuple.AdaptiveTuple+import qualified Data.AdaptiveTuple.Reps.Lazy as L+import qualified Data.AdaptiveTuple.Reps.Strict as S++import Data.TypeLevel.Num++import Control.Arrow+import Control.Applicative++-- helper function+fI :: (Integral a, Num b) => a -> b+fI = fromIntegral++-- --------------------------------------------------++-- |Lazily convert a list of AdaptiveTuples into an AdaptiveTuple of lists.+invert :: (AdaptiveTuple c s) => [c s a] -> c s [a]+invert []     = pure []+invert (x:xs) = (:) <$> x <*> invert xs++-- |Map a 0-indexed function over an AdaptiveTuple+mapIndexed :: (AdaptiveTuple c s) => (Int -> a -> b) -> c s a -> c s b+mapIndexed f a = f <$> toATuple [0..] <*> a++--reification function++-- |run a computation using a lazy AdaptiveTuple+reifyTuple :: forall el r. Int -> [el] -> (forall c s. (AdaptiveTuple c s, Nat s) => c s el -> r) -> r+reifyTuple 0 xs f = f (toATuple xs :: ATuple0 D0 el)+reifyTuple 1  xs f = f (toATuple xs :: L.ATuple1 D1  el)+reifyTuple 2  xs f = f (toATuple xs :: L.ATuple2 D2  el)+reifyTuple 3  xs f = f (toATuple xs :: L.ATuple3 D3  el)+reifyTuple 4  xs f = f (toATuple xs :: L.ATuple4 D4  el)+reifyTuple 5  xs f = f (toATuple xs :: L.ATuple5 D5  el)+reifyTuple 6  xs f = f (toATuple xs :: L.ATuple6 D6  el)+reifyTuple 7  xs f = f (toATuple xs :: L.ATuple7 D7  el)+reifyTuple 8  xs f = f (toATuple xs :: L.ATuple8 D8  el)+reifyTuple 9  xs f = f (toATuple xs :: L.ATuple9 D9  el)+reifyTuple 10 xs f = f (toATuple xs :: L.ATuple10 D10 el)+reifyTuple 11 xs f = f (toATuple xs :: L.ATuple11 D11 el)+reifyTuple 12 xs f = f (toATuple xs :: L.ATuple12 D12 el)+reifyTuple 13 xs f = f (toATuple xs :: L.ATuple13 D13 el)+reifyTuple 14 xs f = f (toATuple xs :: L.ATuple14 D14 el)+reifyTuple 15 xs f = f (toATuple xs :: L.ATuple15 D15 el)+reifyTuple 16 xs f = f (toATuple xs :: L.ATuple16 D16 el)+reifyTuple 17 xs f = f (toATuple xs :: L.ATuple17 D17 el)+reifyTuple 18 xs f = f (toATuple xs :: L.ATuple18 D18 el)+reifyTuple 19 xs f = f (toATuple xs :: L.ATuple19 D19 el)+reifyTuple 20 xs f = f (toATuple xs :: L.ATuple20 D20 el)+reifyTuple n xs f = reifyIntegral n $ \n' -> f (makeListTuple n' xs)++-- |run a computation using a strict AdaptiveTuple+reifyStrictTuple :: forall el r. Int -> [el] -> (forall c s. (AdaptiveTuple c s, Nat s) => c s el -> r) -> r+reifyStrictTuple 0 xs f = f (toATuple xs :: ATuple0 D0 el)+reifyStrictTuple 1  xs f = f (toATuple xs :: S.ATuple1 D1  el)+reifyStrictTuple 2  xs f = f (toATuple xs :: S.ATuple2 D2  el)+reifyStrictTuple 3  xs f = f (toATuple xs :: S.ATuple3 D3  el)+reifyStrictTuple 4  xs f = f (toATuple xs :: S.ATuple4 D4  el)+reifyStrictTuple 5  xs f = f (toATuple xs :: S.ATuple5 D5  el)+reifyStrictTuple 6  xs f = f (toATuple xs :: S.ATuple6 D6  el)+reifyStrictTuple 7  xs f = f (toATuple xs :: S.ATuple7 D7  el)+reifyStrictTuple 8  xs f = f (toATuple xs :: S.ATuple8 D8  el)+reifyStrictTuple 9  xs f = f (toATuple xs :: S.ATuple9 D9  el)+reifyStrictTuple 10 xs f = f (toATuple xs :: S.ATuple10 D10 el)+reifyStrictTuple 11 xs f = f (toATuple xs :: S.ATuple11 D11 el)+reifyStrictTuple 12 xs f = f (toATuple xs :: S.ATuple12 D12 el)+reifyStrictTuple 13 xs f = f (toATuple xs :: S.ATuple13 D13 el)+reifyStrictTuple 14 xs f = f (toATuple xs :: S.ATuple14 D14 el)+reifyStrictTuple 15 xs f = f (toATuple xs :: S.ATuple15 D15 el)+reifyStrictTuple 16 xs f = f (toATuple xs :: S.ATuple16 D16 el)+reifyStrictTuple 17 xs f = f (toATuple xs :: S.ATuple17 D17 el)+reifyStrictTuple 18 xs f = f (toATuple xs :: S.ATuple18 D18 el)+reifyStrictTuple 19 xs f = f (toATuple xs :: S.ATuple19 D19 el)+reifyStrictTuple 20 xs f = f (toATuple xs :: S.ATuple20 D20 el)+reifyStrictTuple n xs f = reifyIntegral n $ \n' -> f (makeListTuple n' xs)++-- -------------------------------------------------------+-- no-element tuple++data ATuple0 s el = ATuple0 deriving (Eq, Show)++instance Functor (ATuple0 D0) where+  fmap _ _ = ATuple0++instance Applicative (ATuple0 D0) where+  pure _  = ATuple0+  _ <*> _ = ATuple0++instance AdaptiveTuple ATuple0 D0 where+  getIndex _ n   = oObExcp "getIndex"+  setIndex _ _ _ = ATuple0+  mapIndex _ _ _ = ATuple0+  toATuple _     = ATuple0+  fromATuple _   = []+++-- |A ListTuple is a List with a type-level length.+-- to be used when there isn't a more specific adaptive tuple defined+newtype Nat s => ListTuple s a = ListTuple {getListTuple :: [a]}+  deriving (Eq, Functor, Show)++-- |Create a ListTuple+makeListTuple :: Nat s => s -> [a] -> ListTuple s a+makeListTuple s xs | toInt s P.< P.length xs =+  error $ "input list to short to make ListTuple of length " +++          (show $ toInt s)+makeListTuple s xs = ListTuple . P.take (toInt s) $ xs++instance Nat s => Applicative (ListTuple s) where+  pure    = pureLT+  a <*> b = ListTuple $ zipWith ($) (getListTuple a) (getListTuple b)++pureLT :: forall s a. (Nat s) => a -> ListTuple s a+pureLT = ListTuple . replicate (toInt (undefined :: s))++instance forall s. (Nat s) => AdaptiveTuple ListTuple s where+  getIndex z i = getListTuple z !! (fI i)+  setIndex i el = ListTuple . uncurry (++) . ((++ [el]) *** P.drop 1) .+                        P.splitAt (fI i) . getListTuple+  mapIndex f i  = ListTuple . uncurry (++) . second (\(x:xs) -> f x : xs) .+                        P.splitAt (fI i) . getListTuple+  toATuple      = makeListTuple (undefined :: s)+  fromATuple    = getListTuple+
+ src/Data/AdaptiveTuple/AdaptiveTuple.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, DeriveDataTypeable #-}++module Data.AdaptiveTuple.AdaptiveTuple (+  -- *Type classes+  AdaptiveTuple (..)+  -- *Types+  ,AdaptiveTupleException (..)+  -- *Error functions+  ,oObExcp+  ,insExcp+  )++where++import Data.TypeLevel.Num+import Data.Data+import Control.Exception+import Control.Applicative++-- |Adaptive tuples: unboxed tuples of varying size.+-- @s@ is a type-level indicator of the number of elements in the container.+class (Nat s, Applicative (c s)) => AdaptiveTuple c s where+  getIndex   :: c s el -> Int -> el+  setIndex   :: Int -> el -> c s el -> c s el+  mapIndex   :: (el -> el) -> Int -> c s el -> c s el+  toATuple   :: [el] -> c s el+  fromATuple :: c s el -> [el]+  tupLength  :: c s el -> Int+  tupLength _ = toInt (undefined :: s)++-- -------------------------------------+-- exceptions++data AdaptiveTupleException =+    ATupleIndexOutOfBounds String+  | ATupleInsufficientInput+  deriving (Show, Typeable)++instance Exception AdaptiveTupleException++oObExcp :: String -> a+oObExcp = throw . ATupleIndexOutOfBounds++insExcp :: a+insExcp = throw ATupleInsufficientInput+
+ src/Data/AdaptiveTuple/Reps/Lazy.hs view
@@ -0,0 +1,38 @@+-- | Adaptive tuples with non-strict elements.  It is usually not+-- necessary to import this module unless you need to construct+-- custom reification functions.++{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-matches #-}++module Data.AdaptiveTuple.Reps.Lazy++where++import Data.AdaptiveTuple.TH+import Data.AdaptiveTuple.AdaptiveTuple+import Data.TypeLevel.Num+import Language.Haskell.TH (Strict (..))+import Control.Applicative++$(makeDatas NotStrict 20)+$(deriveInstances ''ATuple1 ''D1)+$(deriveInstances ''ATuple2 ''D2)+$(deriveInstances ''ATuple3 ''D3)+$(deriveInstances ''ATuple4 ''D4)+$(deriveInstances ''ATuple5 ''D5)+$(deriveInstances ''ATuple6 ''D6)+$(deriveInstances ''ATuple7 ''D7)+$(deriveInstances ''ATuple8 ''D8)+$(deriveInstances ''ATuple9 ''D9)+$(deriveInstances ''ATuple10 ''D10)+$(deriveInstances ''ATuple11 ''D11)+$(deriveInstances ''ATuple12 ''D12)+$(deriveInstances ''ATuple13 ''D13)+$(deriveInstances ''ATuple14 ''D14)+$(deriveInstances ''ATuple15 ''D15)+$(deriveInstances ''ATuple16 ''D16)+$(deriveInstances ''ATuple17 ''D17)+$(deriveInstances ''ATuple18 ''D18)+$(deriveInstances ''ATuple19 ''D19)+$(deriveInstances ''ATuple20 ''D20)
+ src/Data/AdaptiveTuple/Reps/Strict.hs view
@@ -0,0 +1,39 @@+-- | Adaptive Tuples with strict fields and unboxed elements.  The equivalent+-- of @data ATuple1 s n = ATuple1 !n@ compiled with @-funbox-strict-fields@.+-- It is usually not necessary to import this module except to make custom+-- reification functions.++{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}+{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-unused-binds -fno-warn-unused-matches #-}++module Data.AdaptiveTuple.Reps.Strict++where++import Data.AdaptiveTuple.TH+import Data.AdaptiveTuple.AdaptiveTuple+import Data.TypeLevel.Num+import Language.Haskell.TH (Strict (..))+import Control.Applicative++$(makeDatas IsStrict 20)+$(deriveInstances ''ATuple1 ''D1)+$(deriveInstances ''ATuple2 ''D2)+$(deriveInstances ''ATuple3 ''D3)+$(deriveInstances ''ATuple4 ''D4)+$(deriveInstances ''ATuple5 ''D5)+$(deriveInstances ''ATuple6 ''D6)+$(deriveInstances ''ATuple7 ''D7)+$(deriveInstances ''ATuple8 ''D8)+$(deriveInstances ''ATuple9 ''D9)+$(deriveInstances ''ATuple10 ''D10)+$(deriveInstances ''ATuple11 ''D11)+$(deriveInstances ''ATuple12 ''D12)+$(deriveInstances ''ATuple13 ''D13)+$(deriveInstances ''ATuple14 ''D14)+$(deriveInstances ''ATuple15 ''D15)+$(deriveInstances ''ATuple16 ''D16)+$(deriveInstances ''ATuple17 ''D17)+$(deriveInstances ''ATuple18 ''D18)+$(deriveInstances ''ATuple19 ''D19)+$(deriveInstances ''ATuple20 ''D20)
+ src/Data/AdaptiveTuple/TH.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, DeriveDataTypeable #-}++{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-incomplete-patterns #-}++module Data.AdaptiveTuple.TH (+ makeDatas+ ,makeData+ ,deriveInstances+ ,deriveFunctor+ ,deriveApplicative+ ,deriveAdaptive+ )+where++import Data.AdaptiveTuple.AdaptiveTuple+import Language.Haskell.TH+import qualified Data.TypeLevel.Num as T+import Data.Data+import Control.Monad+import Control.Applicative+import Control.Arrow++checkStrict :: Strict -> Bool+checkStrict IsStrict = True+checkStrict _        = False++-- template type for Q Decls+data T1 s a = T1 a++-- |Generate "ATuple1" ... "ATupleN"+makeDatas :: Strict -> Int -> Q [Dec]+makeDatas strict n = liftM concat $ mapM (makeData strict) [1..n]++-- |Given a value n >1, create data value "ATupleN"+makeData :: Strict -> Int -> Q [Dec]+makeData strict n = do+  let dN = mkName $ "ATuple" ++ show n+  let d' = if checkStrict strict+              then [d| data MX s a = MX {-# UNPACK #-} !a deriving (Show, Eq, Typeable, Data)|]+              else [d| data MX s a = MX a deriving (Show, Eq, Typeable, Data)|]+  d <- d'+  let [DataD [] _mx tvars [NormalC _mx' [cfield]] ders] = d+  return [DataD [] dN tvars [NormalC dN (replicate n cfield)] ders]++-- |Generate Functor, Applicative, and AdaptiveTuple instances for type (t s)+deriveInstances :: Name -> Name -> Q [Dec]+deriveInstances t s = do+  fs <- deriveFunctor t s+  apps <- deriveApplicative t s+  adpts <- deriveAdaptive t s+  return $ fs ++ apps ++ adpts++-- |derive Functor instance for type (t s)+deriveFunctor :: Name -> Name -> Q [Dec]+deriveFunctor t s = do+  TyConI (DataD _ _ _ constructors _) <- reify t+  tT <- conT t                                      -- tuple constructor+  sT <- conT s                                      --type-level size number+  d <- [d| instance Functor (T1 s) where fmap _ x = x|]+  let fmapClause (NormalC name fields) = do+        (fP:pats, fE:vars) <- genPE (1+length fields)+        clause (fP:[conP name pats])+           (normalB (appsE (conE name : map (appE fE) vars))) []+  let [InstanceD [] (AppT fmapt _) [FunD fmapf _clause]] = d+  funs <- funD fmapf (map fmapClause constructors)+  return [InstanceD [] (AppT fmapt (AppT tT sT)) [funs]]++-- |Generate Applicative instance for type (t s)+deriveApplicative :: Name -> Name -> Q [Dec]+deriveApplicative t s = do+  TyConI (DataD _ _ _ constructors _) <- reify t+  tT <- conT t+  sT <- conT s+  d <- [d| instance Functor (T1 s) => Applicative (T1 s) where pure a = T1 a; (T1 a) <*> (T1 b) = T1 (a b)|]+  let pureClause (NormalC name fields) = do+        (aP, [aE]) <- genPE 1+        clause aP (normalB (appsE (conE name:replicate (length fields) aE))) []+  let appClause (NormalC name fields) = do+        (aPats, aVars) <- genPE (length fields)+        (bPats, bVars) <- genPE (length fields)+        let pats = [conP name aPats, conP name bPats]+        clause pats (normalB (appsE (conE name:zipWith appE aVars bVars))) []+  let [InstanceD _ (AppT appt _) [FunD puref _, FunD appf _]] = d+  purefuncs <- funD puref (map pureClause constructors)+  appfuncs <- funD appf (map appClause constructors)+  return [InstanceD [] (AppT appt (AppT tT sT)) [purefuncs, appfuncs]]++-- |Generate AdaptiveTuple instance for type (t s)+deriveAdaptive :: Name -> Name -> Q [Dec]+deriveAdaptive t s = do+  TyConI (DataD _ _ _ constructors _) <- reify t+  tT <- conT t+  sT <- conT s+  d <- [d| instance (T.Nat s, Applicative (T1 s)) => AdaptiveTuple T1 s where getIndex _ _ = undefined; setIndex _ _ c = c; mapIndex _ _ c = c; toATuple _ = undefined; fromATuple _ = []|]+  let makeClauseOut n pf bf = return $ map ((\(x,y) -> clause x y []) .+                                (pf &&& bf)) [0..n]+  let getClauses (NormalC name fields) = do+        (aP, aV) <- genPE (length fields)+        ([eP],[eV]) <- genPE 1+        let getPats n = [conP name aP, litP (integerL (fromIntegral n))]+        let getBody = normalB . (aV !!)+        let errC = clause [wildP, eP] (normalB [| oObExcp "getIndex" |]) []+        c1 <- makeClauseOut (length fields - 1) getPats getBody+        return (c1 ++ [errC])+  let setClauses (NormalC name fields) = do+        ([elP,eP], [elV,eV]) <- genPE 2+        (aP, aV) <- genPE (length fields)+        let getPats n = [litP (integerL (fromIntegral n)), elP, conP name aP]+        let getBody n = normalB $ appsE (conE name:replaceAt aV n elV)+        let errC = clause [eP, wildP, wildP] (normalB [| oObExcp "setIndex" |]) []+        c1 <- makeClauseOut (length fields - 1) getPats getBody+        return (c1 ++ [errC])+  let mapClauses (NormalC name fields) = do+        ([fP,eP], [fV,eV]) <- genPE 2+        (aP, aV) <- genPE (length fields)+        let getPats n = [fP, litP (integerL (fromIntegral n)), conP name aP]+        let getBody n = normalB $ appsE+                          (conE name:replaceAt aV n (appE fV (aV !! n)))+        let errC = clause [wildP, eP, wildP] (normalB [| oObExcp "mapIndex" |]) []+        c1 <- makeClauseOut (length fields - 1) getPats getBody+        return (c1 ++ [errC])+  let toClauses (NormalC name fields) = do+        (aP, aV) <- genPE (length fields)+        let pats = foldr (flip infixP '(:)) wildP aP+        let c1 = clause [pats] (normalB $ appsE (conE name:aV)) []+        let c2 = clause [wildP] (normalB [| insExcp |]) []+        return [c1,c2]+  let fromClause (NormalC name fields) = do+        (aP, aV) <- genPE (length fields)+        clause [conP name aP] (normalB $ listE aV) []+  let [InstanceD _ (AppT (AppT adtT _) _) [FunD getF _, FunD setF _, FunD mapF _, FunD toATF _, FunD fromATF _]] = d+  let newty = AppT (AppT adtT tT) sT+  getters <- mapM getClauses constructors >>= (funD getF . concat)+  setters <- mapM setClauses constructors >>= (funD setF . concat)+  maps    <- mapM mapClauses constructors >>= (funD mapF . concat)+  tos     <- mapM toClauses  constructors >>= (funD toATF . concat)+  froms   <- funD fromATF (map fromClause constructors)+  return [InstanceD [] newty [getters,setters,maps,tos,froms]]++-- |Create a list of n Names, with the associated Pat's and Exp's+genPE :: Int -> Q ([PatQ], [ExpQ])+genPE n = do+  ids <- replicateM n (newName "x")+  return (map varP ids, map varE ids)++replaceAt :: [a] -> Int -> a -> [a]+replaceAt xs n el = let (f,l) = splitAt n xs in f ++ (el:tail l)