Rearranging files

5 files changed, 0 insertions, 491 deletions

diff --git a/Unlambda/Builtins.hs b/Unlambda/Builtins.hs
deleted file mode 100644
index bb054a1..0000000
--- a/Unlambda/Builtins.hs
+++ /dev/null
@@ -1,70 +0,0 @@
-module Unlambda.Builtins (
-	k,
-	s,
-	i,
-	dot,
-	r,
-	d,
-	c,
-	e
-	) where
-
-
-import Control.Exception( Exception(..), throw )
-
-
-
-data MyException = MyException { func :: a -> b }
-    deriving (Show, Eq)
-
-instance Exception MyException
-
-
-
-k :: a -> b -> a
-k x y = x
-
-
-
-s :: (a -> b -> c) -> (a -> b) -> a -> c
-s x y z = (x z) (y z)
-
-
-
-i :: a -> a
-i = id
-
-
-
-class Void a where
-	v :: a -> r
-
-instance Void v => Void (a -> r) where
-	v x = v
-
-
-
-dot :: Char -> a -> IO a
-dot ch f = putChar ch >> return f
-
-
-
-r :: a -> IO a
-r f = putChar '\n' >> return f
-
-
-
--- may not work as per unlambda lazy semantics
-d :: (a -> b) -> (a -> b)
-d x = (\y -> x y)
-
-
-
-c :: (a -> b) -> (a -> b)
-c x = (`runCont` id) (callCC $ \cont -> x cont)
-
-
-
-e :: a -> b
-e x = throw (MyException x)
-
diff --git a/Unlambda/Interpreter.hs b/Unlambda/Interpreter.hs
deleted file mode 100644
index f1dcf05..0000000
--- a/Unlambda/Interpreter.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-module Unlambda.Interpreter (
-    unlambda
-    ) where
-
-
-import System.IO.Error
-import Control.Monad.Trans.Cont
-import Control.Monad.IO.Class
-import Data.Maybe
-import Unlambda.Parser
-import Unlambda.Types
-
-
-
-
-unlambda :: UnlambdaTerm -> IO UnlambdaTerm
-unlambda term = getResult $ eval term
-
-
-
-eval :: UnlambdaTerm -> ULM UnlambdaTerm
-eval term =
-    case term of
-        App f x -> do
-            t <- eval f
-            apply t x
-        _ -> return term
-
-
-
-apply :: UnlambdaTerm -> UnlambdaTerm -> ULM UnlambdaTerm
-apply firstTerm secondTerm =
-    case firstTerm of
-        K -> eval secondTerm >>= return . Kpartial
-
-        Kpartial x -> eval secondTerm >> return x
-
-        S -> eval secondTerm >>= return . Spartial
-
-        Spartial x -> eval secondTerm >>= return . (Sapp x)
-
-        Sapp x y -> do
-            z <- eval secondTerm
-            eval (App (App x z) (App y z))
-
-        I -> eval secondTerm
-
-        V -> eval secondTerm >> return V
-
-        C -> callCC $ \cont -> eval (App secondTerm (Continuation cont))
-
-        Continuation cont -> eval secondTerm >>= cont
-
-        D -> return (Promise secondTerm)
-
-        Promise x -> eval secondTerm >>= eval . (App x)
-
-        Dot c -> do
-            t <- eval secondTerm
-            liftIO (putChar c)
-            return t
-
-        R -> do
-            t <- eval secondTerm
-            liftIO (putChar '\n')
-            return t
-
-        E -> eval secondTerm >>= doExit
-
-        Reed -> do
-            t <- eval secondTerm
-            ch <- liftIO (catchIOError (getChar >>= return . Just) (\e -> return Nothing))
-            setCurChar ch
-            if (isNothing ch) then eval (App t V) else eval (App t I)
-
-        Bar -> do
-            t <- eval secondTerm
-            ch <- getCurChar
-            if (isNothing ch) then eval (App t V) else eval (App t I)
-
-        Compare c -> do
-            t <- eval secondTerm
-            ch <- getCurChar
-            if (ch /= Just c) then eval (App t V) else eval (App t I)
-
diff --git a/Unlambda/Parser.hs b/Unlambda/Parser.hs
deleted file mode 100644
index 23bf723..0000000
--- a/Unlambda/Parser.hs
+++ /dev/null
@@ -1,125 +0,0 @@
-module Unlambda.Parser (
-    parseUnlambda,
-    parseUnlambda1
-    ) where
-
-
-import Control.Applicative( some )
-import Data.Either
-import Text.ParserCombinators.Parsec
-import Unlambda.Types
-
-
-
-
-parseUnlambda :: String -> Either ParseError UnlambdaTerm
-parseUnlambda input = 
-    let firstPass = parse removeComments "error" input
-    in case firstPass of
-        Left e -> Left e
-        Right o -> parse unlambda "error" o
-
-
-
-parseUnlambda1 :: String -> Either ParseError UnlambdaTerm
-parseUnlambda1 input =
-    let firstPass = parse removeComments "error" input
-    in case firstPass of
-        Left e -> Left e
-        Right o -> parse unlambda1 "error" o
-
-
-
-
-removeComments = uline `sepEndBy` eol >>= (return . concat)
-
-
-uline = do
-    l <- many (builtin <|> (oneOf " \t" >>= return . (:[])))
-    optional (char '#' >> many (noneOf "\r\n"))
-    return . concat $ l
-
-
-builtin  =  (oneOf "`skivrdce|@" >>= return . (:[]))
-        <|> (char '.' >> anyChar >>= return . ('.':) . (:[]))
-        <|> (char '?' >> anyChar >>= return . ('?':) . (:[]))
-        <?> "unlambda builtin function"
-
-
-eol  =  try (string "\r\n")
-    <|> try (string "\n\r")
-    <|> try (string "\r")
-    <|> try (string "\n")
-    <?> "end of line"
-
-
-unlambda = do
-    whiteSpace
-    t <- term
-    eof
-    return t
-
-
-unlambda1 = do
-    whiteSpace
-    t <- term1
-    eof
-    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"
-
-
-app = do
-    char '`'
-    whiteSpace
-    f <- term
-    x <- term
-    return (App f x)
-
-
-s = char 's' >> whiteSpace >> return S
-k = char 'k' >> whiteSpace >> return K
-i = char 'i' >> whiteSpace >> return I
-v = char 'v' >> whiteSpace >> return V
-r = char 'r' >> whiteSpace >> return R
-d = char 'd' >> whiteSpace >> return D
-c = char 'c' >> whiteSpace >> return C
-e = char 'e' >> whiteSpace >> return E
-reed = char '@' >> whiteSpace >> return Reed
-bar = char '|' >> whiteSpace >> return Bar
-
-
-comp = do
-    char '?'
-    c <- anyChar
-    whiteSpace
-    return (Compare c)
-
-
-dot = do
-    char '.'
-    c <- anyChar
-    whiteSpace
-    return (Dot c)
-
-
-whiteSpace = many (oneOf "\t\n\r ")
-
diff --git a/Unlambda/Test.hs b/Unlambda/Test.hs
deleted file mode 100644
index f049b59..0000000
--- a/Unlambda/Test.hs
+++ /dev/null
@@ -1,103 +0,0 @@
-module Unlambda.Test (
-    parserTests,
-    interpreterTests,
-    tests,
-    ioTests
-    ) where
-
-
-import Test.HUnit
-import Text.Parsec.Error
-import Control.Monad
-import System.IO.Silently
-import Unlambda.Types
-import Unlambda.Parser
-import Unlambda.Interpreter
-
-
-instance Eq Text.Parsec.Error.ParseError
-
-
-
-
-parser0 = (Right S) ~=? (parseUnlambda "s")
-
-parser1 = (Right K) ~=? (parseUnlambda "k")
-
-parser2 = (Right I) ~=? (parseUnlambda "i")
-
-parser3 = (Right V) ~=? (parseUnlambda "v")
-
-parser4 = (Right R) ~=? (parseUnlambda "r")
-
-parser5 = (Right D) ~=? (parseUnlambda "d")
-
-parser6 = (Right C) ~=? (parseUnlambda "c")
-
-parser7 = (Right E) ~=? (parseUnlambda "e")
-
-parser8 = (Right (App S K)) ~=? (parseUnlambda "`sk")
-
-parser9 = (Right (Dot 'c')) ~=? (parseUnlambda ".c")
-
-parser10 = (Right (Compare '?')) ~=? (parseUnlambda "??")
-
-parser11 = (Right Bar) ~=? (parseUnlambda "|")
-
-parser12 = (Right Reed) ~=? (parseUnlambda "@")
-
-
-
-interpretString :: String -> IO (Maybe (String,UnlambdaTerm))
-interpretString input =
-    let t = parseUnlambda input
-    in case t of
-        Left _ -> return Nothing
-        Right term -> do
-            c <- capture (unlambda term)
-            return (Just c)
-
-
-
-interpreter0 = (liftM2 (~=?))
-                    (return (Just ("\n", R)) )
-                    (interpretString "``cir")
-
-interpreter1 = (liftM2 (~=?))
-                    (return (Just ("", I)) )
-                    (interpretString "`c``s`kr``si`ki")
-
-interpreter2 = (liftM2 (~=?))
-                    (return (Just ("", Promise (App R I))) )
-                    (interpretString "`d`ri")
-
-interpreter3 = (liftM2 (~=?))
-                    (return (Just ("\n", Promise I)) )
-                    (interpretString "``dd`ri")
-
-
-
-parserTests :: Test
-parserTests = TestList [parser0, parser1, parser2, parser3, parser4, parser5, parser6, parser7, parser8
-                       ,parser9, parser10, parser11, parser12]
-
-
-
-interpreterTests :: IO Test
-interpreterTests = do
-    t0 <- interpreter0
-    t1 <- interpreter1
-    t2 <- interpreter2
-    t3 <- interpreter3
-    return (TestList [t0,t1,t2,t3])
-
-
-
-tests :: Test
-tests = parserTests
-
-
-
-ioTests :: IO Test
-ioTests = interpreterTests
-
diff --git a/Unlambda/Types.hs b/Unlambda/Types.hs
deleted file mode 100644
index 825a624..0000000
--- a/Unlambda/Types.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-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 _) = "<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)
-