Commit 5ec4f091 authored by Dante Noguera's avatar Dante Noguera
Browse files

...

parent 87ca9df6
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
module Common where
import Prelude
import Data.Int
......@@ -10,14 +6,6 @@ import Control.Monad (liftM, ap)
import Control.Monad.Trans.Class
import Data.Word
-- Para calmar GHC--
instance Functor OperateMachine where
fmap = liftM
instance Applicative OperateMachine where
pure = return
(<*>) = ap
--------------------
-- Para calmar GHC--
instance Monad m => Functor (OperateMachineT m) where
fmap = liftM
......@@ -37,30 +25,12 @@ data Comm = While Prog
| R
deriving Show
data Machine a = Machine [a] a [a] [a] [a] deriving Show
data Machine a = Machine [a] a [a] deriving Show
data Error a = Raise String | Return a deriving Show
newtype OperateMachine a = OperateMachine { runOperateMachine :: Error a } deriving Show
instance Monad OperateMachine where
return x = OperateMachine (Return x)
m >>= f = case runOperateMachine m of
Raise e -> OperateMachine (Raise e)
Return x -> f x
pointE,readE :: OperateMachine a
pointE = OperateMachine (Raise "Pointer out of bounds")
readE = OperateMachine (Raise "Empty Stream")
sizeE :: Error a
sizeE = Raise "Invalid Size"
mkMachine :: Int -> [Word8] -> Machine Word8
mkMachine size inp = Machine [] 0 (replicate (size - 1) 0) inp []
-- Para la Maquina interactiva --
mkMachine :: Int -> Machine Word8
mkMachine size = Machine [] 0 (replicate (size - 1) 0)
newtype OperateMachineT m a = OperateMachineT { runOperateMachineT :: m (Error a) }
......@@ -74,8 +44,8 @@ instance Monad m => Monad (OperateMachineT m) where
instance MonadTrans OperateMachineT where
lift = OperateMachineT . (liftM Return)
pointEI :: Monad m => OperateMachineT m a
pointEI = OperateMachineT $ return (Raise "Pointer out of bounds")
pointE :: Monad m => OperateMachineT m a
pointE = OperateMachineT $ return (Raise "Pointer out of bounds")
sizeEI :: IO (Error a)
sizeEI = return (Raise "Invalid Size")
sizeE :: IO (Error a)
sizeE = return (Raise "Invalid Size")
......@@ -3,55 +3,26 @@ import Common
import Data.Word
import Control.Monad.Trans.Class
evalComm :: Comm -> Machine Word8 -> OperateMachine (Machine Word8)
evalComm (While p) m@(Machine _ c _ _ _) = if c == 0 then return m else evalProg' (p ++ [While p]) m
evalComm DecP (Machine [] _ _ _ _) = pointE
evalComm DecP (Machine (l : ls) c rs is os) = return (Machine ls l (c : rs) is os)
evalComm IncP (Machine _ _ [] _ _) = pointE
evalComm IncP (Machine ls c (r : rs) is os) = return (Machine (c : ls) r rs is os)
evalComm IncB (Machine ls c rs is os) = return (Machine ls (c + 1) rs is os)
evalComm DecB (Machine ls c rs is os) = return (Machine ls (c - 1) rs is os)
evalComm W (Machine ls c rs is os) = return (Machine ls c rs is (c : os))
evalComm R (Machine _ _ _ [] _) = readE
evalComm R (Machine ls c rs (i : is) os) = return (Machine ls i rs is os)
evalProg :: Prog -> Int -> [Word8] -> Error (Machine Word8)
evalProg p size inp = if size <= 0 then sizeE
else runOperateMachine (evalProg' p (mkMachine size inp))
evalProg' :: Prog -> Machine Word8 -> OperateMachine (Machine Word8)
evalComm :: Comm -> Machine Word8 -> OperateMachineT IO (Machine Word8)
evalComm (While p) m@(Machine _ c _) = if c == 0 then return m else evalProg' (p ++ [While p]) m
evalComm DecP (Machine [] _ _) = pointE
evalComm DecP (Machine (l : ls) c rs) = return (Machine ls l (c : rs))
evalComm IncP (Machine _ _ []) = pointE
evalComm IncP (Machine ls c (r : rs)) = return (Machine (c : ls) r rs)
evalComm IncB (Machine ls c rs) = return (Machine ls (c + 1) rs)
evalComm DecB (Machine ls c rs) = return (Machine ls (c - 1) rs)
evalComm W (Machine ls c rs) = do lift (putStrLn (show c))
return (Machine ls c rs)
evalComm R (Machine ls c rs) = do w <- lift getLine
return (Machine ls (read w) rs)
evalProg' :: Prog -> Machine Word8 -> OperateMachineT IO (Machine Word8)
evalProg' p m = case p of
[] -> return m
(op : ops) -> do
m' <- evalComm op m
evalProg' ops m'
-- Maquina Interactiva --
evalCommI :: Comm -> Machine Word8 -> OperateMachineT IO (Machine Word8)
evalCommI (While p) m@(Machine _ c _ _ _) = if c == 0 then return m else evalProgI' (p ++ [While p]) m
evalCommI DecP (Machine [] _ _ _ _) = pointEI
evalCommI DecP (Machine (l : ls) c rs _ _) = return (Machine ls l (c : rs) [] [])
evalCommI IncP (Machine _ _ [] _ _) = pointEI
evalCommI IncP (Machine ls c (r : rs) _ _) = return (Machine (c : ls) r rs [] [])
evalCommI IncB (Machine ls c rs _ _) = return (Machine ls (c + 1) rs [] [])
evalCommI DecB (Machine ls c rs _ _) = return (Machine ls (c - 1) rs [] [])
evalCommI W (Machine ls c rs _ _) = do lift (putStrLn (show c))
return (Machine ls c rs [] [])
evalCommI R (Machine ls c rs _ _) = do w <- lift getLine
return (Machine ls (read w) rs [] [])
evalProgI' :: Prog -> Machine Word8 -> OperateMachineT IO (Machine Word8)
evalProgI' p m = case p of
[] -> return m
(op : ops) -> do
m' <- evalCommI op m
evalProgI' ops m'
m' <- evalComm op m
evalProg' ops m'
evalProgI :: Prog -> Int -> IO (Error (Machine Word8))
evalProgI p size = if size <= 0 then sizeEI
else runOperateMachineT (evalProgI' p (mkMachine size []))
evalProg :: Prog -> Int -> IO (Error (Machine Word8))
evalProg p size = if size <= 0 then sizeE
else runOperateMachineT (evalProg' p (mkMachine size))
......@@ -5,10 +5,12 @@ import System.Console.Readline
import Data.List
import Data.Char
import System.IO hiding (print)
import System.Environment
import Common
--import PrettyPrinter
import Eval
import Parse
size = 10
data Command = Compile CompileForm
| Print String
......@@ -48,8 +50,8 @@ readEvalPrintLoop = do
resp <- handleCommand cmd
case resp of
Quit -> return ()
_ -> putStrLn $ show cmd
readEvalPrintLoop
_ -> do putStrLn $ show cmd
readEvalPrintLoop
interpretCommand :: String -> IO Command
interpretCommand str =
......@@ -81,8 +83,13 @@ handleCommand cmd =
compilePhrase :: String -> IO ()
compilePhrase s = do
p <- parseIO "<interactive>" parseProg s
evalProg p
maybep <- parseIO "<interactive>" parserProg s
case maybep of
Nothing -> return ()
Just p -> do r <- evalProg p size
case r of
Raise str -> putStrLn str
Return m -> putStrLn $ show m
......@@ -91,3 +98,9 @@ helpTxt cs =
unlines (map (\ (Cmd c a _ d) ->
let ct = concat (intersperse ", " (map (++ if null a then "" else " " ++ a) c))
in ct ++ replicate ((24 - length ct) `max` 2) ' ' ++ d) cs)
parseIO :: String -> (String -> ParseResult a) -> String -> IO (Maybe a)
parseIO f p x = case p x of
Failed e -> do putStrLn (f++": "++e)
return Nothing
Ok r -> return (Just r)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment