3 files changed, 65 insertions, 8 deletions
diff --git a/src/Haskell/Env/Cmd.hs b/src/Haskell/Env/Cmd.hs
new file mode 100644
index 0000000..35a6542
--- /dev/null
+++ b/src/Haskell/Env/Cmd.hs
@@ -0,0 +1,48 @@
+module Haskell.Env.Cmd where
+
+import Haskell.AST
+import Haskell.Rewrite
+import Pretty
+import Util
+
+
+data Action = Action RewCmd Name
+  deriving (Show)
+
+data RewCmd = CRewrite Name
+            | CBeta
+            | CEta
+            | CCase
+            | CCaseForce
+            | CEtaCase
+            | CCaseCase
+            | CRepeat RewCmd
+  deriving (Show)
+
+instance Pretty Action where
+    pretty (Action cmd target) = Node ("action " ++ target) [pretty cmd]
+
+instance Pretty RewCmd where
+    pretty (CRewrite name) = Leaf ("rew " ++ name)
+    pretty CBeta = Leaf "beta"
+    pretty CEta = Leaf "eta"
+    pretty CCase = Leaf "case"
+    pretty CCaseForce = Leaf "case!"
+    pretty CEtaCase = Leaf "etacase"
+    pretty CCaseCase = Leaf "casecase"
+    pretty (CRepeat cmd) = Node "repeat" [pretty cmd]
+
+
+exprTransformer :: RewCmd -> Maybe (Expr -> Expr)
+exprTransformer = fmap (normalise .) . exprTransformer'
+
+exprTransformer' :: RewCmd -> Maybe (Expr -> Expr)
+exprTransformer' (CRewrite _) = Nothing
+exprTransformer' CBeta        = Just betared
+exprTransformer' CEta         = Just etared
+exprTransformer' CCase        = Just (casered False)
+exprTransformer' CCaseForce   = Just (casered True)
+exprTransformer' CEtaCase     = Just etacase
+exprTransformer' CCaseCase    = Just casecase
+exprTransformer' (CRepeat (CRepeat cmd)) = exprTransformer' (CRepeat cmd)
+exprTransformer' (CRepeat cmd) = fixpoint <$> exprTransformer' cmd
diff --git a/src/Haskell/Env/Context.hs b/src/Haskell/Env/Context.hs
new file mode 100644
index 0000000..2e6b6cc
--- /dev/null
+++ b/src/Haskell/Env/Context.hs
@@ -0,0 +1,15 @@
+module Haskell.Env.Context where
+
+import Haskell.Env
+import Haskell.Env.Cmd
+
+
+data Context = Context { cStack :: [(Action, Env)], cBaseEnv :: Env }
+  deriving (Show)
+
+topEnv :: Context -> Env
+topEnv (Context [] env) = env
+topEnv (Context ((_, env):_) _) = env
+
+pushCtx :: (Action, Env) -> Context -> Context
+pushCtx pair ctx = ctx { cStack = pair : cStack ctx }
diff --git a/src/Haskell/Rewrite.hs b/src/Haskell/Rewrite.hs
index c33f62e..bcec6f7 100644
--- a/src/Haskell/Rewrite.hs
+++ b/src/Haskell/Rewrite.hs
@@ -3,14 +3,14 @@ module Haskell.Rewrite
     ,betared, etared, casered
     ,etacase, casecase
     ,autoSimp
-    ,normalise
-    ,fixpoint) where
+    ,normalise) where
 
 import Control.Monad
 import Data.List
 import Data.Maybe
 import qualified Data.Map.Strict as Map
 import Haskell.AST
+import Util
 
 
 rewrite :: Name -> Expr -> Expr -> Expr
@@ -105,9 +105,3 @@ recurse _  _ (Num k) = Num k
 recurse _  f (Tup es) = Tup (map f es)
 recurse _  f (Lam ns e) = Lam ns (f e)
 recurse fp f (Case e as) = Case (f e) (map (\(p, e') -> (fp p, f e')) as)
-
-fixpoint :: Eq a => (a -> a) -> a -> a
-fixpoint f initVal =
-    let values = iterate f initVal
-        pairs = zip values (tail values)
-    in fst . head $ dropWhile (uncurry (/=)) pairs