diff --git a/CREDITS b/CREDITS new file mode 100644 --- /dev/null +++ b/CREDITS @@ -0,0 +1,21 @@ + +Credits for multirec +==================== + +This is a list of those who have contributed to the research, concept, code, +and/or other issues of the multirec library. + +Research and Code +----------------- + +* Alexey Rodriguez +* Stefan Holdermans +* Andres Löh +* Johan Jeuring + +Ideas and Support +----------------- + +* Thomas van Noort +* Sean Leather +* José Pedro Magalhães diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2008 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 the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/examples/AST.hs b/examples/AST.hs new file mode 100644 --- /dev/null +++ b/examples/AST.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module AST where + +import Generics.MultiRec.Base + +-- * The AST type from the paper + +infix 1 := + +data Expr = Const Int + | Add Expr Expr + | Mul Expr Expr + | EVar Var + | Let Decl Expr + deriving Show + +data Decl = Var := Expr + | Seq Decl Decl + deriving Show + +type Var = String + +-- * Instantiating the library for AST + +data AST :: * -> * where + Expr :: AST Expr + Decl :: AST Decl + Var :: AST Var + +type instance PF AST = + K Int :>: Expr -- |Const| + :+: (I Expr :*: I Expr) :>: Expr -- |Add| + :+: (I Expr :*: I Expr) :>: Expr -- |Mul| + :+: I Var :>: Expr -- |EVar| + :+: (I Decl :*: I Expr) :>: Expr -- |Let| + :+: (I Var :*: I Expr) :>: Decl -- |:=| + :+: (I Decl :*: I Decl) :>: Decl -- |Seq| + :+: K String :>: Var -- |V| + +instance Ix AST Expr where + + from_ (Const i) = L (Tag (K i)) + from_ (Add e f) = R (L (Tag (I (I0 e) :*: I (I0 f)))) + from_ (Mul e f) = R (R (L (Tag (I (I0 e) :*: I (I0 f))))) + from_ (EVar x) = R (R (R (L (Tag (I (I0 x)))))) + from_ (Let d e) = R (R (R (R (L (Tag (I (I0 d) :*: I (I0 e))))))) + + to_ (L (Tag (K i))) = Const i + to_ (R (L (Tag (I (I0 e) :*: I (I0 f))))) = Add e f + to_ (R (R (L (Tag (I (I0 e) :*: I (I0 f)))))) = Mul e f + to_ (R (R (R (L (Tag (I (I0 x))))))) = EVar x + to_ (R (R (R (R (L (Tag (I (I0 d) :*: I (I0 e)))))))) = Let d e + + index = Expr + +instance Ix AST Decl where + + from_ (x := e) = R (R (R (R (R (L (Tag (I (I0 x) :*: I (I0 e)))))))) + from_ (Seq c d) = R (R (R (R (R (R (L (Tag (I (I0 c) :*: I (I0 d))))))))) + + to_ (R (R (R (R (R (L (Tag (I (I0 x) :*: I (I0 e))))))))) = x := e + to_ (R (R (R (R (R (R (L (Tag (I (I0 c) :*: I (I0 d))))))))))= Seq c d + + index = Decl + +instance Ix AST Var where + + from_ x = R (R (R (R (R (R (R(Tag (K x)))))))) + + to_ (R (R (R (R (R (R (R(Tag (K x))))))))) = x + + index = Var + diff --git a/examples/ASTExamples.hs b/examples/ASTExamples.hs new file mode 100644 --- /dev/null +++ b/examples/ASTExamples.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} + +module ASTExamples where + +import Data.Maybe (fromJust) +import Control.Arrow ((>>>)) +import Control.Monad ((>=>)) + +import AST + +import Generics.MultiRec.Base +import Generics.MultiRec.Compos +import Generics.MultiRec.Fold +import Generics.MultiRec.Eq + +-- | Example expression + +example = Let ("x" := Mul (Const 6) (Const 9)) + (Add (EVar "x") (EVar "y")) + +-- | Renaming variables using 'compos' + +renameVar :: Expr -> Expr +renameVar = renameVar' Expr + where + renameVar' :: Ix AST a => AST a -> a -> a + renameVar' Var x = x ++ "_" + renameVar' _ x = compos renameVar' x + +-- | Test for 'renameVar' + +testRename :: Expr +testRename = renameVar example + +-- | Result of evaluating an expression + +data family Value aT :: * +data instance Value Expr = EV (Env -> Int) +data instance Value Decl = DV (Env -> Env) +data instance Value Var = VV Var + +type Env = [(Var, Int)] + +-- | Algebra for evaluating an expression + +evalAlgebra :: Algebra AST Value +evalAlgebra _ = + tag (\ (K x) -> EV (const x)) + & tag (\ (I (EV x) :*: I (EV y)) -> EV (\ env -> x env + y env)) + & tag (\ (I (EV x) :*: I (EV y)) -> EV (\ env -> x env * y env)) + & tag (\ (I (VV x)) -> EV (fromJust . lookup x)) + & tag (\ (I (DV e) :*: I (EV x)) -> EV (\ env -> x (e env))) + & tag (\ (I (VV x) :*: I (EV v)) -> DV (\ env -> (x, v env) : env )) + & tag (\ (I (DV f) :*: I (DV g)) -> DV (g . f)) + & tag (\ (K x) -> VV x) + +-- | Evaluator + +eval :: Expr -> Env -> Int +eval x = let (EV f) = fold evalAlgebra x in f + +-- | Test for 'eval' + +testEval :: Int +testEval = eval example [("y", -12)] + +-- | Equality instance for 'Expr' + +instance Eq Expr where + (==) = eq Expr + +-- | Test for equality + +testEq :: (Bool, Bool) +testEq = (example == example, example == testRename) diff --git a/multirec.cabal b/multirec.cabal new file mode 100644 --- /dev/null +++ b/multirec.cabal @@ -0,0 +1,57 @@ +name: multirec +version: 0.1 +license: BSD3 +license-file: LICENSE +author: Alexey Rodriguez, + Stefan Holdermans, + Andres Löh, + Johan Jeuring +maintainer: generics@haskell.org +category: Generics +synopsis: Generic programming with systems of recursive datatypes +homepage: http://www.cs.uu.nl/wiki/GenericProgramming/Multirec +description: + Many generic programs require information about the recursive positions + of a datatype. Examples include the generic fold, generic rewriting or + the Zipper data structure. Several generic programming systems allow to + write such functions by viewing datatypes as fixed points of a pattern + functor. Traditionally, this view has been limited to so-called regular + datatypes such as lists and binary trees. In particular, systems of + mutually recursive datatypes have been excluded. + . + With the multirec library, we provide a mechanism to talk about fixed + points of systems of datatypes that may be mutually recursive. On top + of this representations, generic functions such as the fold or the zipper + can then be defined. + . + We expect that the library will be especially interesting for compiler + writers, because ASTs are typically systems of mutually recursive datatypes, + and with multirec it becomes easy to write generic functions on ASTs. + . + The library is based on ideas described in the paper: + . + * Alexey Rodriguez, Stefan Holdermans, Andres Löh, Johan Jeuring. + /Generic programming with fixed points for mutually recursive datatypes/. + Technical Report, Universiteit Utrecht + (). + +stability: experimental +build-type: Simple +cabal-version: >= 1.2.1 +tested-with: GHC == 6.8.3 +hs-source-dirs: src +exposed-modules: Generics.MultiRec + + -- Base + Generics.MultiRec.Base + + -- Generic functions + Generics.MultiRec.HFunctor + Generics.MultiRec.Fold + Generics.MultiRec.Compos + Generics.MultiRec.Eq + +extra-source-files: examples/AST.hs + examples/ASTExamples.hs + CREDITS +build-depends: base >= 3.0 diff --git a/src/Generics/MultiRec.hs b/src/Generics/MultiRec.hs new file mode 100644 --- /dev/null +++ b/src/Generics/MultiRec.hs @@ -0,0 +1,37 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Generics.MultiRec +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- multirec -- +-- generic programming with systems of recursive datatypes +-- +-- This top-level module re-exports all other modules of the library. +-- +----------------------------------------------------------------------------- + +module Generics.MultiRec + ( + -- * Base + module Generics.MultiRec.Base, + + -- * Generic functions + module Generics.MultiRec.HFunctor, + module Generics.MultiRec.Fold, + module Generics.MultiRec.Compos, + module Generics.MultiRec.Eq + ) + where + +import Generics.MultiRec.Base +import Generics.MultiRec.HFunctor +import Generics.MultiRec.Fold +import Generics.MultiRec.Compos +import Generics.MultiRec.Eq + + diff --git a/src/Generics/MultiRec/Base.hs b/src/Generics/MultiRec/Base.hs new file mode 100644 --- /dev/null +++ b/src/Generics/MultiRec/Base.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Rank2Types #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Generics.MultiRec.Base +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- This module is the base of the multirec library. It defines the view of a +-- system of datatypes: All the datatypes of the system are represented as +-- indexed functors that are built up from the structure types defined in this +-- module. Furthermore, in order to use the library for a system, conversion +-- functions have to be defined between the original datatypes and their +-- representation. The type class that holds these conversion functions are +-- also defined here. +-- +----------------------------------------------------------------------------- + +module Generics.MultiRec.Base + (-- * Structure types + I(..), unI, + K(..), (:+:)(..), (:*:)(..), + (:>:)(..), unTag, + + -- ** Unlifted variants + I0(..), K0(..), + + -- * Indexed systems + PF, Str, Ix(..) + ) where + +import Control.Applicative + +-- * Structure types + +infixr 5 :+: +infix 6 :>: +infixr 7 :*: + +-- | Represents recursive positions. The first argument indicates +-- which type (within the system) to recurse on. +data I :: * -> (* -> *) -> (* -> *) -> * -> * where + I :: Ix s xi => r xi -> I xi s r ix + +-- | Destructor for 'I'. +unI :: I xi s r ix -> r xi +unI (I x) = x + +-- | Represents constant types that do not belong to the system. +data K a (s :: * -> *) (r :: * -> *) ix = K {unK :: a} + +-- | Represents sums (choices between constructors). +data (f :+: g) (s :: * -> *) (r :: * -> *) ix = L (f s r ix) | R (g s r ix) + +-- | Represents products (sequences of fields of a constructor). +data (f :*: g) (s :: * -> *) (r :: * -> *) ix = f s r ix :*: g s r ix + +-- | Is used to indicate the type (within the system) that a +-- particular constructor injects to. +data (:>:) :: ((* -> *) -> (* -> *) -> * -> *) -> * -> (* -> *) -> (* -> *) -> * -> * where + Tag :: f s r ix -> (f :>: ix) s r ix + +-- | Destructor for '(:>:)'. +unTag :: (f :>: ix) s r ix -> f s r ix +unTag (Tag x) = x + +-- ** Unlifted variants + +-- | Unlifted version of 'I'. +newtype I0 a = I0 { unI0 :: a } + +-- | Unlifted version of 'K'. +newtype K0 a b = K0 { unK0 :: a } + +instance Functor I0 where + fmap f = I0 . f . unI0 + +instance Applicative I0 where + pure = I0 + (I0 f) <*> (I0 x) = I0 (f x) + +-- * Indexed systems + +-- | Type family describing the pattern functor of a system. +type family PF s :: (* -> *) -> (* -> *) -> * -> * +type Str s ix = (PF s) s I0 ix + +class Ix s ix where + from_ :: ix -> Str s ix + to_ :: Str s ix -> ix + + -- | Some functions need to have their types desugared in order to make programs + -- that use them typable. Desugaring consists in transforming ``inline'' type + -- family applications into equality constraints. This is a strangeness in current + -- versions of GHC that hopefully will be fixed sometime in the future. + from :: (pfs ~ PF s) => ix -> pfs s I0 ix + from = from_ + to :: (pfs ~ PF s) => pfs s I0 ix -> ix + to = to_ + + index :: s ix diff --git a/src/Generics/MultiRec/Compos.hs b/src/Generics/MultiRec/Compos.hs new file mode 100644 --- /dev/null +++ b/src/Generics/MultiRec/Compos.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Generics.MultiRec.Compos +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- The compos operator, inspired by +-- +-- B. Bringert and A. Ranta +-- A pattern for almost compositional functions +-- ICFP 2006 +-- +----------------------------------------------------------------------------- +module Generics.MultiRec.Compos where + +import Control.Monad (liftM) +import Control.Applicative (Applicative(..), liftA) + +import Generics.MultiRec.Base +import Generics.MultiRec.HFunctor + +-- * Compos + +-- | Normal version. +compos :: (Ix s ix, HFunctor (PF s)) => + (forall ix. Ix s ix => s ix -> ix -> ix) -> ix -> ix +compos f = to . hmap (\ ix -> I0 . f ix . unI0) . from + +-- | Monadic version of 'compos'. +composM :: (Ix s ix, HFunctor (PF s), Monad m) => + (forall ix. Ix s ix => s ix -> ix -> m ix) -> ix -> m ix +composM f = liftM to . hmapM (\ ix -> liftM I0 . f ix . unI0) . from + +-- | Applicative version of 'compos'. +composA :: (Ix s ix, HFunctor (PF s), Applicative a) => + (forall ix. Ix s ix => s ix -> ix -> a ix) -> ix -> a ix +composA f = liftA to . hmapA (\ ix -> liftA I0 . f ix . unI0) . from diff --git a/src/Generics/MultiRec/Eq.hs b/src/Generics/MultiRec/Eq.hs new file mode 100644 --- /dev/null +++ b/src/Generics/MultiRec/Eq.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Generics.MultiRec.Eq +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- Generic equality. +-- +----------------------------------------------------------------------------- +module Generics.MultiRec.Eq where + +import Generics.MultiRec.Base + +-- * Generic equality + +class HEq f where + heq :: s ix -> + (forall ix. Ix s ix => s ix -> r ix -> r ix -> Bool) -> + f s r ix -> f s r ix -> Bool + +instance HEq (I xi) where + heq _ eq (I x1) (I x2) = eq index x1 x2 + +instance Eq x => HEq (K x) where + heq _ eq (K x1) (K x2) = x1 == x2 + +instance (HEq f, HEq g) => HEq (f :+: g) where + heq ix eq (L x1) (L x2) = heq ix eq x1 x2 + heq ix eq (R y1) (R y2) = heq ix eq y1 y2 + heq _ eq _ _ = False + +instance (HEq f, HEq g) => HEq (f :*: g) where + heq ix eq (x1 :*: y1) (x2 :*: y2) = heq ix eq x1 x2 && heq ix eq y1 y2 + +-- The following instance does not compile with ghc-6.8.2 +instance HEq f => HEq (f :>: ix) where + heq ix eq (Tag x1) (Tag x2) = heq ix eq x1 x2 + +eq :: (Ix s ix, HEq (PF s)) => s ix -> ix -> ix -> Bool +eq ix x1 x2 = heq ix (\ ix (I0 x1) (I0 x2) -> eq ix x1 x2) (from x1) (from x2) + +-- Note: +-- +-- We do not declare an equality instance such as +-- +-- instance (Ix s ix, HEq (PF s)) => Eq ix where +-- (==) = eq index +-- +-- because "s" is not mentioned on the right hand side. +-- One datatype may belong to multiple systems, and +-- although the generic equality instances should be +-- the same, there is no good way to decide which instance +-- to use. +-- +-- For a concrete "s", it is still possible to manually +-- define an "Eq" instance as above. diff --git a/src/Generics/MultiRec/Fold.hs b/src/Generics/MultiRec/Fold.hs new file mode 100644 --- /dev/null +++ b/src/Generics/MultiRec/Fold.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LiberalTypeSynonyms #-} +{-# LANGUAGE GADTs #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Generics.MultiRec.Fold +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- The definition of generic fold. +-- +----------------------------------------------------------------------------- + +module Generics.MultiRec.Fold where + +import Generics.MultiRec.Base +import Generics.MultiRec.HFunctor + +-- * Generic fold and unfold + +type Algebra s r = forall ix. Ix s ix => s ix -> PF s s r ix -> r ix + +fold :: (Ix s ix, HFunctor (PF s)) => + Algebra s r -> ix -> r ix +fold f = f index . hmap (\ _ (I0 x) -> fold f x) . from + +type CoAlgebra s r = forall ix. Ix s ix => s ix -> r ix -> PF s s r ix + +unfold :: (Ix s ix, HFunctor (PF s)) => + CoAlgebra s r -> r ix -> ix +unfold f = to . hmap (\ _ x -> I0 (unfold f x)) . f index + +type ParaAlgebra s r = forall ix. Ix s ix => s ix -> PF s s r ix -> ix -> r ix + +para :: (Ix s ix, HFunctor (PF s)) => + ParaAlgebra s r -> ix -> r ix +para f x = f index (hmap (\ _ (I0 x) -> para f x) (from x)) x + + +-- * Creating an algebra + +infixr 5 & +infixr :-> + +type AlgPart a (s :: * -> *) r ix = a s r ix -> r ix +type (f :-> g) (s :: * -> *) (r :: * -> *) ix = f s r ix -> g s r ix + +(&) :: (AlgPart a :-> AlgPart b :-> AlgPart (a :+: b)) s r ix +(f & g) (L x) = f x +(f & g) (R x) = g x + +tag :: AlgPart a s r ix -> AlgPart (a :>: ix) s r ix' +tag f (Tag x) = f x + diff --git a/src/Generics/MultiRec/HFunctor.hs b/src/Generics/MultiRec/HFunctor.hs new file mode 100644 --- /dev/null +++ b/src/Generics/MultiRec/HFunctor.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Generics.MultiRec.HFunctor +-- Copyright : (c) 2008 Universiteit Utrecht +-- License : BSD3 +-- +-- Maintainer : generics@haskell.org +-- Stability : experimental +-- Portability : non-portable +-- +-- The definition of functorial map. +-- +----------------------------------------------------------------------------- +module Generics.MultiRec.HFunctor where + +import Control.Monad (liftM, liftM2) +import Control.Applicative (Applicative(..), liftA, liftA2, WrappedMonad(..)) + +import Generics.MultiRec.Base + +-- * Generic map + +-- We define a general 'hmapA' that works on applicative functors. +-- The simpler 'hmap' is a special case. + +class HFunctor f where + hmapA :: (Applicative a) => + (forall ix. Ix s ix => s ix -> r ix -> a (r' ix)) -> + f s r ix -> a (f s r' ix) + +instance HFunctor (I xi) where + hmapA f (I x) = liftA I (f index x) + +instance HFunctor (K x) where + hmapA _ (K x) = pure (K x) + +instance (HFunctor f, HFunctor g) => HFunctor (f :+: g) where + hmapA f (L x) = liftA L (hmapA f x) + hmapA f (R y) = liftA R (hmapA f y) + +instance (HFunctor f, HFunctor g) => HFunctor (f :*: g) where + hmapA f (x :*: y) = liftA2 (:*:) (hmapA f x) (hmapA f y) + +instance HFunctor f => HFunctor (f :>: ix) where + hmapA f (Tag x) = liftA Tag (hmapA f x) + +-- | The function 'hmap' takes a functor @f@. All the recursive instances +-- in that functor are wrapped by an application of @r@. The argument to +-- 'hmap' takes a function that transformes @r@ occurrences into @r'@ +-- occurrences, for every @ix@. In order to associate the index @ix@ +-- with the correct system @s@, the argument to @hmap@ is additionally +-- parameterized by a witness of type @s ix@. +hmap :: (HFunctor f) => + (forall ix. Ix s ix => s ix -> r ix -> r' ix) -> + f s r ix -> f s r' ix +hmap f x = unI0 (hmapA (\ ix x -> I0 (f ix x)) x) + +-- | Monadic version of 'hmap'. +hmapM :: (HFunctor f, Monad m) => + (forall ix. Ix s ix => s ix -> r ix -> m (r' ix)) -> + f s r ix -> m (f s r' ix) +hmapM f x = unwrapMonad (hmapA (\ ix x -> WrapMonad (f ix x)) x)