summaryrefslogtreecommitdiff
path: root/TrieMap/Reflection.hs
diff options
context:
space:
mode:
Diffstat (limited to 'TrieMap/Reflection.hs')
-rw-r--r--TrieMap/Reflection.hs44
1 files changed, 30 insertions, 14 deletions
diff --git a/TrieMap/Reflection.hs b/TrieMap/Reflection.hs
index 1118c6d..a07c552 100644
--- a/TrieMap/Reflection.hs
+++ b/TrieMap/Reflection.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances #-}
+{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}
module TrieMap.Reflection where
@@ -11,21 +11,37 @@ import TrieMap.RadixTrie()
import qualified TrieMap.TrieAlgebraic as TA
instance Algebraic v => Algebraic (Elem v) where
- type Alg (Elem v) = Alg v
+ type AlgRep (Elem v) = AlgRep v
toAlg (Elem v) = toAlg v
fromAlg v = Elem (fromAlg v)
-instance Algebraic (m1 (m2 v)) => Algebraic (ProdMap m1 m2 v) where
- type Alg (ProdMap m1 m2 v) = Alg (m1 (m2 v))
- toAlg (PMap m) = toAlg m
- fromAlg = PMap . fromAlg
+-- instance Algebraic (t1 k (m2 v)) => Algebraic (ProdMap m1 m2 v) where
+-- type AlgRep (ProdMap m1 m2 v) = AlgRep (m1 (m2 v))
+-- toAlg (PMap m) = toAlg m
+-- fromAlg = PMap . fromAlg
+--
+-- instance (Ord k, Algebraic k, Sized v, Algebraic v, TrieKey k m) => Algebraic (RadixTrie k m v) where
+-- type AlgRep (RadixTrie k m v) = AlgRep [([k], v)]
+-- toAlg m = toAlg (build (\ c n -> foldWithKeyAlg (curry c) n m))
+-- fromAlg = fromDistAscListAlg . fromAlg
-instance (Algebraic (m1 v), Algebraic (m2 v)) => Algebraic (UnionMap m1 m2 v) where
- type Alg (UnionMap m1 m2 v) = (Alg (m1 v), Alg (m2 v))
- toAlg (m1 :+: m2) = (toAlg m1, toAlg m2)
- fromAlg (m1, m2) = fromAlg m1 :+: fromAlg m2
+instance (Algebraic k, TrieKey k m) => SAlgebraicT (RadixTrie k m) where
+ type SAlgRepT (RadixTrie k m) = AlgRepT ([] `O` ((,) [k]))
+ toSAlgT = toAlgT . o . assocsAlg
+ fromSAlgT = fromDistAscListAlg . unO . fromAlgT
-instance (Ord k, Algebraic k, Sized v, Algebraic v, TrieKey k m) => Algebraic (RadixTrie k m v) where
- type Alg (RadixTrie k m v) = Alg [([k], v)]
- toAlg m = toAlg (build (\ c n -> foldWithKeyAlg (curry c) n m))
- fromAlg = fromDistAscListAlg . fromAlg \ No newline at end of file
+-- instance (AlgebraicT m, Algebraic k) => SAlgebraicT (Edge k m) where
+-- type SAlgRepT (Edge k m) = AlgRepT (O Fix (O ((:*:) (Const Int :*: Co{--}nst [k] :*: AlgRepT m)) (O Const Maybe)))
+
+
+instance (AlgebraicT m, Algebraic k, Algebraic a) => Algebraic (Edge k m a) where
+ type AlgRep (Edge k m a) = Fix (AlgRepT (Const (Int, [k], Maybe a)) :*: AlgRepT m)
+ toAlg (Edge s ks v ts) = Fix (toAlgT (Const (s, ks, v)) :*: fmap toAlg (toAlgT ts))
+ fromAlg (Fix (a :*: b)) = case (fromAlgT a, fmap fromAlg b) of
+ (Const (s, ks, v), ts) ->
+ Edge s ks v (fromAlgT ts)
+
+instance (AlgebraicT m, Algebraic k, Algebraic a) => Algebraic (RadixTrie k m a) where
+ type AlgRep (RadixTrie k m a) = AlgRep (Maybe (Edge k m a))
+ toAlg (Radix e) = toAlg e
+ fromAlg = Radix . fromAlg \ No newline at end of file