From 005d847234a84b58b1f2ef1baec8b3fdd238c2df Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Fri, 14 Mar 2014 13:37:55 +1100 Subject: Renamed Unlambda.Monad to Unlambda.Types --- Unlambda/Interpreter.hs | 2 +- Unlambda/Monad.hs | 108 ------------------------------------------------ Unlambda/Parser.hs | 2 +- Unlambda/Types.hs | 108 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 110 insertions(+), 110 deletions(-) delete mode 100644 Unlambda/Monad.hs create mode 100644 Unlambda/Types.hs (limited to 'Unlambda') diff --git a/Unlambda/Interpreter.hs b/Unlambda/Interpreter.hs index 44dcad9..f1dcf05 100644 --- a/Unlambda/Interpreter.hs +++ b/Unlambda/Interpreter.hs @@ -8,7 +8,7 @@ import Control.Monad.Trans.Cont import Control.Monad.IO.Class import Data.Maybe import Unlambda.Parser -import Unlambda.Monad +import Unlambda.Types diff --git a/Unlambda/Monad.hs b/Unlambda/Monad.hs deleted file mode 100644 index c432c08..0000000 --- a/Unlambda/Monad.hs +++ /dev/null @@ -1,108 +0,0 @@ -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 _) = "" - - - - -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 5921f29..23bf723 100644 --- a/Unlambda/Parser.hs +++ b/Unlambda/Parser.hs @@ -7,7 +7,7 @@ module Unlambda.Parser ( import Control.Applicative( some ) import Data.Either import Text.ParserCombinators.Parsec -import Unlambda.Monad +import Unlambda.Types diff --git a/Unlambda/Types.hs b/Unlambda/Types.hs new file mode 100644 index 0000000..825a624 --- /dev/null +++ b/Unlambda/Types.hs @@ -0,0 +1,108 @@ +module Unlambda.Types ( + 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 _) = "" + + + + +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) + -- cgit