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/Monad.hs | 108 ------------------------------------------------------ 1 file changed, 108 deletions(-) delete mode 100644 Unlambda/Monad.hs (limited to 'Unlambda/Monad.hs') 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) - -- cgit