Rearranging files

21 files changed, 1262 insertions, 0 deletions

diff --git a/src/Brainfuck/Interpreter.hs b/src/Brainfuck/Interpreter.hs
new file mode 100644
index 0000000..1085a30
--- /dev/null
+++ b/src/Brainfuck/Interpreter.hs
@@ -0,0 +1,70 @@
+module Brainfuck.Interpreter (
+    brainfuck
+    ) where
+
+
+import Data.Char
+import Data.Maybe
+import Brainfuck.Parser
+import Brainfuck.Tape
+
+
+
+
+brainfuck :: BrainfuckProgram -> IO (Tape Int)
+brainfuck program =
+    let dataTape = (repeat 0, Just 0, repeat 0)
+        commandTape = shiftRight ([], Nothing, program)
+    in process commandTape dataTape
+
+
+
+endLoop :: Tape BrainCom -> Tape BrainCom
+endLoop tape =
+    let f t c = case (currentCell t, c) of
+                    (Just CloseLoop, 0) -> shiftRight t
+                    (Just OpenLoop, x) -> f (shiftRight t) (x + 1)
+                    (Just CloseLoop, x) -> f (shiftRight t) (x - 1)
+                    (Just com, x) -> f (shiftRight t) x
+    in f (shiftRight tape) 0
+
+
+
+doLoop :: Tape BrainCom -> Tape BrainCom
+doLoop tape =
+    let f t c = case (currentCell t, c) of
+                    (Just OpenLoop, 0) -> shiftRight t
+                    (Just OpenLoop, x) -> f (shiftLeft t) (x - 1)
+                    (Just CloseLoop, x) -> f (shiftLeft t) (x + 1)
+                    (Just com, x) -> f (shiftLeft t) x
+    in f (shiftLeft tape) 0
+
+
+
+process :: Tape BrainCom -> Tape Int -> IO (Tape Int)
+process commandTape dataTape =
+    case (currentCell commandTape) of
+        Nothing -> return dataTape
+
+        Just R -> process (shiftRight commandTape) (shiftRight dataTape)
+
+        Just L -> process (shiftRight commandTape) (shiftLeft dataTape)
+
+        Just Inc -> process (shiftRight commandTape) (applyToCurrentCell ((`mod` 256) . (+1)) dataTape)
+
+        Just Dec -> process (shiftRight commandTape) (applyToCurrentCell ((`mod` 256) . (subtract 1)) dataTape)
+
+        Just Out -> (putChar . chr . fromJust . currentCell $ dataTape) >> process (shiftRight commandTape) dataTape
+
+        Just In -> do { c <- getChar; process (shiftRight commandTape) (applyToCurrentCell (\_ -> ord c) dataTape) }
+
+        Just OpenLoop ->
+                if (currentCell dataTape == Just 0)
+                then process (endLoop commandTape) dataTape
+                else process (shiftRight commandTape) dataTape
+
+        Just CloseLoop ->
+                if (currentCell dataTape /= Just 0)
+                then process (doLoop commandTape) dataTape
+                else process (shiftRight commandTape) dataTape
+
diff --git a/src/Brainfuck/Parser.hs b/src/Brainfuck/Parser.hs
new file mode 100644
index 0000000..1ea046a
--- /dev/null
+++ b/src/Brainfuck/Parser.hs
@@ -0,0 +1,62 @@
+module Brainfuck.Parser (
+    BrainfuckProgram,
+    BrainCom(..),
+
+	parseBrainfuck
+    ) where
+
+import Control.Applicative( some )
+import Text.ParserCombinators.Parsec
+
+
+
+type BrainfuckProgram = [BrainCom]
+
+
+data BrainCom = R | L | Inc | Dec | Out | In | OpenLoop | CloseLoop
+    deriving (Show, Eq)
+
+
+
+
+parseBrainfuck :: String -> Either ParseError BrainfuckProgram
+parseBrainfuck = parse brainfuck "error"
+
+
+
+
+brainfuck = do
+	many commentChar
+	bs <- many fuck
+	eof
+	return . concat $ bs
+
+
+fuck =  (brainCommand >>= return . (:[]))
+    <|> loop
+    <?> "brainfuck command"
+
+
+loop = do
+	char '['
+	many commentChar
+	bs <- many brainCommand
+	char ']'
+	many commentChar
+	return . concat $ [[OpenLoop],bs,[CloseLoop]]
+
+
+brainCommand = do { b <- brainCom; many commentChar; return b }
+
+
+brainCom =  (char '>' >> return R)
+        <|> (char '<' >> return L)
+        <|> (char '+' >> return Inc)
+        <|> (char '-' >> return Dec)
+        <|> (char '.' >> return Out)
+        <|> (char ',' >> return In)
+        <?> "brainfuck command"
+
+
+commentChar = noneOf "><+-.,[]"
+
diff --git a/src/Brainfuck/Tape.hs b/src/Brainfuck/Tape.hs
new file mode 100644
index 0000000..8da4352
--- /dev/null
+++ b/src/Brainfuck/Tape.hs
@@ -0,0 +1,46 @@
+module Brainfuck.Tape (
+    Tape,
+
+    shiftLeft,
+    shiftRight,
+    currentCell,
+    applyToCurrentCell
+    ) where
+
+
+import Control.Monad
+import Data.Maybe
+
+
+
+type Tape a = ([a], Maybe a, [a])
+
+
+
+
+shiftLeft :: Eq a => Tape a -> Tape a
+shiftLeft (x,y,z) = 
+	let x' = if (x /= []) then tail x else x
+	    y' = if (x /= []) then Just (head x) else Nothing
+	    z' = if (isJust y) then (fromJust y):z else z
+	in (x', y', z')
+
+
+
+shiftRight :: Eq a => Tape a -> Tape a
+shiftRight (x,y,z) =
+	let x' = if (isJust y) then (fromJust y):x else x
+	    y' = if (z /= []) then Just (head z) else Nothing
+	    z' = if (z /= []) then tail z else z
+	in (x', y', z')
+
+
+
+currentCell :: Tape a -> Maybe a
+currentCell (_,c,_) = c
+
+
+
+applyToCurrentCell :: (a -> a) -> Tape a -> Tape a
+applyToCurrentCell f (x,y,z) = (x, (liftM f) y, z)
+
diff --git a/src/Fractran/Example.hs b/src/Fractran/Example.hs
new file mode 100644
index 0000000..43d8cc8
--- /dev/null
+++ b/src/Fractran/Example.hs
@@ -0,0 +1,46 @@
+module Fractran.Example (
+    addition,
+    multiply,
+    prime2,
+    prime10short,
+    prime10) where
+
+
+import Fractran.Parser
+
+
+
+
+-- some simple fractran programs
+
+
+-- these ones need an initial input added of the appropriate form
+
+-- input: 2^a * 3^b
+-- output: 3^(a+b)
+addition :: [(Int,Int)]
+addition = [(3,2)]
+
+-- input: 2^a * 3^b
+-- output: 5^ab
+multiply :: [(Int,Int)]
+multiply = [(13,21), (385,13), (1,7), (3,11), (7,2), (1,3)]
+
+
+
+
+-- these ones are already in ready to interpret, FractranProgram form
+
+-- input: 2
+-- output: a sequence containing all prime powers of 2
+prime2 :: FractranProgram
+prime2 = FractranProgram [(17,91), (78,85), (19,51), (23,38), (29,33), (77,29), (95,23), (77,19), (1,17), (11,13), (13,11), (15,14), (15,2), (55,1)] 2
+
+-- input: 10
+-- output: a sequence containing all prime powers of 10
+prime10short :: FractranProgram
+prime10short = FractranProgram [(3,11), (847,45), (143,6), (7,3), (10,91), (3,7), (36,325), (1,2), (36,5)] 10
+
+prime10 :: FractranProgram
+prime10 = FractranProgram [(7,3), (99,98), (13,49), (39,35), (36,91), (10,143), (49,13), (7,11), (1,2), (91,1)] 10
+
diff --git a/src/Fractran/Interpreter.hs b/src/Fractran/Interpreter.hs
new file mode 100644
index 0000000..1393991
--- /dev/null
+++ b/src/Fractran/Interpreter.hs
@@ -0,0 +1,29 @@
+module Fractran.Interpreter (
+    fractran
+	) where
+
+
+import Fractran.Parser
+
+
+
+
+fractran :: FractranProgram -> [Int]
+fractran program =
+    let prog = map (\(x,y) -> (fromIntegral x, fromIntegral y)) (fractions program)
+        f = (\p v -> if (p == [])
+                     then []
+                     else let (curX, curY) = head p
+                              newV = v * curX / curY
+                          in if (isInt newV)
+                             then newV : (f prog newV)
+                             else f (tail p) v)
+        result = map round (f prog (fromIntegral (initialValue program)))
+    in (initialValue program) : result
+
+
+
+isInt :: (RealFrac a) => a -> Bool
+isInt x =
+    x == fromInteger (round x)
+
diff --git a/src/Fractran/Parser.hs b/src/Fractran/Parser.hs
new file mode 100644
index 0000000..95aa954
--- /dev/null
+++ b/src/Fractran/Parser.hs
@@ -0,0 +1,68 @@
+module Fractran.Parser (
+    FractranProgram(..),
+
+    parseFractran
+    ) where
+
+
+import Control.Applicative( some )
+import Text.ParserCombinators.Parsec
+
+
+
+data FractranProgram = FractranProgram { fractions :: [(Int,Int)]
+                                       , initialValue :: Int }
+    deriving (Show, Eq)
+
+
+
+
+parseFractran :: String -> Either ParseError FractranProgram
+parseFractran = parse fractran "error"
+
+
+
+
+fractran = do
+    whiteSpace
+    value <- initVal
+    fractionList <- many intPair
+    eof
+    return (FractranProgram fractionList value)
+
+
+intPair = do
+    numerator <- wholeNumber
+    slash
+    denominator <- positiveNumber
+    whiteSpace
+    return (numerator,denominator)
+
+
+slash  =  char '/'
+      <?> "slash character"
+
+
+initVal = do
+    value <- wholeNumber
+    whiteSpace
+    return value
+
+
+wholeNumber = do
+    value <- some digit
+    return (read value)
+
+
+positiveNumber = do
+    firstDigit <- nonZeroDigit
+    rest <- many digit
+    return (read (firstDigit:rest))
+
+
+nonZeroDigit  =  oneOf "123456789"
+             <?> "non-zero digit"
+
+
+whiteSpace = many (oneOf "\t\n\r ")
+
diff --git a/src/Fractran/Test.hs b/src/Fractran/Test.hs
new file mode 100644
index 0000000..2b507b1
--- /dev/null
+++ b/src/Fractran/Test.hs
@@ -0,0 +1,53 @@
+module Fractran.Test (
+	parserTests,
+	interpreterTests,
+	tests
+    ) where
+
+
+import Test.HUnit
+import Text.Parsec.Error
+import Fractran.Parser
+import Fractran.Interpreter
+import Fractran.Example
+
+
+instance Eq Text.Parsec.Error.ParseError
+
+
+
+
+parser0 = (Right (FractranProgram [] 2)) ~=? (parseFractran "2")
+
+parser1 = (Right (FractranProgram [] 2)) ~=? (parseFractran "2\n")
+
+parser2 = (Right (FractranProgram [] 2)) ~=? (parseFractran "\n2")
+
+parser3 = (Right (FractranProgram [(1,2)] 2)) ~=? (parseFractran "2 1/2")
+
+parser4 = (Right (FractranProgram [(2,3)] 3)) ~=? (parseFractran "3\n \n2/3\n")
+
+
+
+interpreter0 = [108,162,243] ~=? (fractran (FractranProgram addition 108))
+
+interpreter1 = [2,15,825,725,1925,2275,425,390,330,290,770,910,170,156,132,116,308,364,68,4] ~=? (take 20 (fractran prime2))
+
+interpreter2 = [5] ~=? (fractran (FractranProgram addition 5))
+
+
+
+parserTests :: Test
+parserTests = TestList [parser0, parser1,parser2, parser3, parser4]
+
+
+
+interpreterTests :: Test
+interpreterTests = TestList [interpreter0, interpreter1, interpreter2]
+
+
+
+tests :: Test
+tests = case (parserTests, interpreterTests) of
+	(TestList a, TestList b) -> TestList (a ++ b)
+
diff --git a/src/Thue/Interpreter.hs b/src/Thue/Interpreter.hs
new file mode 100644
index 0000000..c53bff9
--- /dev/null
+++ b/src/Thue/Interpreter.hs
@@ -0,0 +1,77 @@
+module Thue.Interpreter (
+    thue,
+    extractInfix,
+    nextInRange
+    ) where
+
+
+import System.Random
+import Data.Maybe
+import Data.List
+import Thue.Parser
+
+
+
+
+thue :: ThueProgram -> IO ThueState
+thue program =
+    let rules = thueRules program
+        state = thueInitialState program
+        gen = mkStdGen 4 --chosen by fair dice roll, guaranteed to be random
+
+    in interpret state rules gen
+
+
+
+interpret :: ThueState -> [ThueRule] -> StdGen -> IO ThueState
+interpret state rules gen = do
+    let possibleRules = rules `applicableTo` state
+        ruleToApply = if (possibleRules == []) then (ThueRule "" "") else possibleRules !! num
+        -- ^ dummy rule if no possible rules apply
+
+        (num, gen') = nextInRange 0 (length possibleRules - 1) gen
+
+        (before, after) = fromJust (extractInfix (original ruleToApply) state)
+
+    state' <- case (replacement ruleToApply) of
+                ":::" -> getLine >>= (\x -> return (before ++ x ++ after))
+
+                '~':xs -> putStr xs >> return (before ++ after)
+
+                x -> return (before ++ x ++ after)
+
+    if (possibleRules == []) then return state else interpret state' rules gen'
+
+
+
+extractInfix :: Eq a => [a] -> [a] -> Maybe ([a], [a])
+extractInfix subList list =
+    let f = (\pre cur -> case (stripPrefix subList cur) of
+                            Nothing -> f ((head cur):pre) (tail cur)
+                            Just x -> (reverse pre, x))
+
+    in if (subList `isInfixOf` list) then Just (f [] list) else Nothing
+
+
+
+nextInRange :: Int -> Int -> StdGen -> (Int, StdGen)
+nextInRange low high random =
+    let (genLow, genHigh) = genRange random
+        (rawNext, random') = next random
+
+        irawNext = fromIntegral rawNext
+        igenLow = fromIntegral genLow
+        igenHigh = fromIntegral genHigh
+        ilow = fromIntegral low
+        ihigh = fromIntegral high
+
+        n' = ((irawNext - igenLow) / (igenHigh - igenLow)) * (ihigh - ilow) + ilow
+
+    in (round n', random')
+
+
+
+applicableTo :: [ThueRule] -> ThueState -> [ThueRule]
+applicableTo ruleList state =
+    filter (\r -> (original r) `isInfixOf` state) ruleList
+
diff --git a/src/Thue/Parser.hs b/src/Thue/Parser.hs
new file mode 100644
index 0000000..2ee41ae
--- /dev/null
+++ b/src/Thue/Parser.hs
@@ -0,0 +1,84 @@
+module Thue.Parser (
+	ThueProgram(..),
+	ThueRule(..),
+	ThueState,
+
+	parseThue
+	) where
+
+import Control.Applicative( some )
+import Text.ParserCombinators.Parsec
+
+
+
+data ThueProgram = ThueProgram { thueRules :: [ThueRule]
+                               , thueInitialState :: ThueState }
+    deriving (Show, Eq)
+
+
+data ThueRule = ThueRule { original :: ThueState
+                         , replacement :: ThueState }
+    deriving (Show, Eq)
+
+
+type ThueState = String
+
+
+
+
+parseThue :: String -> Either ParseError ThueProgram
+parseThue = parse thue "error"
+
+
+
+
+thue = do
+	rs <- many rule
+	separatorLine
+	i <- initialState
+	eof
+	return (ThueProgram rs i)
+
+
+rule = do
+	o <- ruleState
+	separator
+	r <- state
+	eol
+	return (ThueRule o r)
+
+
+separatorLine = whiteSpace >> separator >> whiteSpace >> eol
+separator  =  string "::="
+          <?> "rule separator"
+
+
+initialState = do
+	s <- state `sepEndBy` eol
+	return (concat s)
+
+
+ruleState = some ruleStateChar
+
+
+ruleStateChar  =  noneOf "\n\r:"
+	          <|> try (char ':' >> notFollowedBy (string ":=") >> return ':')
+	          <?> "state character"
+
+
+state = many stateChar
+
+
+stateChar  =  noneOf "\n\r"
+          <?> "state character"
+
+
+whiteSpace = many (oneOf "\t ")
+
+
+eol  =  try (string "\r\n")
+    <|> try (string "\n\r")
+    <|> try (string "\r")
+    <|> try (string "\n")
+    <?> "end of line"
+	
diff --git a/src/Thue/Test.hs b/src/Thue/Test.hs
new file mode 100644
index 0000000..0273c48
--- /dev/null
+++ b/src/Thue/Test.hs
@@ -0,0 +1,52 @@
+module Thue.Test (
+	parserTests,
+	extractInfixTests,
+	tests
+    ) where
+
+
+import Test.HUnit
+import Text.Parsec.Error
+import Thue.Parser
+import Thue.Interpreter
+
+
+instance Eq Text.Parsec.Error.ParseError
+
+
+
+
+parser0 = (Right (ThueProgram [ThueRule "a" "b"] "a")) ~=? (parseThue "a::=b\n::=\na")
+
+parser1 = (Right (ThueProgram [] "b")) ~=? (parseThue "::=\nb")
+
+
+
+extractInfix0 = Nothing ~=? (extractInfix [1,2] [3,4,5])
+
+extractInfix1 = (Just ([1,2],[5,6])) ~=? (extractInfix [3,4] [1,2,3,4,5,6])
+
+extractInfix2 = (Just ([],[3,4])) ~=? (extractInfix [0,1,2] [0,1,2,3,4])
+
+extractInfix3 = (Just ([1],[])) ~=? (extractInfix [2,3] [1,2,3])
+
+extractInfix4 = (Just ([],[1])) ~=? (extractInfix [] [1])
+
+extractInfix5 = (Just ("before","after")) ~=? (extractInfix "middle" "beforemiddleafter")
+
+
+
+parserTests :: Test
+parserTests = TestList [parser0, parser1]
+
+
+
+extractInfixTests :: Test
+extractInfixTests = TestList [extractInfix0, extractInfix1, extractInfix2, extractInfix3, extractInfix4, extractInfix5]
+
+
+
+tests :: Test
+tests = case (parserTests, extractInfixTests) of
+	(TestList a, TestList b) -> TestList (a ++ b)
+
diff --git a/src/Unlambda/Builtins.hs b/src/Unlambda/Builtins.hs
new file mode 100644
index 0000000..bb054a1
--- /dev/null
+++ b/src/Unlambda/Builtins.hs
@@ -0,0 +1,70 @@
+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/src/Unlambda/Interpreter.hs b/src/Unlambda/Interpreter.hs
new file mode 100644
index 0000000..f1dcf05
--- /dev/null
+++ b/src/Unlambda/Interpreter.hs
@@ -0,0 +1,85 @@
+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/src/Unlambda/Parser.hs b/src/Unlambda/Parser.hs
new file mode 100644
index 0000000..23bf723
--- /dev/null
+++ b/src/Unlambda/Parser.hs
@@ -0,0 +1,125 @@
+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/src/Unlambda/Test.hs b/src/Unlambda/Test.hs
new file mode 100644
index 0000000..f049b59
--- /dev/null
+++ b/src/Unlambda/Test.hs
@@ -0,0 +1,103 @@
+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/src/Unlambda/Types.hs b/src/Unlambda/Types.hs
new file mode 100644
index 0000000..825a624
--- /dev/null
+++ b/src/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 _) = "<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/src/brainfuck.hs b/src/brainfuck.hs
new file mode 100644
index 0000000..5f13ae6
--- /dev/null
+++ b/src/brainfuck.hs
@@ -0,0 +1,30 @@
+
+import System.Environment( getArgs )
+import Control.Exception( ErrorCall(..), Handler(..), catches )
+import Brainfuck.Parser
+import Brainfuck.Interpreter
+
+
+
+
+usageString :: String
+usageString = "Usage: brainfuck <program file>"
+
+
+
+program :: IO ()
+program = do
+	args <- getArgs
+	fileContents <- if (length args /= 1)
+		            then error usageString
+		            else readFile (head args)
+
+	case (parseBrainfuck fileContents) of
+		Left x -> putStrLn (show x)
+		Right x -> brainfuck x >> return ()
+
+
+
+main = catches program
+               [ Handler ((\e -> putStrLn . show $ e) :: ErrorCall -> IO ()) ]
+
diff --git a/src/fractran.hs b/src/fractran.hs
new file mode 100644
index 0000000..224cb05
--- /dev/null
+++ b/src/fractran.hs
@@ -0,0 +1,30 @@
+
+import System.Environment( getArgs )
+import Control.Exception( ErrorCall(..), Handler(..), catches )
+import Fractran.Parser
+import Fractran.Interpreter
+
+
+
+
+usageString :: String
+usageString = "Usage: fractran <program file>"
+
+
+
+program :: IO ()
+program = do
+	args <- getArgs
+	fileContents <- if (length args /= 1)
+		            then error usageString
+		            else readFile (head args)
+
+	case (parseFractran fileContents) of
+		Left x -> putStrLn (show x)
+		Right x -> putStrLn (show (fractran x))
+
+
+
+main = catches program
+               [ Handler ((\e -> putStrLn . show $ e) :: ErrorCall -> IO ()) ]
+
diff --git a/src/misc.hs b/src/misc.hs
new file mode 100644
index 0000000..f7623e4
--- /dev/null
+++ b/src/misc.hs
@@ -0,0 +1,35 @@
+
+
+
+
+modulo :: Int -> Int -> Int
+modulo x y =
+    x - (x `div` y) * y
+
+
+
+primeFactors :: Int -> [Int]
+primeFactors x =
+    let p = (\x e c -> if (x == 1)
+                       then (reverse c)
+                       else if (x `modulo` (head e) == 0)
+                            then p (x `div` (head e)) e ((head e) : c)
+                            else p x (tail e) c)
+    in p x euler []
+
+
+
+euler :: [Int]
+euler =
+    let f = (\list -> (head list) : (f (filter (\x -> x `modulo` (head list) /= 0) list)))
+    in f [2..]
+
+
+
+isPowerOf :: Int -> Int -> Bool
+isPowerOf x y =
+    case (compare x y) of
+        LT -> False
+        EQ -> True
+        GT -> if (x `modulo` y == 0) then isPowerOf (x `div` y) y else False
+
diff --git a/src/test.hs b/src/test.hs
new file mode 100644
index 0000000..5fc3533
--- /dev/null
+++ b/src/test.hs
@@ -0,0 +1,29 @@
+
+import Test.HUnit
+import qualified Fractran.Test
+import qualified Thue.Test
+import qualified Unlambda.Test
+
+
+
+
+main = do
+    putStrLn "Fractran Parser"
+    runTestTT Fractran.Test.parserTests
+
+    putStrLn "\nFractran Interpreter"
+    runTestTT Fractran.Test.interpreterTests
+
+    putStrLn "\nThue Parser"
+    runTestTT Thue.Test.parserTests
+
+    putStrLn "\nextractInfix"
+    runTestTT Thue.Test.extractInfixTests
+
+    putStrLn "\nUnlambda Parser"
+    runTestTT Unlambda.Test.parserTests
+
+    putStrLn "\nUnlambda Interpreter"
+    tests <- Unlambda.Test.interpreterTests
+    runTestTT tests
+
diff --git a/src/thue.hs b/src/thue.hs
new file mode 100644
index 0000000..89afcc3
--- /dev/null
+++ b/src/thue.hs
@@ -0,0 +1,30 @@
+
+import System.Environment( getArgs )
+import Control.Exception( ErrorCall(..), Handler(..), catches )
+import Thue.Parser
+import Thue.Interpreter
+
+
+
+
+usageString :: String
+usageString = "Usage: thue <program file>"
+
+
+
+program :: IO ()
+program = do
+	args <- getArgs
+	fileContents <- if (length args /= 1)
+		            then error usageString
+		            else readFile (head args)
+
+	case (parseThue fileContents) of
+		Left x -> putStrLn (show x)
+		Right x -> (thue x) >>= (putStrLn . show)
+
+
+
+main = catches program
+               [ Handler ((\e -> putStrLn . show $ e) :: ErrorCall -> IO ()) ]
+
diff --git a/src/unlambda.hs b/src/unlambda.hs
new file mode 100644
index 0000000..b06b42f
--- /dev/null
+++ b/src/unlambda.hs
@@ -0,0 +1,30 @@
+
+import System.Environment( getArgs )
+import Control.Exception( ErrorCall(..), Handler(..), catches )
+import Unlambda.Parser
+import Unlambda.Interpreter
+
+
+
+
+usageString :: String
+usageString = "Usage: unlambda <program file>"
+
+
+
+program :: IO ()
+program = do
+    args <- getArgs
+    fileContents <- if (length args /= 1)
+                    then error usageString
+                    else readFile (head args)
+
+    case (parseUnlambda fileContents) of
+        Left x -> putStrLn (show x)
+        Right x -> unlambda x >>= putStrLn . show
+
+
+
+main = catches program
+               [ Handler ((\e -> putStrLn . show $ e) :: ErrorCall -> IO ()) ]
+