removed src for 2.9

1 files changed, 0 insertions, 257 deletions

diff --git a/src/GF/Data/Zipper.hs b/src/GF/Data/Zipper.hs
deleted file mode 100644
index a4491f76e..000000000
--- a/src/GF/Data/Zipper.hs
+++ /dev/null
@@ -1,257 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Zipper
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/06/11 20:27:05 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.9 $
---
--- Gérard Huet's zipper (JFP 7 (1997)). AR 10\/8\/2001
------------------------------------------------------------------------------
-
-module GF.Data.Zipper (-- * types
-	       Tr(..),
-	       Path(..),
-	       Loc(..),
-	       -- * basic (original) functions
-	       leaf,
-	       goLeft, goRight, goUp, goDown,
-	       changeLoc,
-	       changeNode,
-	       forgetNode,
-	       -- * added sequential representation
-	       goAhead,
-	       goBack,
-	       -- ** n-ary versions
-	       goAheadN,
-	       goBackN,
-	       -- * added mappings between locations and trees
-	       loc2tree,
-	       loc2treeMarked,
-	       tree2loc,
-	       goRoot,
-	       goLast,
-	       goPosition,
-	       getPosition,
-	       keepPosition,
-	       -- * added some utilities
-	       traverseCollect,
-	       scanTree,
-	       mapTr,
-	       mapTrM,
-	       mapPath,
-	       mapPathM,
-	       mapLoc,
-	       mapLocM,
-	       foldTr,
-	       foldTrM,
-	       mapSubtrees,
-	       mapSubtreesM,
-	       changeRoot,
-	       nthSubtree,
-	       arityTree
-	      ) where
-
-import GF.Data.Operations
-
-newtype Tr a = Tr (a,[Tr a]) deriving (Show,Eq)
-    
-data Path a = 
-    Top 
-  | Node ([Tr a], (Path a, a), [Tr a]) 
-   deriving Show
-
-leaf :: a -> Tr a
-leaf a = Tr (a,[])
-
-newtype Loc a = Loc (Tr a, Path a)     deriving Show
-
-goLeft, goRight, goUp, goDown :: Loc a -> Err (Loc a)
-goLeft (Loc (t,p)) = case p of
-  Top -> Bad "left of top"
-  Node (l:left, upv, right) -> return $ Loc (l, Node (left,upv,t:right))
-  Node _ -> Bad "left of first"
-goRight (Loc (t,p)) = case p of
-  Top -> Bad "right of top"
-  Node (left, upv, r:right) -> return $ Loc (r, Node (t:left,upv,right))
-  Node _ -> Bad "right of first"
-goUp (Loc (t,p)) = case p of
-  Top -> Bad "up of top"
-  Node (left, (up,v), right) -> 
-    return $ Loc (Tr (v, reverse left ++ (t:right)), up)
-goDown (Loc (t,p)) = case t of
-  Tr (v,(t1:trees)) -> return $ Loc (t1,Node ([],(p,v),trees))
-  _ -> Bad "down of empty"
-
-changeLoc :: Loc a -> Tr a -> Err (Loc a)
-changeLoc (Loc (_,p)) t = return $ Loc (t,p)
-
-changeNode :: (a -> a) -> Loc a -> Loc a
-changeNode f (Loc (Tr (n,ts),p)) = Loc (Tr (f n, ts),p)
-
-forgetNode :: Loc a -> Err (Loc a)
-forgetNode (Loc (Tr (n,[t]),p)) = return $ Loc (t,p)
-forgetNode _ = Bad $ "not a one-branch tree"
-
--- added sequential representation
-
--- | a successor function
-goAhead :: Loc a -> Err (Loc a) 
-goAhead s@(Loc (t,p)) = case (t,p) of
-  (Tr (_,_:_),Node (_,_,_:_)) -> goDown s
-  (Tr (_,[]), _)              -> upsRight s
-  (_,         _)              -> goDown s
- where
-   upsRight t = case goRight t of
-     Ok t' -> return t'
-     Bad _ -> goUp t >>= upsRight
-
--- | a predecessor function
-goBack :: Loc a -> Err (Loc a) 
-goBack s@(Loc (t,p)) = case goLeft s of
-  Ok s' -> downRight s'
-  _     -> goUp s
- where
-   downRight s = case goDown s of
-     Ok s' -> case goRight s' of
-       Ok s'' -> downRight s''
-       _ -> downRight s'       
-     _     -> return s
-
--- n-ary versions
-
-goAheadN :: Int ->  Loc a -> Err (Loc a)
-goAheadN i st
-  | i < 1     = return st
-  | otherwise = goAhead st >>= goAheadN (i-1)
-
-goBackN :: Int ->  Loc a -> Err (Loc a)
-goBackN i st
-  | i < 1     = return st
-  | otherwise = goBack st >>= goBackN (i-1)
-
--- added mappings between locations and trees
-
-loc2tree :: Loc a -> Tr a
-loc2tree (Loc (t,p)) = case p of
-  Top -> t
-  Node (left,(p',v),right) -> 
-    loc2tree (Loc (Tr (v, reverse left ++ (t : right)),p'))
-
-loc2treeMarked :: Loc a -> Tr (a, Bool)
-loc2treeMarked (Loc (Tr (a,ts),p)) = 
-  loc2tree (Loc (Tr (mark a, map (mapTr nomark) ts), mapPath nomark p)) 
- where 
-   (mark, nomark) = (\a -> (a,True), \a -> (a, False))
-
-tree2loc :: Tr a -> Loc a
-tree2loc t = Loc (t,Top)
-
-goRoot :: Loc a -> Loc a
-goRoot = tree2loc . loc2tree
-
-goLast :: Loc a -> Err (Loc a)
-goLast = rep goAhead where
-  rep f s = err (const (return s)) (rep f) (f s)
-
-goPosition :: [Int] -> Loc a -> Err (Loc a)
-goPosition p = go p . goRoot where
-  go []     s = return s
-  go (p:ps) s = goDown s >>= apply p goRight >>= go ps
-
-getPosition :: Loc a -> [Int]
-getPosition = reverse . getp where 
-  getp (Loc (t,p)) = case p of
-    Top -> []
-    Node (left,(p',v),_) -> length left : getp (Loc (Tr (v, []),p'))
-
-keepPosition :: (Loc a -> Err (Loc a)) -> (Loc a -> Err (Loc a))
-keepPosition f s = do
-  let p = getPosition s
-  s' <- f s
-  goPosition p s'
-
-apply :: Monad m => Int -> (a -> m a) -> a -> m a
-apply n f a = case n of
-  0 -> return a
-  _ -> f a >>= apply (n-1) f
-
--- added some utilities
-
-traverseCollect :: Path a -> [a]
-traverseCollect p = reverse $ case p of
-  Top -> []
-  Node (_, (p',v), _) -> v : traverseCollect p'
-
-scanTree :: Tr a -> [a]
-scanTree (Tr (a,ts)) = a : concatMap scanTree ts
-
-mapTr :: (a -> b) -> Tr a -> Tr b
-mapTr f (Tr (x,ts)) = Tr (f x, map (mapTr f) ts)
-
-mapTrM :: Monad m => (a -> m b) -> Tr a -> m (Tr b)
-mapTrM f (Tr (x,ts)) = do
-  fx  <- f x
-  fts <- mapM (mapTrM f) ts
-  return $ Tr (fx,fts)
-
-mapPath :: (a -> b) -> Path a -> Path b
-mapPath f p = case p of
-  Node (ts1, (p,v), ts2) -> 
-    Node (map (mapTr f) ts1, (mapPath f p, f v), map (mapTr f) ts2)
-  Top -> Top
-
-mapPathM :: Monad m => (a -> m b) -> Path a -> m (Path b)
-mapPathM f p = case p of
-  Node (ts1, (p,v), ts2) -> do
-    ts1' <- mapM (mapTrM f) ts1
-    p'   <- mapPathM f p
-    v'   <- f v 
-    ts2' <- mapM (mapTrM f) ts2
-    return $ Node (ts1', (p',v'), ts2')
-  Top -> return Top
-
-mapLoc :: (a -> b) -> Loc a -> Loc b
-mapLoc f (Loc (t,p)) = Loc (mapTr f t, mapPath f p)
-
-mapLocM :: Monad m => (a -> m b) -> Loc a -> m (Loc b)
-mapLocM f (Loc (t,p)) = do
-  t' <- mapTrM f t
-  p' <- mapPathM f p
-  return $ (Loc (t',p'))
-
-foldTr :: (a -> [b] -> b) -> Tr a -> b
-foldTr f (Tr (x,ts)) = f x (map (foldTr f) ts)
-
-foldTrM :: Monad m => (a -> [b] -> m b) -> Tr a -> m b
-foldTrM f (Tr (x,ts)) = do
-  fts <- mapM (foldTrM f) ts
-  f x fts
-
-mapSubtrees :: (Tr a -> Tr a) -> Tr a -> Tr a
-mapSubtrees f t = let Tr (x,ts) = f t in Tr (x, map (mapSubtrees f) ts)
-
-mapSubtreesM :: Monad m => (Tr a -> m (Tr a)) -> Tr a -> m (Tr a)
-mapSubtreesM f t = do
-  Tr (x,ts) <- f t
-  ts' <- mapM (mapSubtreesM f) ts
-  return $ Tr (x, ts')
-
--- | change the root without moving the pointer
-changeRoot :: (a -> a) -> Loc a -> Loc a
-changeRoot f loc = case loc of
-  Loc (Tr (a,ts),Top) -> Loc (Tr (f a,ts),Top)
-  Loc (t, Node (left,pv,right)) -> Loc (t, Node (left,chPath pv,right))
- where
-   chPath pv = case pv of 
-     (Top,a) -> (Top, f a)
-     (Node (left,pv,right),v) -> (Node (left, chPath pv,right),v)
-
-nthSubtree :: Int -> Tr a -> Err (Tr a)
-nthSubtree n (Tr (a,ts)) = ts !? n
-
-arityTree :: Tr a -> Int
-arityTree (Tr (_,ts)) = length ts