diff --git a/functor-combo.cabal b/functor-combo.cabal --- a/functor-combo.cabal +++ b/functor-combo.cabal @@ -1,5 +1,5 @@ Name: functor-combo -Version: 0.0.4 +Version: 0.0.5 Cabal-Version: >= 1.2 Synopsis: Functor combinators with tries & zippers Category: Data @@ -34,9 +34,9 @@ FunctorCombo.Derivative FunctorCombo.Holey FunctorCombo.DHoley - FunctorCombo.FixC FunctorCombo.Regular - FunctorCombo.LocT + FunctorCombo.ZipperFix + FunctorCombo.ZipperReg FunctorCombo.StrictMemo FunctorCombo.NonstrictMemo ghc-options: -Wall diff --git a/src/FunctorCombo/FixC.hs b/src/FunctorCombo/FixC.hs deleted file mode 100644 --- a/src/FunctorCombo/FixC.hs +++ /dev/null @@ -1,112 +0,0 @@ --- {-# LANGUAGE #-} -{-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------- --- | --- Module : FunctorCombo.FixC --- Copyright : (c) Conal Elliott 2010 --- License : BSD3 --- --- Maintainer : conal@conal.net --- Stability : experimental --- --- Zippers for functor fixpoints ----------------------------------------------------------------------- - -module FunctorCombo.FixC (FixC,LocFix, up,up',down) where - -import Control.Arrow (first) - --- import FunctorCombo.Derivative --- import FunctorCombo.Holey - -import FunctorCombo.DHoley - - - -newtype Fix f = Fix { unFix :: f (Fix f) } - --- If Haskell had recursive type synonyms: --- --- Fix f =~ f (Fix f) - - --- | Context for functor fixpoints - --- data FixC f = FixC (Der f (Fix f)) (FixC f) - --- type FixC f = Stream (Der f (Fix f)) - --- Or, if we want topped data types: - --- data FixC f = TopC | FixC (Der f (Fix f)) (FixC f) - --- Isomorphically: - - --- | Context for a regular type -type FixC f = [Der f (Fix f)] - --- Reminder: --- --- type Loc f a = (Der f a, a) - --- Instead, - --- | Location in a functor tree -- a zipper -type LocFix f = (FixC f, Fix f) - --- TODO: can I relate FixC to Der (Fix f) and use Loc for LocFix? - --- | Move upward. Error if empty context. -up :: Holey f => LocFix f -> LocFix f -up ([] , _) = error "up: given empty context" -up (d:ds', t) = (ds', Fix (fill (d,t))) - --- | Variant of 'up'. 'Nothing' if empty context. -up' :: Holey f => LocFix f -> Maybe (LocFix f) -up' ([] , _) = Nothing -up' l = Just (up l) - -{- - -(d:ds', t) :: LocFix f -(d:ds', t) :: (FixC f, Fix f) - -d:ds' :: [Der f (Fix f)] - -t :: Fix f - -d :: Der f (Fix f) -ds' :: [Der f (Fix f)] - -fill :: Loc f b -> f b - -fill (d,t) :: f (Fix f) - -Fix (fill (d,t)) :: Fix f - --} - -down :: Holey f => LocFix f -> f (LocFix f) -down (ds', t) = fmap (first (:ds')) (extract (unFix t)) - --- down (ds', t) = fmap (\ (d,t') -> (d:ds',t')) (extract (unFix t)) - - - -{- -(ds',t) :: LocFix f -(ds',t) :: (FixC f, Fix f) -(ds',t) :: ([Der f (Fix f)], Fix f) - -ds' :: [Der f (Fix f)] -t :: Fix f -unFix t :: f (Fix f) - -extract (unFix t) :: f (Der f (Fix f), Fix f) - -fmap (\ (d,t') -> (d:ds',t')) (extract (unFix t)) - :: ([Der f (Fix f)], Fix f) - :: (FixC f, Fix f) - :: LocFix f --} diff --git a/src/FunctorCombo/LocT.hs b/src/FunctorCombo/LocT.hs deleted file mode 100644 --- a/src/FunctorCombo/LocT.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE TypeFamilies, TypeOperators, FlexibleContexts #-} -{-# OPTIONS_GHC -Wall #-} ----------------------------------------------------------------------- --- | --- Module : FunctorCombo.LocT --- Copyright : (c) Conal Elliott 2010 --- License : BSD3 --- --- Maintainer : conal@conal.net --- Stability : experimental --- --- ----------------------------------------------------------------------- - -module FunctorCombo.LocT - ( - Context,LocT, up, up', down - ) where - - -import Control.Arrow (first) - --- import FunctorCombo.Derivative --- import FunctorCombo.Holey - -import FunctorCombo.DHoley - -import FunctorCombo.Regular - --- TODO: Bring in pattern functors (as in PolyP), so I don't have to --- work on fixpoints directly. Something like --- --- type Context t = [Der (PF t) t] --- --- type LocT t = (Context t, t) --- --- Then use with some standard recursive data types like lists & trees. - --- TODO: Consider the implications of my style of zipper, using f (Der --- ...), contrasted with the traditional one. Try an application of mine --- to make sure it's useful. And that I avoid staring into the void. - --- TODO: rename wrap/unwrap, e.g., to reg/unreg - --- | Context for a regular type -type Context t = [Der (PF t) t] - --- | Location for a regular type -- a zipper -type LocT t = (Context t, t) - --- | Move upward. Error if empty context. -up :: (Regular t, Holey (PF t)) => LocT t -> LocT t -up ([] , _) = error "up: given empty context" -up (d:ds', t) = (ds', wrap (fill (d,t))) - --- | Variant of 'up'. 'Nothing' if empty context. -up' :: (Regular t, Holey (PF t)) => LocT t -> Maybe (LocT t) -up' ([] , _) = Nothing -up' l = Just (up l) - -down :: (Regular t, Holey (PF t)) => LocT t -> PF t (LocT t) -down (ds', t) = fmap (first (:ds')) (extract (unwrap t)) - -{- - -type P = Id :*: Id -- pairs -type Q = P :*: P -- quadruples (or P :. P) - -type Two a = (a,a) - -type Four a = Two (Two a) - -data QuadTree a = QuadTree a (Four (QuadTree a)) - -instance Regular (QuadTree a) where - type PF (QuadTree a) = Const a :*: Q - unwrap (QuadTree a ((p,q),(r,s))) = - Const a :*: ((Id p :*: Id q) :*: (Id r :*: Id s)) - wrap (Const a :*: ((Id p :*: Id q) :*: (Id r :*: Id s))) = - QuadTree a ((p,q),(r,s)) - --} diff --git a/src/FunctorCombo/ZipperFix.hs b/src/FunctorCombo/ZipperFix.hs new file mode 100644 --- /dev/null +++ b/src/FunctorCombo/ZipperFix.hs @@ -0,0 +1,111 @@ +-- {-# LANGUAGE #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : FunctorCombo.ZipperFix +-- Copyright : (c) Conal Elliott 2010 +-- License : BSD3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Zippers for functor fixpoints +---------------------------------------------------------------------- + +module FunctorCombo.ZipperFix (Context,Location, up,up',down) where + +import Control.Arrow (first) + +-- import FunctorCombo.Derivative +-- import FunctorCombo.Holey + +import FunctorCombo.DHoley + + +newtype Fix f = Fix { unFix :: f (Fix f) } + +-- If Haskell had recursive type synonyms: +-- +-- Fix f =~ f (Fix f) + + +-- | Context for functor fixpoints + +-- data Context f = Context (Der f (Fix f)) (Context f) + +-- type Context f = Stream (Der f (Fix f)) + +-- Or, if we want topped data types: + +-- data Context f = TopC | Context (Der f (Fix f)) (Context f) + +-- Isomorphically: + + +-- | Context for a regular type +type Context f = [Der f (Fix f)] + +-- Reminder: +-- +-- type Loc f a = (Der f a, a) + +-- Instead, + +-- | Location in a functor tree -- a zipper +type Location f = (Context f, Fix f) + +-- TODO: can I relate Context to Der (Fix f) and use Loc for Location? + +-- | Move upward. Error if empty context. +up :: Holey f => Location f -> Location f +up ([] , _) = error "up: given empty context" +up (d:ds', t) = (ds', Fix (fill (d,t))) + +-- | Variant of 'up'. 'Nothing' if empty context. +up' :: Holey f => Location f -> Maybe (Location f) +up' ([] , _) = Nothing +up' l = Just (up l) + +{- + +(d:ds', t) :: Location f +(d:ds', t) :: (Context f, Fix f) + +d:ds' :: [Der f (Fix f)] + +t :: Fix f + +d :: Der f (Fix f) +ds' :: [Der f (Fix f)] + +fill :: Loc f b -> f b + +fill (d,t) :: f (Fix f) + +Fix (fill (d,t)) :: Fix f + +-} + +down :: Holey f => Location f -> f (Location f) +down (ds', t) = fmap (first (:ds')) (extract (unFix t)) + +-- down (ds', t) = fmap (\ (d,t') -> (d:ds',t')) (extract (unFix t)) + + + +{- +(ds',t) :: Location f +(ds',t) :: (Context f, Fix f) +(ds',t) :: ([Der f (Fix f)], Fix f) + +ds' :: [Der f (Fix f)] +t :: Fix f +unFix t :: f (Fix f) + +extract (unFix t) :: f (Der f (Fix f), Fix f) + +fmap (\ (d,t') -> (d:ds',t')) (extract (unFix t)) + :: ([Der f (Fix f)], Fix f) + :: (Context f, Fix f) + :: Location f +-} diff --git a/src/FunctorCombo/ZipperReg.hs b/src/FunctorCombo/ZipperReg.hs new file mode 100644 --- /dev/null +++ b/src/FunctorCombo/ZipperReg.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE TypeFamilies, TypeOperators, FlexibleContexts #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : FunctorCombo.ZipperReg +-- Copyright : (c) Conal Elliott 2010 +-- License : BSD3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- +---------------------------------------------------------------------- + +module FunctorCombo.ZipperReg + ( + Context,Location, up, up', down + ) where + + +import Control.Arrow (first) + +-- import FunctorCombo.Derivative +-- import FunctorCombo.Holey + +import FunctorCombo.DHoley +import FunctorCombo.Regular + +-- TODO: Bring in pattern functors (as in PolyP), so I don't have to +-- work on fixpoints directly. Something like +-- +-- type Context t = [Der (PF t) t] +-- +-- type Location t = (Context t, t) +-- +-- Then use with some standard recursive data types like lists & trees. + +-- TODO: Consider the implications of my style of zipper, using f (Der +-- ...), contrasted with the traditional one. Try an application of mine +-- to make sure it's useful. And that I avoid staring into the void. + +-- TODO: rename wrap/unwrap, e.g., to reg/unreg + +-- | Context for a regular type +type Context t = [Der (PF t) t] + +-- | Location for a regular type -- a zipper +type Location t = (Context t, t) + +-- | Move upward. Error if empty context. +up :: (Regular t, Holey (PF t)) => Location t -> Location t +up ([] , _) = error "up: given empty context" +up (d:ds', t) = (ds', wrap (fill (d,t))) + +-- | Variant of 'up'. 'Nothing' if empty context. +up' :: (Regular t, Holey (PF t)) => Location t -> Maybe (Location t) +up' ([] , _) = Nothing +up' l = Just (up l) + +down :: (Regular t, Holey (PF t)) => Location t -> PF t (Location t) +down (ds', t) = fmap (first (:ds')) (extract (unwrap t)) + +{- + +type P = Id :*: Id -- pairs +type Q = P :*: P -- quadruples (or P :. P) + +type Two a = (a,a) + +type Four a = Two (Two a) + +data QuadTree a = QuadTree a (Four (QuadTree a)) + +instance Regular (QuadTree a) where + type PF (QuadTree a) = Const a :*: Q + unwrap (QuadTree a ((p,q),(r,s))) = + Const a :*: ((Id p :*: Id q) :*: (Id r :*: Id s)) + wrap (Const a :*: ((Id p :*: Id q) :*: (Id r :*: Id s))) = + QuadTree a ((p,q),(r,s)) + +-}