packages feed

multirec (empty) → 0.1

raw patch · 12 files changed

+648/−0 lines, 12 filesdep +basesetup-changed

Dependencies added: base

Files

+ CREDITS view
@@ -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
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ examples/AST.hs view
@@ -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+
+ examples/ASTExamples.hs view
@@ -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)
+ multirec.cabal view
@@ -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+     (<http://www.cs.uu.nl/research/techreps/repo/CS-2008/2008-019.pdf>).+ +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
+ src/Generics/MultiRec.hs view
@@ -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++
+ src/Generics/MultiRec/Base.hs view
@@ -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
+ src/Generics/MultiRec/Compos.hs view
@@ -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
+ src/Generics/MultiRec/Eq.hs view
@@ -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.
+ src/Generics/MultiRec/Fold.hs view
@@ -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+
+ src/Generics/MultiRec/HFunctor.hs view
@@ -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)