data-treify 0.3.3 → 0.3.4
raw patch · 3 files changed
+36/−19 lines, 3 filesdep ~ty
Dependency ranges changed: ty
Files
- data-treify.cabal +8/−4
- src/Data/Reify/TGraph.hs +13/−7
- src/Data/TReify.hs +15/−8
data-treify.cabal view
@@ -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 <conal@conal.net>-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
src/Data/Reify/TGraph.hs view
@@ -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)
src/Data/TReify.hs view
@@ -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