diff --git a/data-treify.cabal b/data-treify.cabal --- a/data-treify.cabal +++ b/data-treify.cabal @@ -1,5 +1,5 @@ Name: data-treify -Version: 0.3.3 +Version: 0.3.4 Synopsis: Reify a recursive data structure into an explicit graph. Description: This package is a (probably temporary) fork of Andy gill's data-reify package. I've tweaked it for typed syntax representations for use with GADTs. @@ -20,21 +20,25 @@ Version 0.3 provided two versions of 'MuRef', the mono-typed version, for trees of a single type, and the dynamic-typed version, for trees of different types. . - © 2009-2012 Andy Gill & Conal Elliott; BSD3 license. + © 2009-2014 Andy Gill & Conal Elliott; BSD3 license. Category: Language, Data, Parsing, Reflection License: BSD3 License-file: LICENSE Author: Andy Gill & Conal Elliott Maintainer: Conal Elliott -Copyright: (c) 2009-2012 Andy Gill and Conal Elliott +Copyright: (c) 2009-2014 Andy Gill and Conal Elliott Homepage: http://ittc.ku.edu/~andygill/data-reify.php Stability: alpha build-type: Simple Cabal-Version: >= 1.6 +source-repository head + type: git + location: git://github.com/conal/data-treify.git + Library - Build-Depends: base<5, containers, ty + Build-Depends: base<5, containers, ty >= 0.1.5 Hs-Source-Dirs: src Exposed-modules: Data.TReify diff --git a/src/Data/Reify/TGraph.hs b/src/Data/Reify/TGraph.hs --- a/src/Data/Reify/TGraph.hs +++ b/src/Data/Reify/TGraph.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GADTs, ExistentialQuantification, FlexibleContexts , UndecidableInstances, PatternGuards #-} -{-# LANGUAGE ScopedTypeVariables #-} -- for bindEnv +{-# LANGUAGE ScopedTypeVariables, ConstraintKinds, Rank2Types #-} -- for bindEnv {-# OPTIONS_GHC -Wall #-} @@ -34,13 +34,13 @@ instance Show (V ty a) where show = showF -instance ShowF (n (V ty)) => Show (Bind ty n) where - show (Bind v n) = showF v ++" = "++ showF n - -- | Typed binding pair, parameterized by variable and node type -- constructors. -data Bind ty n = forall a. Bind (V ty a) (n (V ty) a) +data Bind ty n = forall a. IsTyConstraint ty a => Bind (V ty a) (n (V ty) a) +instance ShowF (n (V ty)) => Show (Bind ty n) where + show (Bind v n) = showF v ++" = "++ showF n + {- -- Slow version bindEnv' :: IsTy ty => [Bind ty n] -> (V ty a -> n (V ty) a) @@ -52,17 +52,23 @@ -- | Fast version, using an IntMap. -- Important: partially apply. -bindEnv :: forall ty n a. IsTy ty => [Bind ty n] -> (V ty a -> n (V ty) a) +bindEnv :: forall ty n. [Bind ty n] -> + forall a. (IsTy ty, IsTyConstraint ty a) => + (V ty a -> n (V ty) a) bindEnv binds = \ (V i' a') -> extract a' (I.lookup i' m) where m :: I.IntMap (Bind ty n) m = I.fromList [(i,b) | b@(Bind (V i _) _) <- binds] - extract :: ty a' -> Maybe (Bind ty n) -> n (V ty) a' +-- extract :: forall a'. IsTyConstraint ty a' => +-- ty a' -> Maybe (Bind ty n) -> n (V ty) a' + extract :: IsTyConstraint ty a => + ty a -> Maybe (Bind ty n) -> n (V ty) a extract _ Nothing = error "bindEnv: variable not found" extract a' (Just (Bind (V _ a) n)) | Just Refl <- a `tyEq` a' = n | otherwise = error "bindEnv: wrong type" +-- TODO: Does the partial application *really* avoid the IntMap reconstruction? -- | Graph, described by bindings and a root variable data Graph ty n a = Graph [Bind ty n] (V ty a) diff --git a/src/Data/TReify.hs b/src/Data/TReify.hs --- a/src/Data/TReify.hs +++ b/src/Data/TReify.hs @@ -1,6 +1,7 @@ {-# LANGUAGE UndecidableInstances, TypeFamilies, BangPatterns, Rank2Types , ExistentialQuantification, PatternGuards, ScopedTypeVariables , MultiParamTypeClasses, GADTs + , ConstraintKinds #-} {-# OPTIONS_GHC -Wall #-} @@ -29,17 +30,19 @@ type DeRef h :: (* -> *) -> * -> * -- DeRef h v a mapDeRef :: forall m v. (Applicative m) - => (forall a. ty a -> h a -> m ( v a)) - -> (forall a. ty a -> h a -> m (DeRef h v a)) + => (forall a. IsTyConstraint ty a => ty a -> h a -> m ( v a)) + -> (forall a. IsTyConstraint ty a => ty a -> h a -> m (DeRef h v a)) -data StableBind ty h = forall a. StableBind (V ty a) (StableName (h a)) +data StableBind ty h = + forall a. IsTyConstraint ty a => StableBind (V ty a) (StableName (h a)) -- | 'reifyGraph' takes a data structure that admits 'MuRef', and returns -- a 'Graph' that contains the dereferenced nodes, with their children as -- 'Integer' rather than recursive values. -reifyGraph :: (IsTy ty, MuRef ty h) => ty a -> h a -> IO (Graph ty (DeRef h) a) +reifyGraph :: (IsTy ty, IsTyConstraint ty a, MuRef ty h) => + ty a -> h a -> IO (Graph ty (DeRef h) a) reifyGraph tya ha = do rt1 <- newMVar M.empty rt2 <- newMVar [] root <- findNodes rt1 rt2 tya ha @@ -47,14 +50,15 @@ return (Graph binds root) -findNodes :: forall ty h a. (IsTy ty, MuRef ty h) +findNodes :: forall ty h a. (IsTy ty, IsTyConstraint ty a, MuRef ty h) => MVar (IntMap [StableBind ty h]) -> MVar [Bind ty (DeRef h)] -> ty a -> h a -> IO (V ty a) findNodes rt1 rt2 tya ha = - do nextI <- newMVar 0 + do nextI <- newMVar (0 :: Int) let newIndex = modifyMVar nextI (\ n -> return (n+1,n)) - loop :: ty b -> h b -> IO (V ty b) + loop :: IsTyConstraint ty b => + ty b -> h b -> IO (V ty b) loop tyb !hb = do st <- makeStableName hb tab <- takeMVar rt1 @@ -73,7 +77,7 @@ in loop tya ha -mylookup :: forall ty h a. IsTy ty => +mylookup :: forall ty h a. (IsTy ty, IsTyConstraint ty a) => ty a -> StableName (h a) -> IntMap [StableBind ty h] -> Maybe (V ty a) mylookup tya sta tab = M.lookup (hashStableName sta) tab >>= llookup @@ -83,3 +87,6 @@ llookup (StableBind v@(V _ tyb) stb : binds') | Just Refl <- tya `tyEq` tyb, sta == stb = Just v | otherwise = llookup binds' + +-- unsafeReify :: (IsTy ty, MuRef ty h) => ty a -> h a -> Graph ty (DeRef h) a +-- unsafeReify = unsafePerformIO . reifyGraph