Separated monad and datatype definitions from rest of code

3 files changed, 131 insertions, 106 deletions

diff --git a/Unlambda/Interpreter.hs b/Unlambda/Interpreter.hs
index 26050e6..44dcad9 100644
--- a/Unlambda/Interpreter.hs
+++ b/Unlambda/Interpreter.hs
@@ -4,40 +4,17 @@ module Unlambda.Interpreter (
 
 
 import System.IO.Error
-import Control.Exception( Exception(..), Handler(..), throw, catches )
-import Control.Monad.Trans.Class
 import Control.Monad.Trans.Cont
-import Control.Monad.Trans.State.Lazy
 import Control.Monad.IO.Class
-import Data.Typeable
 import Data.Maybe
 import Unlambda.Parser
+import Unlambda.Monad
 
 
 
-type ULM a = ContT UnlambdaTerm (StateT (Maybe Char) IO) a
-
-
-data UnlambdaException = UnlambdaException { exitValue :: UnlambdaTerm }
-    deriving (Show, Typeable)
-
-instance Exception UnlambdaException
-
-
 
 unlambda :: UnlambdaTerm -> IO UnlambdaTerm
-unlambda term = catches ((`evalStateT` Nothing) . (`runContT` return) $ eval term)
-                        [ Handler ((\e -> return . exitValue $ e) :: UnlambdaException -> IO UnlambdaTerm) ]
-
-
-
-setCurChar :: Maybe Char -> ULM ()
-setCurChar x = lift (put x)
-
-
-
-getCurChar :: ULM (Maybe Char)
-getCurChar = lift (get)
+unlambda term = getResult $ eval term
 
 
 
@@ -88,7 +65,7 @@ apply firstTerm secondTerm =
             liftIO (putChar '\n')
             return t
 
-        E -> eval secondTerm >>= throw . UnlambdaException
+        E -> eval secondTerm >>= doExit
 
         Reed -> do
             t <- eval secondTerm
diff --git a/Unlambda/Monad.hs b/Unlambda/Monad.hs
new file mode 100644
index 0000000..c432c08
--- /dev/null
+++ b/Unlambda/Monad.hs
@@ -0,0 +1,108 @@
+module Unlambda.Monad (
+	ULM,
+	UnlambdaTerm(..),
+
+    getResult,
+	doExit,
+	setCurChar,
+	getCurChar
+	) where
+
+
+import Control.Exception
+import Control.Monad.Trans.Cont
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.State.Lazy
+import Control.Monad.IO.Class
+import Data.Typeable
+
+
+
+
+data UnlambdaException = UnlambdaException { exitTerm :: UnlambdaTerm }
+    deriving (Show, Typeable)
+
+instance Exception UnlambdaException
+
+
+
+
+type ULM a = ContT UnlambdaTerm (StateT (Maybe Char) IO) a
+
+
+
+
+data UnlambdaTerm = S | K | I | V | R | D | C | E | Bar | Reed
+                  | Dot Char
+                  | Compare Char
+                  | App UnlambdaTerm UnlambdaTerm
+                  | Kpartial UnlambdaTerm
+                  | Spartial UnlambdaTerm
+                  | Sapp UnlambdaTerm UnlambdaTerm
+                  | Promise UnlambdaTerm
+                  | Continuation (UnlambdaTerm -> ULM UnlambdaTerm)
+
+
+instance Eq UnlambdaTerm where
+    S == S   =   True
+    K == K   =   True
+    I == I   =   True
+    V == V   =   True
+    R == R   =   True
+    D == D   =   True
+    C == C   =   True
+    E == E   =   True
+    Bar == Bar   =   True
+    Reed == Reed   =   True
+    Dot x == Dot y   =   x == y
+    Compare x == Compare y   =   x == y
+    App a b == App x y   =   a == x && b == y
+    Kpartial x == Kpartial y   =   x == y
+    Spartial x == Spartial y   =   x == y
+    Sapp a b == Sapp x y   =   a == x && b == y
+    Promise x == Promise y   =   x == y
+    _ == _   =   False
+
+
+instance Show UnlambdaTerm where
+    show S = "s"
+    show K = "k"
+    show I = "i"
+    show V = "v"
+    show R = "r"
+    show D = "d"
+    show C = "c"
+    show E = "e"
+    show Bar = "|"
+    show Reed = "@"
+    show (Dot x) = ['.', x]
+    show (Compare x) = ['?', x]
+    show (App x y) = "`" ++ (show x) ++ (show y)
+    show (Kpartial x) = "`k" ++ (show x)
+    show (Spartial x) = "`s" ++ (show x)
+    show (Sapp x y) = "``s" ++ (show x) ++ (show y)
+    show (Promise x) = "`d" ++ (show x)
+    show (Continuation _) = "<cont>"
+
+
+
+
+getResult :: ULM UnlambdaTerm -> IO UnlambdaTerm
+getResult m = catches (liftIO ((`evalStateT` Nothing) . (`runContT` return) $ m))
+                      [ Handler ((\e -> return (exitTerm e)) :: UnlambdaException -> IO UnlambdaTerm) ]
+
+
+
+doExit :: UnlambdaTerm -> ULM UnlambdaTerm
+doExit term = throw (UnlambdaException term)
+
+
+
+setCurChar :: Maybe Char -> ULM ()
+setCurChar x = lift (put x)
+
+
+
+getCurChar :: ULM (Maybe Char)
+getCurChar = lift (get)
+
diff --git a/Unlambda/Parser.hs b/Unlambda/Parser.hs
index 59fc5e3..5921f29 100644
--- a/Unlambda/Parser.hs
+++ b/Unlambda/Parser.hs
@@ -1,74 +1,13 @@
 module Unlambda.Parser (
-    UnlambdaTerm(..),
-
     parseUnlambda,
     parseUnlambda1
     ) where
 
 
 import Control.Applicative( some )
-import Control.Monad.Trans.Cont
-import Control.Monad.IO.Class
-import Control.Monad.Trans.State.Lazy
 import Data.Either
 import Text.ParserCombinators.Parsec
-
-
-
-type ULM a = ContT UnlambdaTerm (StateT (Maybe Char) IO) a
-
-
-data UnlambdaTerm = S | K | I | V | R | D | C | E | Bar | Reed
-                  | Dot Char
-                  | Compare Char
-                  | App UnlambdaTerm UnlambdaTerm
-                  | Kpartial UnlambdaTerm
-                  | Spartial UnlambdaTerm
-                  | Sapp UnlambdaTerm UnlambdaTerm
-                  | Promise UnlambdaTerm
-                  | Continuation (UnlambdaTerm -> ULM UnlambdaTerm)
-
-
-instance Eq UnlambdaTerm where
-    S == S   =   True
-    K == K   =   True
-    I == I   =   True
-    V == V   =   True
-    R == R   =   True
-    D == D   =   True
-    C == C   =   True
-    E == E   =   True
-    Bar == Bar   =   True
-    Reed == Reed   =   True
-    Dot x == Dot y   =   x == y
-    Compare x == Compare y   =   x == y
-    App a b == App x y   =   a == x && b == y
-    Kpartial x == Kpartial y   =   x == y
-    Spartial x == Spartial y   =   x == y
-    Sapp a b == Sapp x y   =   a == x && b == y
-    Promise x == Promise y   =   x == y
-    _ == _   =   False
-
-
-instance Show UnlambdaTerm where
-    show S = "s"
-    show K = "k"
-    show I = "i"
-    show V = "v"
-    show R = "r"
-    show D = "d"
-    show C = "c"
-    show E = "e"
-    show Bar = "|"
-    show Reed = "@"
-    show (Dot x) = ['.', x]
-    show (Compare x) = ['?', x]
-    show (App x y) = "`" ++ (show x) ++ (show y)
-    show (Kpartial x) = "`k" ++ (show x)
-    show (Spartial x) = "`s" ++ (show x)
-    show (Sapp x y) = "``s" ++ (show x) ++ (show y)
-    show (Promise x) = "`d" ++ (show x)
-    show (Continuation _) = "<cont>"
+import Unlambda.Monad
 
 
 
@@ -91,6 +30,7 @@ parseUnlambda1 input =
 
 
 
+
 removeComments = uline `sepEndBy` eol >>= (return . concat)
 
 
@@ -127,24 +67,24 @@ unlambda1 = do
     return t
 
 
-term  =  (try term1)
-     <|> (try e)
-     <|> (try reed)
-     <|> (try comp)
-     <|> (try bar)
-     <?> "unlambda term"
-
-
-term1  =  (try app)
-      <|> (try s)
-      <|> (try k)
-      <|> (try i)
-      <|> (try v)
-      <|> (try r)
-      <|> (try d)
-      <|> (try c)
-      <|> (try dot)
-      <?> "unlambda term"
+term =  (try term1)
+    <|> (try e)
+    <|> (try reed)
+    <|> (try comp)
+    <|> (try bar)
+    <?> "unlambda term"
+
+
+term1 =  (try app)
+    <|> (try s)
+    <|> (try k)
+    <|> (try i)
+    <|> (try v)
+    <|> (try r)
+    <|> (try d)
+    <|> (try c)
+    <|> (try dot)
+    <?> "unlambda term"
 
 
 app = do