Ztrategic (empty) → 0.1.0

raw patch · 10 files changed

+1755/−0 lines, 10 filesdep +ZipperAGdep +basedep +monadplus

Dependencies added: ZipperAG, base, monadplus, mtl, random, syb, syz, transformers

Files

• LICENSE +21/−0
• Language/Memo/AGMemo.hs +69/−0
• Language/Memo/Safe/AGMemo.hs +95/−0
• Language/Memo/Safe/Ztrategic.hs +265/−0
• Language/Memo/State/Ztrategic.hs +316/−0
• Language/Memo/Ztrategic.hs +241/−0
• Language/StrategicData.hs +67/−0
• Language/Ztrategic.hs +365/−0
• README.md +264/−0
• Ztrategic.cabal +52/−0

@@ -0,0 +1,21 @@+MIT License
+
+Copyright (c) 2025 José Nuno Macedo
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

@@ -0,0 +1,69 @@+{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables #-}
+module Language.Memo.AGMemo where 
+
+import Data.Generics.Zipper
+import Data.Generics.Aliases
+import Language.ZipperAG
+import Data.Data
+import Data.Maybe (fromJust)
+
+mkAG :: Data x => x -> Zipper x
+mkAG = toZipper
+
+-- MemoAG
+
+eval .@. t      = let (v,t') = eval t
+                  in  (v, parent t') 
+
+atParent eval t = let n = arity t 
+                      (v,t') = eval (parent t)
+                  in  (v, t'.$n)
+
+atRight eval t  = let (v,t') = eval (t.$>1)
+                  in  (v, (t'.$<1))
+
+atLeft eval t   = let (v,t') = eval (t.$<1)
+                  in  (v, (t'.$>1))
+
+class Memo att m a where
+  mlookup :: att -> m -> Maybe a
+  massign :: att -> a -> m -> m
+
+class (Typeable dtype, Typeable m) => Memoizable dtype m where 
+  getMemoTable :: dtype m -> m 
+  updMemoTable :: (m -> m) -> dtype m -> dtype m
+  cleanMemoTable :: Zipper (dtype m) -> Zipper (dtype m)
+  cleanMemoTable = id 
+
+type AGTree_m dtype m a = Zipper (dtype m) -> (a, Zipper (dtype m)) 
+
+
+memo :: (Memoizable dtype m, Memo attr m a) => 
+        attr -> 
+        AGTree_m dtype m a -> 
+        AGTree_m dtype m a
+memo attr eval z =
+   case mlookup attr (memoTable z) of
+    Just v   -> (v,z)
+    Nothing  -> let (v,z') = eval z
+                in  (v, transTree attr v z') 
+                -- in  (v, trans (ttree attr v) z') 
+{-
+ttree :: forall dtype m attr a b. (Memoizable dtype m, Memo attr m a) => attr -> a -> (b -> b)
+ttree attr v = let x = (massign attr v) :: m -> m
+                   f = (updMemoTable x) :: (dtype m -> dtype m)
+               in mkT f
+-}
+
+
+memoTable :: forall dtype m. (Memoizable dtype m) => Zipper (dtype m) -> m
+memoTable zx = let a' = (fromJust $ getHole zx) :: dtype m
+               in getMemoTable a' 
+
+
+upd :: (Memoizable dtype m, Memo att m a) => att -> a -> Zipper (dtype m) -> dtype m
+upd attr v = updMemoTable (massign attr v) . fromJust . getHole 
+
+transTree :: (Memoizable dtype m, Memo att m a) => att -> a -> Zipper (dtype m)
+                                     -> Zipper (dtype m)
+transTree attr v z = setHole (upd attr v z) z

@@ -0,0 +1,95 @@+{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, AllowAmbiguousTypes, DeriveDataTypeable #-}
+module Language.Memo.Safe.AGMemo where 
+
+import Data.Generics.Zipper
+import Data.Generics.Aliases
+import Language.ZipperAG
+import Language.StrategicData
+import Data.Data
+import Data.Maybe (fromJust)
+import Data.List (union)
+
+mkAG :: Data x => x -> Zipper x
+mkAG = toZipper
+
+-- MemoAG
+
+atChild eval t i = let (v,t',d) = eval (t.$i)
+                   in  (v, parent t',[Child i]) 
+
+atParent eval t = let n = arity t 
+                      (v,t',d) = eval (parent t)
+                  in  (v, t'.$n, [Parent])
+
+atRight eval t  = let (v,t',d) = eval (t.$>1)
+                  in  (v, (t'.$<1),[AtRight])
+
+atLeft eval t   = let (v,t',d) = eval (t.$<1)
+                  in  (v, (t'.$>1),[AtLeft])
+
+class MemoTable m => Memo att m a where
+  mlookup :: att -> m -> Maybe a
+  massign :: att -> a -> m -> m
+
+data Dependency = Parent | Child Int | AtRight | AtLeft
+ deriving (Data, Eq, Show)
+
+class Typeable m => MemoTable m where 
+  isValidMemoTable :: m -> Bool
+  invalidateMemoTable :: m -> m 
+  validateMemoTable :: m -> m 
+  getDependencies :: m -> [Dependency]
+  addDependency :: Dependency -> m -> m
+  -- consider deleting memo class for this here:
+  -- mstore :: 
+  -- mlookup :: 
+
+addDependencies :: MemoTable m => [Dependency] -> m -> m 
+addDependencies d m = validateMemoTable $ foldr addDependency m d
+
+class (Typeable dtype, MemoTable m) => Memoizable dtype m where 
+  getMemoTable :: dtype m -> m 
+  updMemoTable :: (m -> m) -> dtype m -> dtype m
+  invalidateDependencies :: Zipper (dtype m) -> Zipper (dtype m)
+  invalidateDependencies z = 
+    if isValidMemoTable (memoTable z)
+      then let z'  = upd' invalidateMemoTable z
+               dep = getDependencies (memoTable z)
+               fromDep Parent r = parent r 
+               fromDep (Child n) r = r.$n
+               fromDep AtRight r = r.$>1
+               fromDep AtLeft  r = r.$<1
+               unFromDep Parent r = r.$(arity z') 
+               unFromDep (Child n) r = parent r
+               unFromDep AtRight r = r.$<1
+               unFromDep AtLeft  r = r.$>1
+           in foldr (\d x -> unFromDep d $ invalidateDependencies (fromDep d x)) z' dep
+      else z
+
+
+-- type AGTree_m dtype m a = Zipper (dtype m) -> (a, Zipper (dtype m)) 
+type AGTree_m dtype m a =  (Zipper (dtype m) -> (a, Zipper (dtype m), [Dependency]))
+
+
+memo :: (Memoizable dtype m, Memo attr m a) => 
+        attr -> 
+        AGTree_m dtype m a -> 
+        AGTree_m dtype m a
+memo attr eval = \z ->
+   case (isValidMemoTable (memoTable z), mlookup attr (memoTable z)) of
+    (True, Just v)   -> (v,z, getDependencies (memoTable z))
+    _                -> let (v,z', d) = eval z
+                        in  (v, upd' (addDependencies d . massign attr v) z', d) 
+
+
+
+memoTable :: forall dtype m. (Memoizable dtype m) => Zipper (dtype m) -> m
+memoTable zx = let a' = (fromJust $ getHole zx) :: dtype m
+               in getMemoTable a' 
+
+
+-- "forced typechecking"
+upd' :: Memoizable dtype m => (m -> m) -> Zipper (dtype m) -> Zipper (dtype m)
+upd' f z = setHole (aux f z) z
+ where aux :: (Memoizable dtype m) => (m -> m) -> Zipper (dtype m) -> dtype m
+       aux f = updMemoTable f . fromJust . getHole

@@ -0,0 +1,265 @@+{-# LANGUAGE Rank2Types,DeriveDataTypeable #-}
+module Language.Memo.Safe.Ztrategic where
+
+import Language.ZipperAG
+import Data.Generics.Zipper hiding (left, right, up, down')
+import Data.Generics.Aliases
+import Data.Maybe
+import Data.Data
+import Control.Monad -- (join, mplus, MonadPlus)
+
+import Language.StrategicData
+import Language.Memo.Safe.AGMemo
+
+----------
+----
+--- TP
+----
+----------
+
+type TP a = Zipper a -> Maybe (Zipper a)
+
+applyTP :: TP (d m) -> Zipper (d m) -> Maybe (Zipper (d m))
+applyTP f z = f z
+
+full_tdTP :: StrategicData (d m) => TP (d m) -> TP (d m) 
+full_tdTP f = allTPdown (full_tdTP f) `seqTP` allTPright (full_tdTP f) `seqTP` f 
+
+full_buTP :: StrategicData (d m) => TP (d m) -> TP (d m) 
+full_buTP f = f `seqTP` allTPright (full_buTP f) `seqTP` allTPdown (full_buTP f) 
+
+once_tdTP :: StrategicData (d m) => TP (d m) -> TP (d m) 
+once_tdTP f =  oneTPdown (once_tdTP f) `choiceTP` oneTPright (once_tdTP f) `choiceTP` f
+
+once_buTP :: StrategicData (d m) => TP (d m) -> TP (d m)   
+once_buTP f = f `choiceTP` oneTPright (once_buTP f) `choiceTP` oneTPdown (once_buTP f) 
+
+--https://hackage.haskell.org/package/ZipperAG-0.9/docs/Language-Grammars-ZipperAG-Examples-Algol68.html
+--change use to decl
+
+--Experimental
+stop_tdTP :: StrategicData (d m) => TP (d m) -> TP (d m)   
+stop_tdTP f = oneTPdown (stop_tdTP f) `choiceTP` f `seqTP` oneTPright (stop_tdTP f)
+
+--Experimental
+stop_buTP :: StrategicData (d m) => TP (d m) -> TP (d m)   
+stop_buTP f = oneTPright (stop_buTP f) `seqTP` (f  `choiceTP` oneTPdown (stop_buTP f))
+
+adhocTP :: Typeable a => TP (d m) -> (a -> Maybe a) -> TP (d m)
+adhocTP f g = maybeKeep f (zTryApplyM g) 
+
+adhocTPZ :: Typeable a => TP (d m) -> (a -> Zipper (d m) -> Maybe (Zipper (d m))) -> TP (d m)
+adhocTPZ f g = maybeKeep f (zTryApplyMZ g)
+
+--Identity function
+idTP :: TP (d m)
+idTP a = return a
+
+idTP_invalidateDep :: Memoizable d m => TP (d m)
+idTP_invalidateDep a = return $ invalidateDependencies a
+
+--Failing function
+failTP :: TP (d m) 
+failTP = const mzero
+
+
+
+maybeKeep :: (a -> Maybe a) -> (a -> Maybe a) -> a -> Maybe a
+maybeKeep x y z =  case y z of 
+              Nothing -> x z 
+              Just r -> case x r of 
+                  Nothing ->  Just r
+                  k -> k 
+
+allTPright :: StrategicData (d m) => TP (d m) -> TP (d m) 
+allTPright f z = case right z of 
+         Nothing -> return z
+         Just r  -> (fromJust . left) <$> f r
+
+--To down node only
+allTPdown :: StrategicData (d m) => TP (d m) -> TP (d m)
+allTPdown f z = case down' z of 
+            Nothing -> return z
+            Just d  -> (fromJust . up) <$> f d
+
+--To right node only
+oneTPright :: StrategicData (d m) => TP (d m) -> TP (d m)
+oneTPright f z = case right z of 
+         Nothing -> Nothing
+         Just r  -> (fromJust . left) <$> f r
+
+--To down node only
+oneTPdown :: StrategicData (d m) => TP (d m) -> TP (d m)
+oneTPdown f z = case down' z of 
+            Nothing -> Nothing
+            Just d  -> (fromJust . up) <$> f d  
+
+--Sequential composition, ignores failure
+seqTP :: TP (d m) -> TP (d m) -> TP (d m)
+seqTP x y z = maybeKeep x y z
+f `mseq` g      =  \x -> g x >>= f
+
+--Sequential composition, chooses rightmost only if possible
+choiceTP :: TP (d m) -> TP (d m) -> TP (d m)
+choiceTP x y z = maybe (x z) (return . id) (y z)
+
+--Apply a function, fail the composition if it fails
+monoTP :: Typeable a => (a -> Maybe a) -> TP (d m)
+monoTP = adhocTP failTP
+
+--Apply a function with access to the zipper, fail the composition if it fails
+monoTPZ :: Typeable a => (a -> Zipper (d m) -> Maybe (Zipper (d m))) -> TP (d m)
+monoTPZ = adhocTPZ failTP
+
+--Try to apply a zipper function, and apply identity if it fails
+tryTP :: TP (d m) -> TP (d m)
+tryTP s = idTP `choiceTP` s
+
+repeatTP :: TP (d m) -> TP (d m)
+repeatTP s =  tryTP (mseq (repeatTP s) s)
+
+innermost :: StrategicData (d m) => TP (d m) -> TP (d m)
+innermost s =  (tryTP ((innermost s) `mseq` s))
+                   `seqTP` oneTPright (innermost s) `seqTP` oneTPdown (innermost s)
+
+innermost'  :: StrategicData (d m) => TP (d m) -> TP (d m)
+innermost' s  =  repeatTP (once_buTP s)
+
+outermost  :: StrategicData (d m) => TP (d m) -> TP (d m)
+outermost s  =  repeatTP (once_tdTP s)
+
+----------
+----
+--- TU
+----
+----------
+
+type TU m d = (forall a. Zipper a -> (m d, Zipper a)) 
+
+applyTU :: (Memoizable dtype memo) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> Zipper (dtype memo) -> (m d, Zipper (dtype memo)) 
+applyTU f z = f z 
+
+foldr1TU :: (Monoid (m d), StrategicData (dtype memo), Foldable m) => 
+    (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> 
+    Zipper (dtype memo) -> (d -> d -> d) -> d
+foldr1TU f z red = foldr1 red $ fst (full_tdTU f z) 
+
+foldl1TU :: (Monoid (m d), StrategicData (dtype memo), Foldable m) => 
+    (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> 
+    Zipper (dtype memo) -> (d -> d -> d) -> d
+foldl1TU f z red = foldl1 red $ fst (full_tdTU f z) 
+
+foldrTU :: (Monoid (m d), StrategicData (dtype memo), Foldable m) => 
+    (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> 
+    Zipper (dtype memo) -> (d -> c -> c) -> c -> c
+foldrTU f z red i = foldr red i $ fst (full_tdTU f z) 
+
+foldlTU :: (Monoid (m d), StrategicData (dtype memo), Foldable m) => 
+    (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> 
+    Zipper (dtype memo) -> (c -> d -> c) -> c -> c
+foldlTU f z red i = foldl red i $ fst (full_tdTU f z) 
+
+full_tdTU :: (Monoid (m d), StrategicData (dtype memo)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))   
+full_tdTU f = allTUright (full_buTU f) `seqTU` allTUdown (full_buTU f) `seqTU` f
+
+full_buTU :: (Monoid (m d), StrategicData (dtype memo)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+full_buTU f = f `seqTU` allTUdown (full_tdTU f) `seqTU` allTUright (full_tdTU f) 
+
+once_tdTU :: (MonadPlus m, Monoid (m d), StrategicData (dtype memo)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) 
+once_tdTU f = f `choiceTU` allTUdown (once_tdTU f)  `choiceTU` allTUright (once_tdTU f) 
+
+once_buTU :: (MonadPlus m, Monoid (m d), StrategicData (dtype memo)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+once_buTU f = allTUright (once_buTU f) `choiceTU` allTUdown (once_buTU f) `choiceTU` f
+
+stop_tdTU :: (MonadPlus m, Monoid (m d), StrategicData (dtype memo)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+stop_tdTU f = (f `choiceTU` allTUdown (stop_tdTU f)) `seqTU` allTUright (stop_tdTU f)
+
+stop_buTU :: (MonadPlus m, Monoid (m d), StrategicData (dtype memo)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+stop_buTU f = allTUright (stop_buTU f) `seqTU` (allTUdown (stop_buTU f) `choiceTU` f)
+
+allTUdown :: (Monoid (m d), StrategicData (dtype memo)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+allTUdown f z = case down' z of 
+         Nothing -> (mempty, z)
+         Just d  -> let (v, z') = f d
+                    in (v, fromJust $ up z')
+
+allTUright :: (Monoid (m d), StrategicData (dtype memo)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+allTUright f z = case right z of 
+         Nothing -> (mempty, z)
+         Just r  -> let (v, z') = f r
+                    in (v, fromJust $ left z')
+
+adhocTU :: (Monad m, Typeable a) => (Zipper c -> (m d, Zipper c)) -> (a -> m d) -> (Zipper c -> (m d, Zipper c))
+adhocTU f g z = case (zTryReduceM g z) of 
+            (Just r, z') -> (r, z')
+            (Nothing, z') -> f z'
+
+adhocTUZ :: (Monad m, Typeable a) => (Zipper c -> (m d, Zipper c)) -> (a -> Zipper c -> (m d, Zipper c)) -> (Zipper c -> (m d, Zipper c))
+adhocTUZ f g z = case (zTryReduceMZ g z) of 
+            (Just r, z') -> (r, z')
+            (Nothing, z') -> f z'
+
+seqTU :: (Monoid (m d)) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))-> (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+seqTU x y z =  
+  let (yr, z') = y z 
+      (xr, z'') = x z'
+  in (xr `mappend` yr, z'')
+
+--Sequential composition 
+choiceTU :: (MonadPlus m) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+choiceTU x y z = 
+  let (yr, z') = y z 
+      (xr, z'') = x z'
+  in (xr `mplus` yr, z'')
+
+failTU :: (MonadPlus m) => (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+failTU z = (mzero, z)
+
+constTU :: Monad m => d -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+constTU v z = (return v, z)
+
+--Apply a function, fail the composition if it fails
+monoTU :: (MonadPlus m, Typeable a) => (a -> m d) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+monoTU = adhocTU failTU
+
+--TODO: fix type signature
+--Apply a function with access to the zipper, fail the composition if it fails
+monoTUZ :: (MonadPlus m, Typeable a) => (a -> Zipper (dtype memo) -> (m d, Zipper (dtype memo))) -> (Zipper (dtype memo) -> (m d, Zipper (dtype memo)))
+monoTUZ = adhocTUZ failTU
+
+
+--TODO: fix type signature
+--TODO: improve using Data.Generics.Aliases, fitting mkT or mkM inside of transM instead of chaining casts 
+--elevate a reduction, which can access the zipper, to the zipper level. If the type does not match, returns Nothing 
+zTryReduceMZ :: (Typeable a) => (a -> Zipper c -> (b, Zipper c)) -> (Zipper c -> (Maybe b, Zipper c))
+zTryReduceMZ f z = case getHole z of 
+       Nothing -> (Nothing     , z)
+       Just r  -> let (x, z') = f r z 
+                  in (Just x, z')
+
+
+--elevate a reduction to the zipper level. If the type does not match, returns Nothing 
+zTryReduceM :: (Typeable a) => (a -> b) -> (Zipper e -> (Maybe b, Zipper e)) -- TU Maybe b
+zTryReduceM f z = case getHole z of 
+       Nothing -> (Nothing   , z)
+       Just r  -> (Just (f r), z)
+
+
+zTryApplyMZ :: (Typeable a) => (a -> Zipper c -> Maybe (Zipper c)) -> TP c
+zTryApplyMZ f z = case getHole z of 
+                    Nothing -> Nothing 
+                    Just v  -> case (f v z) of 
+                                Nothing -> Nothing 
+                                Just r  -> Just r
+
+--elevate a transformation to the zipper level. If the type does not match, returns Nothing 
+zTryApplyM :: (Typeable a, Typeable b) => (a -> Maybe b) -> TP (c)
+zTryApplyM f = transM (join . cast . f . fromJust . cast)
+
+--elevate a transformation to the zipper level. If the type does not match, returns Nothing 
+zTryApply :: (Typeable a, Typeable b) => (a -> b) -> TP c
+zTryApply f = transM (cast . f . fromJust . cast)
+
+--elevate a transformation to the zipper level. If the type does not match, the zipper remains unchanged
+zApply :: (Typeable a, Typeable b) => (a -> b) -> (Zipper c -> Zipper c)
+zApply f z = maybe z id (zTryApply f z) 

@@ -0,0 +1,316 @@+{-# LANGUAGE Rank2Types,DeriveDataTypeable #-}
+module Language.Memo.State.Ztrategic where
+
+import Language.ZipperAG
+import Language.StrategicData
+
+import Data.Generics.Zipper hiding (left, right, up, down')
+import Data.Generics.Aliases
+import Data.Maybe
+import Data.Data
+import Control.Monad -- (join, mplus, MonadPlus)
+import Control.Monad.State.Lazy
+
+
+data Result = Success | Fail deriving Show 
+andS Success Success = Success
+andS _ _ = Fail
+orS Fail Fail = Fail 
+orS _ _ = Success
+
+----------
+----
+--- TP
+----
+----------
+
+type TP a = State (Zipper a) Result
+
+applyTP :: TP c -> Zipper c -> Zipper c
+applyTP f z = execState f z
+
+full_tdTP :: StrategicData a => TP a -> TP a
+full_tdTP f = allTPdown (full_tdTP f) `seqTP` allTPright (full_tdTP f) `seqTP` f 
+
+full_buTP :: StrategicData a => TP a -> TP a
+full_buTP f = f `seqTP` allTPright (full_buTP f) `seqTP` allTPdown (full_buTP f) 
+
+once_tdTP :: StrategicData a => TP a -> TP a
+once_tdTP f =  oneTPdown (once_tdTP f) `choiceTP` oneTPright (once_tdTP f) `choiceTP` f
+
+once_buTP :: StrategicData a => TP a -> TP a  
+once_buTP f = f `choiceTP` oneTPright (once_buTP f) `choiceTP` oneTPdown (once_buTP f) 
+
+--Experimental
+stop_tdTP :: StrategicData a => TP a -> TP a
+stop_tdTP f = oneTPdown (stop_tdTP f) `choiceTP` f `seqTP` oneTPright (stop_tdTP f)
+
+--Experimental
+stop_buTP :: StrategicData a => TP a -> TP a
+stop_buTP f = oneTPright (stop_buTP f) `seqTP` (f  `choiceTP` oneTPdown (stop_buTP f))
+
+adhocTP :: Typeable a => TP e -> (a -> Maybe a) -> TP e
+adhocTP f g = f `seqTP` (zTryApplyM g) 
+
+adhocTPZ :: Typeable a => TP e -> (a -> Zipper e -> Maybe (Zipper e)) -> TP e
+adhocTPZ f g = f `seqTP` (zTryApplyMZ g)
+
+--Identity function
+idTP :: TP a
+idTP = return Success
+
+--Failing function
+failTP :: TP a 
+failTP = return Fail
+
+
+--To right node only
+allTPright :: StrategicData a => TP a -> TP a
+allTPright f = do
+            z <- get 
+            case right z of 
+              Nothing -> return Success
+              Just r  -> do 
+                         put r 
+                         res <- f 
+                         modify (fromJust . left)
+                         return res
+
+--To down node only
+allTPdown :: StrategicData a => TP a -> TP a
+allTPdown f = do
+            z <- get 
+            case down' z of 
+              Nothing -> return Success
+              Just d  -> do 
+                  put d
+                  res <- f 
+                  modify (fromJust . up)
+                  return res
+
+--To right node only
+oneTPright :: StrategicData a => TP a -> TP a
+oneTPright f = do
+            z <- get 
+            case right z of 
+              Nothing -> return Fail
+              Just r  -> do 
+                         put r 
+                         res <- f 
+                         modify (fromJust . left)
+                         return res
+
+--To down node only
+oneTPdown :: StrategicData a => TP a -> TP a
+oneTPdown f = do
+            z <- get 
+            case down' z of 
+              Nothing -> return Fail
+              Just d  -> do 
+                  put d
+                  res <- f 
+                  modify (fromJust . up)
+                  return res
+
+
+--Sequential composition, ignores failure
+seqTP :: TP a -> TP a -> TP a
+seqTP x y = do 
+          r1 <- y
+          r2 <- x
+          return (orS r1 r2)
+
+mseq :: TP a -> TP a -> TP a
+f `mseq` g      =  do 
+  r1 <- g
+  case r1 of 
+    Fail -> return Fail 
+    Success -> f 
+
+--Sequential composition, chooses rightmost only if possible
+choiceTP :: TP a -> TP a -> TP a
+choiceTP x y = do 
+  r1 <- y 
+  case r1 of 
+   Success -> return Success 
+   Fail -> x
+
+--Apply a function, fail the composition if it fails
+monoTP :: Typeable a => (a -> Maybe a) -> TP e
+monoTP = adhocTP failTP
+
+--Apply a function with access to the zipper, fail the composition if it fails
+monoTPZ :: Typeable a => (a -> Zipper e -> Maybe (Zipper e)) -> TP e
+monoTPZ = adhocTPZ failTP
+
+--Try to apply a zipper function, and apply identity if it fails
+tryTP :: TP a -> TP a
+tryTP s = idTP `choiceTP` s
+
+repeatTP :: TP a -> TP a
+repeatTP s =  tryTP (mseq (repeatTP s) s)
+
+innermost :: StrategicData a => TP a -> TP a
+innermost s =  (tryTP ((innermost s) `mseq` s))
+                   `seqTP` oneTPright (innermost s) `seqTP` oneTPdown (innermost s)
+
+innermost'  :: StrategicData a => TP a -> TP a
+innermost' s  =  repeatTP (once_buTP s)
+
+outermost  :: StrategicData a => TP a -> TP a
+outermost s  =  repeatTP (once_tdTP s)
+
+----------
+----
+--- TU
+----
+----------
+
+type TU m d = (forall a. State (Zipper a) (m d, Result))
+
+applyTU :: State (Zipper c) (m d, Result) -> Zipper c -> m d 
+applyTU f z = fst $ evalState f z 
+
+foldr1TU :: (Monoid (m d), StrategicData c, Foldable m) => 
+    State (Zipper c) (m d, Result) -> 
+    Zipper c -> (d -> d -> d) -> d
+foldr1TU f z red = foldr1 red $ applyTU (full_tdTU f) z 
+
+foldl1TU :: (Monoid (m d), StrategicData c, Foldable m) => 
+    State (Zipper c) (m d, Result) -> 
+    Zipper c -> (d -> d -> d) -> d
+foldl1TU f z red = foldl1 red $ applyTU (full_tdTU f) z 
+
+foldrTU :: (Monoid (m d), StrategicData c, Foldable m) => 
+    State (Zipper c) (m d, Result) -> 
+    Zipper c -> (d -> v -> v) -> v -> v
+foldrTU f z red i = foldr red i $ applyTU (full_tdTU f) z 
+
+foldlTU :: (Monoid (m d), StrategicData c, Foldable m) => 
+    State (Zipper c) (m d, Result) -> 
+    Zipper c -> (v -> d -> v) -> v -> v
+foldlTU f z red i = foldl red i $ applyTU (full_tdTU f) z 
+
+full_tdTU :: (Monoid (m d), StrategicData c) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)
+full_tdTU f = allTUright (full_buTU f) `seqTU` allTUdown (full_buTU f) `seqTU` f
+
+full_buTU :: (Monoid (m d), StrategicData c) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)
+full_buTU f = f `seqTU` allTUdown (full_tdTU f) `seqTU` allTUright (full_tdTU f) 
+
+once_tdTU :: (MonadPlus m, Monoid (m d), StrategicData c) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)
+once_tdTU f = f `choiceTU` allTUdown (once_tdTU f)  `choiceTU` allTUright (once_tdTU f) 
+
+once_buTU :: (MonadPlus m, Monoid (m d), StrategicData c) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)
+once_buTU f = allTUright (once_buTU f) `choiceTU` allTUdown (once_buTU f) `choiceTU` f
+
+stop_tdTU :: (MonadPlus m, Monoid (m d), StrategicData c) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)
+stop_tdTU f = (f `choiceTU` allTUdown (stop_tdTU f)) `seqTU` allTUright (stop_tdTU f)
+
+stop_buTU :: (MonadPlus m, Monoid (m d), StrategicData c) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)
+stop_buTU f = allTUright (stop_buTU f) `seqTU` (allTUdown (stop_buTU f) `choiceTU` f)
+
+allTUdown :: (Monoid (m d), StrategicData c) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)
+allTUdown f = do 
+         z <- get 
+         case down' z of 
+           Nothing -> return (mempty, Success)
+           Just d  -> do 
+                      put d 
+                      res <- f
+                      modify (fromJust . up)
+                      return res
+
+allTUright :: (Monoid (m d), StrategicData c) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)
+allTUright f = do 
+         z <- get 
+         case right z of 
+           Nothing -> return (mempty, Success)
+           Just r  -> do 
+                      put r 
+                      res <- f
+                      modify (fromJust . left)
+                      return res
+
+adhocTU :: (Monad m, Typeable a) => State (Zipper c) (m d, Result) -> (a -> m d) -> State (Zipper c) (m d, Result)
+adhocTU f g = do 
+            r <- zTryReduceM g
+            case r of 
+              (_, Fail) -> f
+              x -> return x
+
+adhocTUZ :: (Monad m, Typeable a) => State (Zipper c) (m d, Result) -> (a -> Zipper c -> (m d, Zipper c)) -> State (Zipper c) (m d, Result) 
+adhocTUZ f g = do 
+            r <- zTryReduceMZ g
+            case r of 
+              (_, Fail) -> f
+              x -> return x
+
+seqTU :: (Monoid (m d)) => State (Zipper c) (m d, Result)-> State (Zipper c) (m d, Result)  -> State (Zipper c) (m d, Result)
+seqTU x y = do 
+      (yr, r1) <- y
+      (xr, r2) <- x
+      return (xr `mappend` yr, orS r1 r2)
+
+--Sequential composition 
+choiceTU :: (MonadPlus m) => State (Zipper c) (m d, Result) -> State (Zipper c) (m d, Result)-> State (Zipper c) (m d, Result)
+choiceTU x y = do 
+      (yr, r1) <- y 
+      (xr, r2) <- x
+      return (xr `mplus` yr, orS r1 r2)
+
+failTU :: (MonadPlus m) => State (Zipper c) (m d, Result)
+failTU = return (mzero, Fail)
+
+constTU :: Monad m => d -> State (Zipper c) (m d, Result)
+constTU v = return (return v, Success)
+
+--Apply a function, fail the composition if it fails
+monoTU :: (MonadPlus m, Typeable a) => (a -> m d) -> State (Zipper c) (m d, Result)
+monoTU = adhocTU failTU
+
+--Apply a function with access to the zipper, fail the composition if it fails
+monoTUZ :: (MonadPlus m, Typeable a) => (a -> Zipper c -> (m d, Zipper c)) -> State (Zipper c) (m d, Result)
+monoTUZ = adhocTUZ failTU
+
+--elevate a reduction, which can access the zipper, to the zipper level. If the type does not match, returns Nothing 
+zTryReduceMZ :: (Typeable a) => (a -> Zipper c -> (m d, Zipper c)) -> State (Zipper c) (m d, Result)
+zTryReduceMZ f = do 
+       z <- get 
+       case getHole z of 
+         Nothing -> return (undefined, Fail)
+         Just r  -> let (x, z') = f r z 
+                    in do 
+                       put z'
+                       return (x, Success)
+
+
+--elevate a reduction to the zipper level. If the type does not match, returns Nothing 
+zTryReduceM :: (Typeable a) => (a -> m d) -> TU m d
+zTryReduceM f = do 
+       z <- get 
+       case getHole z of 
+         Nothing -> return (undefined, Fail   )
+         Just r  -> return (f r      , Success)
+
+
+--elevate a transformation to the zipper level. If the type does not match, returns Nothing 
+zTryApplyMZ :: (Typeable a) => (a -> Zipper c -> Maybe (Zipper c)) -> TP c
+zTryApplyMZ f = do 
+        z <- get 
+        case getHole z of 
+          Nothing -> return Fail 
+          Just v  -> case (f v z) of 
+                      Nothing -> return Fail 
+                      Just r  -> do 
+                                put r 
+                                return Success
+
+--elevate a transformation to the zipper level. If the type does not match, returns Nothing 
+zTryApplyM :: (Typeable a, Typeable b) => (a -> Maybe b) -> TP c
+zTryApplyM f = do 
+        z <- get 
+        case transM (join . cast . f . fromJust . cast) z of 
+         Nothing -> return Fail
+         Just z' -> do 
+            put z' 
+            return Success

@@ -0,0 +1,241 @@+{-# LANGUAGE Rank2Types #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use camelCase" #-}
+module Language.Memo.Ztrategic where
+
+import Language.ZipperAG
+import Data.Generics.Zipper hiding (left, right, up, down')
+import Data.Generics.Aliases
+import Data.Maybe
+import Data.Data
+import Control.Monad -- (join, mplus, MonadPlus)
+
+import Control.Monad.Trans.Maybe -- for MaybeT in elevate func
+
+import Language.StrategicData
+import Language.Memo.AGMemo
+
+----------
+----
+--- TP
+----
+----------
+
+newtype TP m = MkTP (forall d mm. (StrategicData (d mm), Memoizable d mm) => Zipper (d mm) -> m (Zipper (d mm)))
+unTP (MkTP f) = f
+
+applyTP_clean :: (Monad m, StrategicData (d mm), Memoizable d mm) => TP m -> Zipper (d mm) -> m (Zipper (d mm))
+applyTP_clean f = fmap cleanMemoTable . unTP f
+
+applyTP :: (StrategicData (d mm), Memoizable d mm) => TP m -> Zipper (d mm) -> m (Zipper (d mm))
+applyTP = unTP
+
+elevate :: (Monad m, Typeable b) => (b -> m b) -> Zipper a -> m (Maybe (Zipper a))
+elevate g z = runMaybeT $ transM (MaybeT . maybe (return Nothing) (fmap cast . g) . cast) z
+
+
+elevateZ :: (Monad m, Typeable a, Typeable b, Typeable c) => (b -> Zipper c -> m (Zipper c)) -> Zipper a -> m (Maybe (Zipper a))
+elevateZ f z = maybe (return Nothing) (\b -> maybe (return Nothing) (fmap cast . f b) (cast z)) (getHole z)
+
+full_tdTP :: (Monad m) => TP m  -> TP m
+full_tdTP f = f `seqTP` allTPdown (full_tdTP f) `seqTP` allTPright (full_tdTP f)
+
+full_buTP :: (Monad m) => TP m -> TP m
+full_buTP f = allTPright (full_buTP f) `seqTP` allTPdown (full_buTP f) `seqTP` f
+
+once_tdTP :: (MonadPlus m) => TP m -> TP m
+once_tdTP f = f `choiceTP` oneTPdown (once_tdTP f) `choiceTP` oneTPright (once_tdTP f)
+
+once_buTP :: (MonadPlus m) => TP m -> TP m
+once_buTP f = oneTPright (once_buTP f) `choiceTP` oneTPdown (once_buTP f) `choiceTP` f
+
+--Experimental
+stop_tdTP :: (MonadPlus m) => TP m -> TP m
+stop_tdTP f = f `choiceTP` (allTPdown (stop_tdTP f) `seqTP` allTPright (stop_tdTP f))
+
+--Experimental
+stop_buTP :: (MonadPlus m) => TP m -> TP m
+stop_buTP f = (allTPdown (stop_tdTP f) `seqTP` allTPright (stop_tdTP f)) `choiceTP` f
+
+adhocTP :: (Monad m, Typeable b) => TP m -> (b -> m b) -> TP m
+adhocTP f g = MkTP $ \z -> do
+          val <- elevate g z
+          maybe (applyTP f z) return val
+
+adhocTPSeq :: (MonadPlus m, Typeable b) => TP m -> (b -> m b) -> TP m
+adhocTPSeq f g = MkTP (\z -> do
+             val <- elevate g z
+             maybe (applyTP f z) (applyTP (tryTP f)) val)
+                `choiceTP` f
+
+adhocTPZ :: (Monad m, Typeable a, Typeable b) => TP m -> (b -> Zipper a -> m (Zipper a)) -> TP m
+adhocTPZ f g = MkTP $ \z -> do
+          val <- elevateZ g z
+          maybe (applyTP f z) return val
+
+adhocTPZSeq :: (MonadPlus m, Typeable a, Typeable b) => TP m -> (b -> Zipper a -> m (Zipper a)) -> TP m
+adhocTPZSeq f g = MkTP (\z -> do
+             val <- elevateZ g z
+             maybe (applyTP f z) (applyTP (tryTP f)) val)
+                `choiceTP` f
+
+--Identity function
+idTP :: Monad m => TP m
+idTP = MkTP return
+
+
+--Failing function
+failTP :: MonadPlus m => TP m
+failTP = MkTP (const mzero)
+
+allTPright :: (Monad m) => TP m  -> TP m
+allTPright f = MkTP $ \z -> moveM right left (return z) (applyTP f) z
+
+allTPdown :: (Monad m) => TP m  -> TP m
+allTPdown f = MkTP $ \z -> moveM down' up (return z) (applyTP f) z
+
+oneTPright :: (MonadPlus m) => TP m -> TP m
+oneTPright f = MkTP $ moveM right left mzero (applyTP f)
+
+oneTPdown :: (MonadPlus m) => TP m -> TP m
+oneTPdown f = MkTP $ moveM down' up mzero (applyTP f)
+
+--Sequential composition, ignores failure
+seqTP :: Monad m => TP m -> TP m -> TP m
+seqTP f g = MkTP (unTP f `mseq` unTP g)
+f `mseq` g =  f >=> g
+
+--Sequential composition, chooses rightmost only if possible
+choiceTP :: MonadPlus m => TP m -> TP m -> TP m
+choiceTP f g = MkTP (unTP f `mchoice` unTP g)
+f `mchoice` g   =  \x -> f x `mplus` g x
+
+
+--Apply a function, fail the composition if it fails
+monoTP :: (MonadPlus m, Typeable b) => (b -> m b) -> TP m
+monoTP = adhocTP failTP
+
+--Apply a function with access to the zipper, fail the composition if it fails
+monoTPZ :: (MonadPlus m, Typeable a, Typeable b) => (b -> Zipper a -> m (Zipper a)) -> TP m
+monoTPZ = adhocTPZ failTP
+
+--Try to apply a zipper function, and apply identity if it fails
+tryTP :: MonadPlus m => TP m -> TP m
+tryTP s = s `choiceTP` idTP
+
+
+repeatTP :: MonadPlus m => TP m -> TP m
+repeatTP s =  tryTP (s `seqTP` repeatTP s)
+
+innermost :: (MonadPlus m) => TP m -> TP m
+innermost s = allTPright (innermost s)
+      `seqTP` allTPdown (innermost s)
+      `seqTP` tryTP (s `seqTP` innermost s)
+
+innermost' :: (MonadPlus m) => TP m -> TP m
+innermost' s  = repeatTP (once_buTP s)
+
+outermost  :: (MonadPlus m) => TP m -> TP m
+outermost s = repeatTP (once_tdTP s)
+
+----------
+----
+--- TU
+----
+----------
+
+
+newtype TU m r = MkTU (forall d mm . (StrategicData (d mm), Memoizable d mm) => Zipper (d mm) -> (m r, Zipper (d mm)))
+unTU (MkTU f) = f
+
+applyTU_clean :: (Memoizable d mm, StrategicData (d mm)) => TU m r -> Zipper (d mm) -> (m r, Zipper (d mm))
+applyTU_clean f z = case unTU f z of
+                (r, z1) -> (r, cleanMemoTable z1)
+
+applyTU :: (Memoizable d mm, StrategicData (d mm)) => TU m r -> Zipper (d mm) -> (m r, Zipper (d mm))
+applyTU = unTU
+
+foldr1TU :: (Memoizable d mm, StrategicData (d mm), Monoid (m r), Foldable m, MonadPlus m) =>
+    TU m r ->
+    Zipper (d mm) -> (r -> r -> r) -> r
+foldr1TU f z red = foldr1 red $ fst (applyTU (full_tdTU f) z)
+
+foldl1TU :: (Memoizable d mm, StrategicData (d mm), Monoid (m r), Foldable m, MonadPlus m) =>
+    TU m r ->
+    Zipper (d mm) -> (r -> r -> r) -> r
+foldl1TU f z red = foldl1 red $ fst (applyTU (full_tdTU f) z)
+
+foldrTU :: (Memoizable d mm, StrategicData (d mm), Monoid (m r), Foldable m, MonadPlus m) =>
+    TU m r ->
+    Zipper (d mm) -> (r -> s -> s) -> s -> s
+foldrTU f z red i = foldr red i $ fst (applyTU (full_tdTU f) z)
+
+foldlTU :: (Memoizable d mm, StrategicData (d mm), Monoid (m r), Foldable m, MonadPlus m) =>
+    TU m r ->
+    Zipper (d mm) -> (s -> r -> s) -> s -> s
+foldlTU f z red i = foldl red i $ fst (applyTU (full_tdTU f) z)
+
+full_tdTU :: (MonadPlus m, Monoid (m r)) => TU m r -> TU m r
+full_tdTU f = allTUright (full_buTU f) `seqTU` allTUdown (full_buTU f) `seqTU` f
+
+full_buTU :: (MonadPlus m, Monoid (m r)) => TU m r -> TU m r
+full_buTU f = f `seqTU` allTUdown (full_tdTU f) `seqTU` allTUright (full_tdTU f)
+
+once_tdTU :: (MonadPlus m, Monoid (m r)) => TU m r -> TU m r
+once_tdTU f = f `choiceTU` allTUdown (once_tdTU f)  `choiceTU` allTUright (once_tdTU f)
+
+once_buTU :: (MonadPlus m, Monoid (m r)) => TU m r -> TU m r
+once_buTU f = allTUright (once_buTU f) `choiceTU` allTUdown (once_buTU f) `choiceTU` f
+
+stop_tdTU :: (MonadPlus m, Monoid (m r)) => TU m r -> TU m r
+stop_tdTU f = (f `choiceTU` allTUdown (stop_tdTU f)) `seqTU` allTUright (stop_tdTU f)
+
+stop_buTU :: (MonadPlus m, Monoid (m r)) => TU m r -> TU m r
+stop_buTU f = allTUright (stop_buTU f) `seqTU` (allTUdown (stop_buTU f) `choiceTU` f)
+
+
+allTUdown :: (Monoid (m r)) => TU m r -> TU m r
+allTUdown f = MkTU $ \z -> moveQ down' (mempty, z) (back . applyTU f) z
+ where back (a,b) = (a, fromJust $ up b)
+
+
+allTUright :: (Monoid (m r)) => TU m r -> TU m r
+allTUright f = MkTU $ \z -> moveQ right (mempty, z) (back . applyTU f) z
+ where back (a,b) = (a, fromJust $ left b)
+
+
+adhocTU :: (Monad m, Typeable a) => TU m r -> (a -> m r) -> TU m r
+adhocTU f g = MkTU $ \z -> maybe (applyTU f z) (\c -> (c, z)) (getHole z >>= return . g)
+
+adhocTUZ :: (Monad m, Typeable a, Typeable d, Typeable mm) => TU m r -> (a -> Zipper (d mm) -> (m r, Zipper (d mm))) -> TU m r
+adhocTUZ f g = MkTU $ \z -> fromMaybe (applyTU f z) (reduce g z)
+
+reduce :: (Typeable a, Typeable d, Typeable d', Typeable mm', Typeable mm) => (a -> Zipper (d' mm') -> (m r, Zipper (d' mm'))) -> Zipper (d mm) -> Maybe (m r, Zipper (d mm))
+reduce f z = getHole z >>= \v -> cast z >>= (\(r, m) -> cast m >>= \mc -> return (r, mc)) . f v
+
+seqTU :: (Monoid (m r)) => TU m r -> TU m r -> TU m r
+seqTU x y = MkTU $ \z ->
+  let (yr, z') = applyTU y z
+      (xr, z'') = applyTU x z'
+  in (xr `mappend` yr, z'')
+
+choiceTU :: (MonadPlus m) => TU m r -> TU m r -> TU m r
+choiceTU x y = MkTU $ \z ->
+  let (yr, z') = applyTU y z
+      (xr, z'') = applyTU x z'
+  in (xr `mplus` yr, z'')
+
+
+failTU :: (MonadPlus m) => TU m r
+failTU = MkTU $ \z -> (mzero, z)
+
+constTU :: Monad m => r -> TU m r
+constTU v = MkTU $ \z -> (return v, z)
+
+--Apply a function, fail the composition if it fails
+monoTU :: (MonadPlus m, Typeable a) => (a -> m r) -> TU m r
+monoTU = adhocTU failTU
+
+--Apply a function with access to the zipper, fail the composition if it fails
+monoTUZ :: (MonadPlus m, Typeable a, Typeable d, Typeable mm) => (a -> Zipper (d mm) -> (m r, Zipper (d mm))) -> TU m r
+monoTUZ = adhocTUZ failTU

@@ -0,0 +1,67 @@+module Language.StrategicData 
+   (StrategicData(..), right, left, up, down', forbid, isJust) 
+  where 
+
+import Data.Generics
+import Data.Generics.Zipper hiding (left, right, up, down')
+import qualified Data.Generics.Zipper as Z (left, right, up, down')
+
+import Prelude hiding (null)
+import Data.Typeable
+import Control.Exception (Exception, throw, catch, evaluate)
+import System.IO.Unsafe (unsafePerformIO)
+
+class Typeable t => StrategicData t where
+  isTerminal :: Zipper t -> Bool
+  -- default isTerminal :: Zipper t -> Bool
+  isTerminal _ = False
+
+right :: StrategicData a => Zipper a -> Maybe (Zipper a)
+right z = case Z.right z of 
+            Just r -> if isTerminal r || isNull r then right r else Just r 
+            Nothing -> Nothing 
+
+left :: StrategicData a => Zipper a -> Maybe (Zipper a)
+left z = case Z.left z of 
+           Just r -> if isTerminal r || isNull r then left r else Just r 
+           Nothing -> Nothing  
+
+up :: StrategicData a => Zipper a -> Maybe (Zipper a)
+up z = case Z.up z of 
+         Just r -> if isTerminal r || isNull r then right r else Just r
+         Nothing -> Nothing 
+     
+down' :: StrategicData a => Zipper a -> Maybe (Zipper a)
+down' z = case Z.down' z of 
+            Just r -> if isTerminal r || isNull r then right r else Just r
+            Nothing -> Nothing 
+
+isJust (Just _) = True
+isJust Nothing  = False
+
+----------
+----
+--- The Null Pointer!!
+----
+----------
+
+isNull z = query isNull' z
+forbid = const null
+
+-- | The null value.
+-- When forced, a NullPointerException will be thrown.
+null :: a
+null = throw NullPointerException
+{-# NOINLINE null #-}
+
+
+
+isNull' x = unsafePerformIO $
+    (evaluate x *> pure False) 
+        `catch` 
+            \NullPointerException -> pure True
+
+-- | Thrown on attempt to use 'null'.
+data NullPointerException = NullPointerException deriving (Eq, Show, Typeable)
+
+instance Exception NullPointerException

@@ -0,0 +1,365 @@+{-# LANGUAGE Rank2Types, ScopedTypeVariables, FlexibleContexts, TypeApplications #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use camelCase" #-}
+module Language.Ztrategic where
+
+import Language.ZipperAG
+import Language.StrategicData
+
+import Data.Generics.Zipper hiding (left, right, up, down')
+import Data.Generics.Aliases
+import Data.Maybe
+import Data.Data
+import Control.Monad -- (join, mplus, MonadPlus)
+
+-- monad transformers, to extract the monad from adhocTP
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Maybe
+
+import Control.Monad.State.Lazy
+import System.Random (randomRIO, initStdGen, setStdGen)
+
+
+gatherChildren (trav, untrav) z = maybe [] ((navigation:) . gatherChildrenR navigation) $ down' z
+ where navigation = (fromJust . down' . trav, untrav . fromJust . up)
+
+
+gatherChildrenR (toNthChild, fromNthChild) z = maybe [] ((navigation:) . gatherChildrenR navigation) $ right z
+ where navigation = (fromJust . right . toNthChild, fromNthChild)
+
+
+
+breadthFirst_tdTP f = MkTP $ \z -> bf' f z [(id, id)]
+ where bf' f z [] = return z
+       bf' f z ((trav, untrav):travs) =
+           do
+             let thisNode = trav z
+             thisNodeTransformed <- applyTP f thisNode
+             let newTravs = gatherChildren (trav, untrav) thisNodeTransformed
+                 baseTransformed = untrav thisNodeTransformed
+             bf' f baseTransformed (travs ++ newTravs)
+
+----------
+----
+--- TP
+----
+----------
+
+newtype TP m = MkTP (forall a. (Typeable a, StrategicData a) => Zipper a -> m (Zipper a))
+
+unTP (MkTP f) = f
+
+applyTP :: (Typeable a, StrategicData a) => TP m -> Zipper a -> m (Zipper a)
+applyTP = unTP
+
+full_tdTP :: (Monad m) => TP m  -> TP m
+full_tdTP f = f `seqTP` allTPdown (full_tdTP f) `seqTP` allTPright (full_tdTP f)
+
+full_buTP :: (Monad m) => TP m -> TP m
+full_buTP f = allTPright (full_buTP f) `seqTP` allTPdown (full_buTP f) `seqTP` f
+
+once_tdTP :: (MonadPlus m) => TP m -> TP m
+once_tdTP f = f `choiceTP` oneTPdown (once_tdTP f) `choiceTP` oneTPright (once_tdTP f)
+
+once_buTP :: (MonadPlus m) => TP m -> TP m
+once_buTP f = oneTPright (once_buTP f) `choiceTP` oneTPdown (once_buTP f) `choiceTP` f
+
+--Experimental
+stop_tdTP :: (MonadPlus m) => TP m -> TP m
+stop_tdTP f = f `choiceTP` (allTPdown (stop_tdTP f) `seqTP` allTPright (stop_tdTP f))
+
+--Experimental
+stop_buTP :: (MonadPlus m) => TP m -> TP m
+stop_buTP f = (allTPdown (stop_tdTP f) `seqTP` allTPright (stop_tdTP f)) `choiceTP` f
+
+{-
+New stuff
+-}
+
+atRoot :: Monad m => TP m -> TP m
+atRoot tp = MkTP (\z -> moveM up (\v -> Just $ v.$ arity z) (applyTP tp z) (applyTP (atRoot tp)) z)
+
+full_uptdTP :: (Monad m) => TP m  -> TP m
+full_uptdTP f = allTPup (full_uptdTP f) `seqTP` f
+
+full_upbuTP :: (Monad m) => TP m  -> TP m
+full_upbuTP f = f `seqTP` allTPup (full_upbuTP f)
+
+once_uptdTP :: (MonadPlus m) => TP m -> TP m
+once_uptdTP f =  oneTPup (once_upbuTP f) `choiceTP` f
+
+once_upbuTP :: (MonadPlus m) => TP m -> TP m
+once_upbuTP f = f `choiceTP` oneTPup (once_uptdTP f)
+
+
+full_tdTPupwards :: forall m a. (Typeable a, Monad m) => Proxy a -> TP m -> TP m
+full_tdTPupwards _ tp = MkTP $ \z ->
+        let (Just v) = (getHole @(Maybe a) z)
+            z' = trans forbid z
+            traversed = applyTP (atRoot (full_tdTP tp)) z'
+        in fmap (setHole v) traversed
+
+
+
+-- counts a node if mutable 
+counter_func :: (Typeable a, MonadPlus m) => (a -> m a) -> a -> StateT Int m a
+counter_func tr e = do
+  t <- lift $ tr e
+  modify succ
+  return e
+
+-- counts the mutable nodes
+counting :: (StrategicData a, Typeable n, MonadPlus m) =>
+        Zipper a -> (n -> m n) -> m Int
+counting r tr = execStateT (applyTP (full_tdTP step) r) 0
+ where step = idTP `adhocTPSeq` counter_func tr
+
+-- applies mutation if node is transformable and we are supposed to mutate now
+mutation_func :: (MonadPlus m) => (a -> m a) -> a -> StateT Int m a
+mutation_func tr e = do
+  --run the transformation to check for mzeros (which will end computations)
+  t <- lift $ tr e
+  modify pred
+  x <- get
+  if x==0
+    then return t
+    else return e
+
+-- applies mutation_func with a random counter deciding when to actually mutate
+mutating :: (StrategicData a, Typeable b, MonadPlus m) =>
+     Zipper a -> Int -> (b -> m b) -> m (Zipper a)
+mutating r index tr = evalStateT (applyTP (full_tdTP step) r) index
+ where step = idTP `adhocTPSeq` mutation_func tr
+
+once_RandomTP :: (Typeable n, StrategicData a) => Zipper a -> (n -> Maybe n) -> IO (Zipper a)
+once_RandomTP r tr = do
+  let Just n = counting r tr
+  s <- initStdGen
+  setStdGen s
+  index <- randomRIO (1, n)
+  let Just v = mutating r index tr
+  return v
+
+mutations :: (Data a, Typeable n, StrategicData a) =>
+             a -> (n -> Maybe n) -> [a]
+mutations z tr = applyTU (full_tdTU step) $ toZipper z
+    where step = failTU `adhocTUZ` select tr
+--           select :: (Typeable n, StrategicData a) =>
+--                     (n -> Maybe n) -> n -> Zipper a -> [a]
+          select tr node zipper = case tr node of
+            Nothing -> []
+            Just newNode -> let newZipper = setHole newNode zipper
+                            in [fromZipper newZipper]
+
+
+{-
+/New stuff
+-}
+
+adhocTP :: (Monad m, Typeable b) => TP m -> (b -> m b) -> TP m
+adhocTP f g = MkTP $ \z -> do
+          val <- elevate g z
+          maybe (applyTP f z) return val
+
+adhocTPSeq :: (MonadPlus m, Typeable b) => TP m -> (b -> m b) -> TP m
+adhocTPSeq f g = MkTP (\z -> do
+             val <- elevate g z
+             maybe (applyTP f z) (applyTP (tryTP f)) val)
+                `choiceTP` f
+
+adhocTPZ :: (Monad m, Typeable a, Typeable b) => TP m -> (b -> Zipper a -> m b) -> TP m
+adhocTPZ f g = MkTP $ \z -> do
+          val <- elevateZ g z
+          maybe (applyTP f z) return val
+
+adhocTPZSeq :: (MonadPlus m, Typeable a, Typeable b) => TP m -> (b -> Zipper a -> m b) -> TP m
+adhocTPZSeq f g = MkTP (\z -> do
+             val <- elevateZ g z
+             maybe (applyTP f z) (applyTP (tryTP f)) val)
+                `choiceTP` f
+
+elevate :: (Monad m, Typeable b) => (b -> m b) -> Zipper a -> m (Maybe (Zipper a))
+elevate g z = runMaybeT $ transM (MaybeT . maybe (return Nothing) (fmap cast . g) . cast) z
+
+elevateZ :: (Monad m, Typeable a, Typeable b, Typeable c) => (b -> Zipper c -> m b) -> Zipper a -> m (Maybe (Zipper a))
+elevateZ g z = runMaybeT $ transM (MaybeT . maybe (return Nothing) (\b -> maybe (return Nothing) (fmap cast . g b) (cast z)) . cast) z
+
+--Identity function
+idTP :: Monad m => TP m
+idTP = MkTP return
+
+--Failing function
+failTP :: MonadPlus m => TP m
+failTP = MkTP (const mzero)
+
+allTPright :: (Monad m) => TP m  -> TP m
+allTPright f = MkTP $ \z -> moveM right left (return z) (applyTP f) z
+
+allTPdown :: (Monad m) => TP m  -> TP m
+allTPdown f = MkTP $ \z -> moveM down' up (return z) (applyTP f) z
+
+oneTPright :: (MonadPlus m) => TP m -> TP m
+oneTPright f = MkTP $ moveM right left mzero (applyTP f)
+
+oneTPdown :: (MonadPlus m) => TP m -> TP m
+oneTPdown f = MkTP $ moveM down' up mzero (applyTP f)
+
+--EXPERIMENTAL:
+allTPleft :: (Monad m) => TP m  -> TP m
+allTPleft f = MkTP $ \z -> moveM left right (return z) (applyTP f) z
+
+allTPup :: (Monad m) => TP m  -> TP m
+allTPup f = MkTP $ \z -> moveM up (\v -> Just $ v.$arity z) (return z) (applyTP f) z
+-- (Just . flip (.$) (arity z))
+
+oneTPleft :: (MonadPlus m) => TP m -> TP m
+oneTPleft f = MkTP $ moveM left right mzero (applyTP f)
+
+oneTPup :: (MonadPlus m) => TP m -> TP m
+oneTPup f = MkTP $ \z -> moveM up (\v -> Just $ v.$arity z) mzero (applyTP f) z
+
+--Sequential composition, ignores failure
+seqTP :: Monad m => TP m -> TP m -> TP m
+seqTP f g = MkTP (unTP f `mseq` unTP g)
+f `mseq` g =  f >=> g
+
+--Sequential composition, chooses leftmost only if possible
+choiceTP :: MonadPlus m => TP m -> TP m -> TP m
+choiceTP f g = MkTP (unTP f `mchoice` unTP g)
+f `mchoice` g   =  \x -> f x `mplus` g x
+
+--Apply a function, fail the composition if it fails
+monoTP :: (MonadPlus m, Typeable b) => (b -> m b) -> TP m
+monoTP = adhocTP failTP
+
+--Apply a function with access to the zipper, fail the composition if it fails
+monoTPZ :: (MonadPlus m, Typeable a, Typeable b) => (b -> Zipper a -> m b) -> TP m
+monoTPZ = adhocTPZ failTP
+
+--Try to apply a zipper function, and apply identity if it fails
+tryTP :: MonadPlus m => TP m -> TP m
+tryTP s = s `choiceTP` idTP
+
+repeatTP :: MonadPlus m => TP m -> TP m
+repeatTP s =  tryTP (s `seqTP` repeatTP s)
+
+
+-- TODO Make sure that this innermost works for all cases?!
+-- note that this is significantly faster than innermost'
+innermost :: (MonadPlus m) => TP m -> TP m
+innermost s = allTPright (innermost s)
+      `seqTP` allTPdown (innermost s)
+      `seqTP` tryTP (s `seqTP` innermost s)
+
+innermost' :: (MonadPlus m) => TP m -> TP m
+innermost' s  = repeatTP (once_buTP s)
+
+outermost  :: (MonadPlus m) => TP m -> TP m
+outermost s = repeatTP (once_tdTP s)
+
+----------
+----
+--- TU
+----
+----------
+
+
+newtype TU m d = MkTU (forall a. (Typeable a, StrategicData a) => Zipper a -> m d)
+unTU (MkTU f) = f
+
+
+applyTU :: (Typeable a, StrategicData a) => TU m d -> Zipper a -> m d
+applyTU = unTU
+
+
+foldr1TU :: (Monoid (m d), Foldable m, StrategicData a) => TU m d -> Zipper a -> (d -> d -> d) -> d
+foldr1TU f z red = foldr1 red $ applyTU (full_tdTU f) z
+
+foldl1TU :: (Monoid (m d), Foldable m, StrategicData a) => TU m d -> Zipper a -> (d -> d -> d) -> d
+foldl1TU f z red = foldl1 red $ applyTU (full_tdTU f) z
+
+foldrTU :: (Monoid (m d), Foldable m, StrategicData a) => TU m d -> Zipper a -> (d -> c -> c) -> c -> c
+foldrTU f z red i = foldr red i $ applyTU (full_tdTU f) z
+
+foldlTU :: (Monoid (m d), Foldable m, StrategicData a) => TU m d -> Zipper a -> (c -> d -> c) -> c -> c
+foldlTU f z red i = foldl red i $ applyTU (full_tdTU f) z
+
+
+full_tdTU :: Monoid (m d) => TU m d -> TU m d
+full_tdTU f = f `seqTU` allTUdown (full_tdTU f) `seqTU` allTUright (full_tdTU f)
+
+full_buTU :: Monoid (m d) => TU m d -> TU m d
+full_buTU f = allTUright (full_buTU f) `seqTU` allTUdown (full_buTU f) `seqTU` f
+
+once_tdTU :: (MonadPlus m, Monoid (m d)) => TU m d -> TU m d
+once_tdTU f = f `choiceTU` allTUdown (once_tdTU f) `choiceTU` allTUright (once_tdTU f)
+
+once_buTU :: (MonadPlus m, Monoid (m d)) => TU m d -> TU m d
+once_buTU f = allTUright (once_buTU f) `choiceTU` allTUdown (once_buTU f) `choiceTU` f
+
+--Experimental
+stop_tdTU :: (MonadPlus m, Monoid (m d)) => TU m d -> TU m d
+stop_tdTU f = f `choiceTU` (allTUdown (stop_tdTU f) `seqTU` allTUright (stop_tdTU f))
+
+--Experimental
+stop_buTU :: (MonadPlus m, Monoid (m d)) => TU m d -> TU m d
+stop_buTU f = (allTUright (stop_buTU f) `seqTU` allTUdown (stop_buTU f)) `choiceTU` f
+
+
+{-
+New!
+-}
+
+full_uptdTU :: (MonadPlus m, Monoid (m d)) => TU m d -> TU m d
+full_uptdTU f = allTUup (full_uptdTU f) `seqTU` f
+
+full_upbuTU :: (MonadPlus m, Monoid (m d)) => TU m d -> TU m d
+full_upbuTU f = f `seqTU` allTUup (full_upbuTU f)
+
+once_uptdTU :: (MonadPlus m, Monoid (m d)) => TU m d -> TU m d
+once_uptdTU f =  allTUup (once_uptdTU f) `choiceTU` f
+
+once_upbuTU :: (MonadPlus m, Monoid (m d)) => TU m d -> TU m d
+once_upbuTU f = f `choiceTU` allTUup (once_upbuTU f)
+
+allTUup :: Monoid (m d) => TU m d -> TU m d
+allTUup f = MkTU $ \z -> moveQ up mempty (applyTU f) z
+
+{-
+/New!
+-}
+
+allTUdown :: Monoid (m d) => TU m d -> TU m d
+allTUdown f = MkTU $ \z -> moveQ down' mempty (applyTU f) z
+
+allTUright :: Monoid (m d) => TU m d -> TU m d
+allTUright f = MkTU $ \z -> moveQ right mempty (applyTU f) z
+
+adhocTU :: (Monad m, Typeable a) => TU m d -> (a -> m d) -> TU m d
+adhocTU f g = MkTU $ \z -> fromMaybe (applyTU f z) (getHole z >>= return . g)
+
+
+adhocTUZ :: (Monad m, Typeable a, Typeable c) => TU m d -> (a -> Zipper c -> m d) -> TU m d
+adhocTUZ f g  = MkTU $ \z -> fromMaybe (applyTU f z) (reduce g z)
+
+reduce :: (Typeable a, Typeable c, Typeable e) => (a -> Zipper c -> m d) -> Zipper e -> Maybe (m d)
+reduce f z = (\v -> fmap (f v) (cast z)) =<< getHole z
+
+
+seqTU :: (Monoid (m d)) => TU m d-> TU m d -> TU m d
+seqTU x y = MkTU $ \z -> applyTU x z `mappend` applyTU y z
+
+choiceTU :: (MonadPlus m) => TU m d -> TU m d -> TU m d
+choiceTU x y = MkTU $ \z -> applyTU x z `mplus` applyTU y z
+
+failTU :: (MonadPlus m) => TU m d
+failTU = MkTU (const mzero)
+
+constTU :: Monad m => d -> TU m d
+constTU d = MkTU (const . return $ d)
+
+monoTU :: (MonadPlus m, Typeable a) => (a -> m d) -> TU m d
+monoTU = adhocTU failTU
+
+monoTUZ :: (MonadPlus m, Typeable a, Typeable e) => (a -> Zipper e -> m d) -> TU m d
+monoTUZ = adhocTUZ failTU

@@ -0,0 +1,264 @@+Ztrategic - A library for Strategic Programming with Attribute Grammars in Haskell
+====================
+
+## This README is a WIP and likely contains outdated information! 
+
+Overview: 
+
+* [Ztrategic](#markdown-header-ztrategic) 
+    * [What is Ztrategic](#markdown-header-what-is-ztrategic)
+    * [Getting Started](#markdown-header-getting-started)
+        * [Type-Preserving Strategies](#markdown-header-type-preserving-strategies)
+        * [Type-Unifying Strategies](#markdown-header-type-unifying-strategies)
+        * [Strategic Data](#markdown-header-strategic-data)
+        * [API Reference](#markdown-header-api-reference)  
+    * [Repository Layout](#markdown-header-repository-layout)
+* [Attribute Grammars](#markdown-header-attribute-grammars)
+* [Combining AGs with Strategies](#markdown-header-combining-ags-with-strategies)
+
+- - -
+
+# Ztrategic
+
+## What is Ztrategic
+
+We strongly recommend reading our publication "Zipping Strategies and Attribute Grammars" regarding this repository for more context and explanation; nevertheless, we provide a tutorial based on previous work in this README. Ztrategic is a library built on top of the `Zipper` data structure, and it allows for data traversal, manipulation and reduction, regardless of the underlying data structure. For more complex transformations, it is possible to integrate Attribute Grammars with Ztrategic. 
+
+
+Ztrategic is a standalone library and it is intended to be simple to use - just import it, respect any needed boilerplate, and define your transformations. 
+
+## Getting Started
+
+Let us consider a data type for the representation of `Let` expressions: 
+
+```haskell
+data Let = Let List Exp
+
+data  List  
+      = NestedLet  Name Let List
+      | Assign     Name Exp List
+      | EmptyList
+
+data Exp = Add   Exp Exp
+         | Sub   Exp Exp
+         | Neg   Exp
+         | Var   Name
+         | Const Int
+
+type Name     = String
+```
+
+A `Let` expression contains a `List` of declarations followed by an `Exp` to be evaluated. A `List` can be an `EmptyList` or either a `NestedLet` (that is, another `Let` block nested inside our current block) or an `Assign` (which is a declaration of a variable); any of these are followed by a `List` containing the rest of the declarations. 
+
+
+We denote that this is not an optimal definition of a `Let` block: we could use Haskell lists instead of explicit recursion on `List`, and `Let` values themselves could be inside `Exp`. Nevertheless, this data type is heterogenous (we have data types `Let`, `List` and `Exp` intertwined) and therefore not exactly easy to handle in classic Haskell fashion. 
+
+
+This tutorial will break on your machine because there is no definition of `StrategicData` for data type `Let`. We discuss this later [here](#markdown-header-strategic-data), but in the meanwhile you can skip this problem by adding the following line to your module: 
+```haskell
+instance StrategicData Let
+```
+
+
+### Type-Preserving Strategies
+
+
+
+Let us now consider a series of arithmetic expression optimizations: 
+
+```
+1) add(e, const(0)) -> e 
+2) add(const(0), e) -> e
+3) add(const(a), const (b)) -> const (a+b)
+4) sub(a, b) -> add(a, neg(b))
+5) neg(neg(e)) -> e
+6) neg (const(a)) -> const (-a)
+7) var (id) | (id, just(e)) ∈ env -> e
+```
+
+Let us consider only the first 6 rules at first. Using regular Haskell code, these rules are easy to implement but they are burdensome: None of these rules really care about the `Let` and `List` data types, but we would be forced to write code to recurse through them anyway. For now, let us write only a function to handle `Exp` values, returning `Just` the result when appliable and `Nothing` otherwise: 
+
+```haskell
+expr :: Exp -> Maybe Exp
+expr (Add e (Const 0))          = Just e 
+expr (Add (Const 0) e)          = Just e
+expr (Add (Const a) (Const b))  = Just (Const (a+b)) 
+expr (Sub a b)                  = Just (Add a (Neg b))    
+expr (Neg (Neg e))              = Just e           
+expr (Neg (Const a))            = Just (Const (-a)) 
+expr _                          = Nothing
+```
+
+This `expr` function contains all the work that is, in fact, relevant for our use case. In regular Haskell code, the rest of the code can be considered boilerplate / copy rules, only recusing through data structures with no real work. Instead, we will be using a **strategy** to apply `expr` to our data type. 
+
+
+There are two types of strategies in our library:
+
+
+* **Type-Preserving (TP)** strategies preserve the type of the data structure, changing only its contents. They are useful for transforming and manipulating data structures. They can be thought of as *map* operations. 
+* **Type-Unifying (TU)** strategies produce a new value out of data from the input data structure. They are useful for gathering data out of and/or analysing data structures. They can be thought of as *reduce* operations. 
+
+
+For this, we will use a Type-Preserving (TP) strategy. From the several strategies available for this, we will choose the *innermost* strategy. This strategy will apply a transformation as many times as possible until a fixed point is reached. Because applying a transformation in part of an expression can enable new transformations in different parts of expressions, we we might need to re-apply `expr` to previously-processed nodes, so this strategy handles re-application for us. 
+
+
+The full code to apply `expr` with an *innermost* strategy is as follows: 
+
+```haskell
+opt :: Zipper Let -> Maybe (Zipper Let)
+opt t = applyTP (innermost step) t
+      where step = failTP `adhocTP` expr
+```
+
+There is a lot to unpack here. For starters, our input is a `Zipper Let` and our output is a `Maybe (Zipper Let)`. This is not a problem, as we can convert to and from `Zipper` with the functions `toZipper` and `fromZipper` easily (these are from the `Data.Generics.Zipper` module from the `syz` package).
+
+
+Then, we define a `step` worker function. This will be the function to be applied to every single node on the data type we are traversing. Note that this function can be applied to all nodes, even primitive data types such as `Int` or `Char`. We define this function by defining its default behaviour, which we define as `failTP` here, meaning that by default this worker function fails silently. We add more behaviours to it with the composing function `adhocTP` and its variations. We then add `expr` to our worker function. The resulting `step` function will apply `expr` if possible (when visiting an `Exp` node), otherwise applying `failTP` and therefore failing. 
+
+
+We then define what strategy we intend to use. We opt for `innermost`, and thus our strategy will be `innermost step`, meaning to apply `step` in a `innermost` way. (See more strategies [here](#markdown-header-api-reference)) This means that `step` will be applied as many times as possible, until it fails on all nodes. It is important that the `step` function respects this and fails when no work is to be done; if it does not fail, then the `innermost` strategy has no way to know it should stop, resulting in an endless loop. Choosing to use the failing function `failTP` or the identity function `idTP` as a default behaviour must depend on what kind of strategy is to be used. 
+
+
+Finally, we apply this strategy with the `applyTP` function. This strategy will apply the optimization rules we have defined as many times as possible until no optimizations are left. We only express transformations on the `Exp` data type, and we ignore the `Let` and `List` datatypes entirely, instead letting the strategic machinery handle them for us. 
+
+
+### Type-Unifying Strategies
+
+Let us now take a look at Type-Unifying strategies. These traverse a data structure and produce a new result out of it, and therefore they are perfect for reduce operations. We will define a function to count the number of assigned variables in a `Let`.
+
+
+There is a **very important** consideration when using Type-Unifying strategies. We can produce any result using them, but it must be an instance of the ~~`Semigroup`~~ `Monoid` class so that intermediate results can be concatenated into a single result. If you also need to select only part of the results and/or to stop the strategy halfway through the traversal, your result must be an instance of ~~`Alternative`~~ `MonadPlus` for the selection of only one alternative. If you don't understand what this means or are unsure on what to do, assuming you need to produce various `a` elements as an output, you can use a `[a]` as an output for the former behaviour only or a `Maybe [a]` for the latter (the alternative behaviour for lists is concatenation, not selection of a sublist, while the alternative behaviour for `Maybe` values is the selection of the left element). If you are also unsure of this, always use `Maybe [a]`. 
+
+
+Returning to our example, let us define the worker function. It will gather all the *declared* variables in a list, keeping the considerations above in mind: 
+
+```haskell
+countAssigns :: List -> Maybe [String]
+countAssigns (Assign s _ _)    = Just [s]
+countAssigns (NestedLet s _ _) = Just [s]
+countAssigns _                 = Nothing 
+```
+
+There is not much to unpack here. We count both `Assign` and `NestedLet` nodes, as they are both declarations of variables. For each, we return the name of the variable itself. As per the considerations above, we could return only a `[String]`, with no real difference for this example. 
+
+
+Next, we apply `countAssigns` to all nodes of our data. For this, we will be using a `full_tdTU` strategy, meaning full, top-down, type-unifying (See more strategies [here](#markdown-header-api-reference). This will traverse the data structure exactly once, from the top to the bottom, applying our worker function whenever possible: 
+
+```haskell
+declarations :: Zipper Let -> Int 
+declarations t = let result = applyTU (full_tdTU step) t 
+                     step   = failTU `adhocTU` countAssigns
+                 in case result of 
+                      Nothing -> 0
+                      Just l  -> length l      
+```
+
+As before, we define a `step` function, failing by default and applying `countAssigns` whenever possible. Note the `TU` suffix on the `fail` and `adhoc` functions. Our `result` will be of type `Maybe [String]`, which will be `Nothing` if we do not gather any results, or `Just l` in which `l` is a list of declared names; we count them with `length`. 
+
+
+### Strategic Data 
+
+The `StrategicData` module is an optimization baked into the  `Ztrategic` library. For a data structure to be traversable by this library, it must be an instance of `StrategicData`, and for most cases it is enough to use the default implementation. For this, we just include the line
+
+```haskell
+instance StrategicData <datatype>
+```
+
+anywhere in our code. However, we can instead decide we want to skip certain nodes in our traversal. Let us recall the `declarations` strategy we define above. We are counting declarations, but we are traversing all nodes - even nodes we know are completely irrelevant for us! For example, we are traversing into `String` values, which is completely useless. Due to Haskell's implementation of strings being a list of characters, which are in turn defined as a character appended to a list of characters, `String` values are deceptively deep and nested structures. The string `Test` contains 5 strings in it, specifically `Test`, `est`, `st`, `t` and the empty string, and it also contains each of the characters that make up the string, totalling 9 actual nodes visited by a strategy when the `Test` string is found (We prove this in module `Examples.Let.LetMisc`).
+
+**TODO**: continue this
+
+
+
+### API Reference
+
+#### Type-Preserving 
+
+
+**Strategies:** 
+
+
+* **full_tdTP** - Full, top-down, type-preserving strategy. Will fail if any node fails, so take care to only fail if the strategy needs to be interrupted. Use `idTP` to signal no changes on a node. 
+* **full_buTP** - Full, bottom-up, type-preserving strategy. Will fail if any node fails, so take care to only fail if the strategy needs to be interrupted. Use `idTP` to signal no changes on a node. 
+* **once_tdTP** - Once, top-down, type-preserving strategy. Will traverse through fails until it succeeds in applying a worker function once, then it will stop. Use `failTP` to signal a node is not changed by default. 
+* **once_buTP** - Once, bottom-up, type-preserving strategy. Will traverse through fails until it succeeds in applying a worker function once, then it will stop. Use `failTP` to signal a node is not changed by default. 
+* **stop_tdTP** - Stop, top-down, type-preserving strategy. Will stop traversing into the subtrees when it succeeds in applying a worker function once. This is different from the `once_` strategies as several subtrees can be branched into and traversed partially - it does not compute only once, instead it stops traversing downwards when it succeeds. Use `failTP` to signal a node is not changed by default. 
+* **stop_buTP** - Stop, bottom-up, type-preserving strategy. Will stop traversing into the subtrees when it succeeds in applying a worker function once. This is different from the `once_` strategies as several subtrees can be branched into and traversed partially - it does not compute only once, instead it stops traversing downwards when it succeeds. Use `failTP` to signal a node is not changed by default. 
+* **innermost** - Applies the given worker function as many times as possible, starting from the innermost node. This will loop infinitely if we do not signal fail properly when no changes are to be made. Use `failTP` to signal a node is not changed by default.
+* **outermost** - Applies the given worker function as many times as possible, starting from the outermost node. This will loop infinitely if we do not signal fail properly when no changes are to be made. Use `failTP` to signal a node is not changed by default.
+* **breadthFirst** - Full, top-down, type-preserving strategy. It traverses breadth-first instead of the depth-first behaviour of the previous strategies. Use it with caution as this strategy is particularly *volatile*, and changing the shape of the data structure being traversed breaks this strategy. Use `idTP` to signal no changes on a node.
+* **full_uptdTP** - Full, top-down, type-preserving strategy. Similar to `full_tdTP` but it makes use of the advantages of *Zippers* to only affect nodes above the starting node. 
+* **full_upbuTP** - Full, bottom-up, type-preserving strategy. Similar to `full_buTP` but it makes use of the advantages of *Zippers* to only affect nodes above the starting node. 
+* **once_uptdTP** - Full, top-down, type-preserving strategy. Similar to `once_tdTP` but it makes use of the advantages of *Zippers* to only affect nodes above the starting node. 
+* **once_upbuTP** - Full, bottom-up, type-preserving strategy. Similar to `once_buTP` but it makes use of the advantages of *Zippers* to only affect nodes above the starting node. 
+* **mutations** - Given a function `tr` that changes one node on a data structure, generates all possible combinations of data structures similar to the input, in which one node was changed by `tr`. The type of this strategy is an outlier and it reads `mutations :: a -> (n -> Maybe n) -> [a]`, meaning the input is a data structure and the aforementioned `tr` function, and the output is a list of variations of the input. 
+
+
+**Composition:**
+
+
+* **adhocTP** - Compose two functions. Apply the rightmost if possible, and if the types don't match, apply the leftmost one. 
+* **adhocTPSeq** - Compose two functions. Apply the rightmost and then the leftmost in sequence. This combinator makes it possible to compose two functions that operate on the same type, but this is generally less efficient (but possibly more expressive) than using `adhocTP` and a single worker function.   
+* **adhocTPZ** - Similar to `adhocTP`, but the worker function has access to a `Zipper` pointing to the current node. This enables the usage of Attribute Grammars and/or nested strategies. 
+* **adhocTPZSeq** - Similar to `adhocTPSeq`, but the worker function has access to a `Zipper` pointing to the current node. This enables the usage of Attribute Grammars and/or nested strategies. 
+
+
+#### Type-Unifying 
+
+
+**Strategies:** 
+
+
+* **full_tdTU** - Full, top-down, type-unifying strategy. Will traverse all nodes on a data structure, collecting whichever data we require and storing it into a structure. Use `failTP` to skip irrelevant nodes.
+* **full_buTU** - Full, bottom-up, type-unifying strategy. Will traverse all nodes on a data structure, collecting whichever data we require and storing it into a structure. Use `failTP` to skip irrelevant nodes.
+* **once_tdTU** - Once, top-down, type-unifying strategy. Will traverse all nodes on a data structure, until a node succeeds in producing data, in which case the traversal stops and said data is returned. Use `failTP` to skip irrelevant nodes.
+* **once_buTU** - Once, bottom-up, type-unifying strategy. Will traverse all nodes on a data structure, until a node succeeds in producing data, in which case the traversal stops and said data is returned. Use `failTP` to skip irrelevant nodes.
+* **stop_tdTU** - Stop, top-down, type-unifying strategy. Will stop traversing into the subtrees when it succeeds in applying a worker function once. This is different from the `once_` strategies as several subtrees can be branched into and traversed partially - it does not compute only once, instead it stops traversing downwards when it succeeds. Use `failTP` to skip irrelevant nodes.
+* **stop_buTU** - Stop, bottom-up, type-unifying strategy. Will stop traversing into the subtrees when it succeeds in applying a worker function once. This is different from the `once_` strategies as several subtrees can be branched into and traversed partially - it does not compute only once, instead it stops traversing downwards when it succeeds. Use `failTP` to skip irrelevant nodes.
+* **full_uptdTU** - Full, top-down, type-unifying strategy. Similar to `full_tdTU` but it makes use of the advantages of *Zippers* to only affect nodes above the starting node. 
+* **full_upbuTU** - Full, bottom-up, type-unifying strategy. Similar to `full_buTU` but it makes use of the advantages of *Zippers* to only affect nodes above the starting node. 
+* **once_uptdTU** - Once, top-down, type-unifying strategy. Similar to `once_tdTU` but it makes use of the advantages of *Zippers* to only affect nodes above the starting node. 
+* **once_upbuTU** - Once, bottom-up, type-unifying strategy. Similar to `once_buTU` but it makes use of the advantages of *Zippers* to only affect nodes above the starting node. 
+* **foldr1TU** - Folds relevant nodes right-to-left into a single result. Shorthand for `foldr1` after a strategy. 
+* **foldl1TU** - Folds relevant nodes left-to-right into a single result. Shorthand for `foldl1` after a strategy.
+* **foldrTU** - Folds relevant nodes right-to-left into a single result, using supplied value as a starting value. Shorthand for `foldr` after a strategy. 
+* **foldlTU** - Folds relevant nodes left-to-right into a single result. using supplied value as a starting value. Shorthand for `foldl` after a strategy.
+
+
+**Composition:**
+
+
+* **adhocTU** - Compose two functions. Apply the rightmost if possible, and if the types don't match, apply the leftmost one. 
+* **adhocTUZ** - Similar to `adhocTU`, but the worker function has access to a `Zipper` pointing to the current node. This enables the usage of Attribute Grammars and/or nested strategies.
+
+
+
+
+**TODO**: Finish small tutorial.
+
+
+
+## Repository Layout
+
+Here we showcase the different files in our repository and how they are organized.
+
+### Library
+
+This folder contains all the relevant files of the core Ztrategic library - these are what makes Ztrategic work, and will be imported throughout any relevant examples using this library. 
+
+#### Ztrategic.hs
+
+The main Ztrategic module. There are similar implementations for memoized versions in the Memo folder. 
+
+#### StrategicData.hs
+
+A module that defines the `StrategicData` class, which is mandatory for the main data type being traversed by Ztrategic. We use it to define terminal symbols that can be skipped by the traversals. A correct usage of this class can net relevant performance improvements. 
+
+**TODO**: add 2 examples, one for *never skip*, one for *skip strings*. 
+
+
+# Attribute Grammars
+
+# Combining AGs with Strategies
+
+

@@ -0,0 +1,52 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack++name:           Ztrategic+version:        0.1.0+synopsis:       Zipper-based library for strategic programming and attribute grammars.+description:    Strategic programming and attribute grammar library built on top of the Zipper data structure. Can be used as a strategic programming library exclusively, with the option of integrating attribute grammars during strategic term traversal. Supports non-memoized and memoized attribute grammars. +category:       Generics+stability:      experimental+homepage:       https://github.com/SLE-Laboratory/Ztrategic#readme+bug-reports:    https://github.com/SLE-Laboratory/Ztrategic/issues+author:         José Nuno Macedo <zenunomacedo@gmail.com>+maintainer:     José Nuno Macedo <zenunomacedo@gmail.com>+copyright:      © 2022 José Nuno Macedo+license:        MIT+license-file:   LICENSE+build-type:     Simple+tested-with:+    GHC == 9.4.7+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/SLE-Laboratory/Ztrategic++library+  exposed-modules:+      Language.Memo.AGMemo+      Language.Memo.Safe.AGMemo+      Language.Memo.Safe.Ztrategic+      Language.Memo.State.Ztrategic+      Language.Memo.Ztrategic+      Language.StrategicData+      Language.Ztrategic+  other-modules:+      Paths_Ztrategic+  hs-source-dirs:+      ./+  build-depends:+      ZipperAG >=1.0.0 && <2+    , base >4.14 && <5+    , monadplus >=1.4.3 && <2+    , mtl >2.0.0.0 && <3+    , random >1.0.0.0 && <2+    , syb <1.0+    , syz ==0.2.0.0+    , transformers >=0.5.6 && <0.7+  default-language: Haskell2010