
I wrote such an interpreter though the code is quite ugly due to my lack of experience in the field as well as with Haskell... It took me the better part of two hour but mainly because I didn't use Parsec before this. I would of course be happy of any suggestion to amend it but a plain rewriting might be best... (even by me ;-) ) There are probably some bugs (in part due to the fuzzy definition of the language semantics and real syntax). Here is the beast : module Minim (the real work is done here) ############################################## module Minim (Statement (..), Test (..), Program (..), Expr (..), eval) where import qualified Data.Map as M import Data.Char data Statement = Assign String Expr | Inc String | Dec String | Cond Test Statement Statement | Goto String | Print Expr | Nl | Input String deriving (Show) data Test = Le Expr Expr | Ge Expr Expr | Eq Expr Expr | And Test Test | Or Test Test | Not Test deriving (Show) data Expr = Str String | Number Int | EVar String deriving (Eq, Ord) instance Show Expr where show (Str s) = s show (Number i) = show i show (EVar s) = "Variable : " ++ s newtype Program = Program ([Statement],[(String,[Statement])]) deriving (Show) eval :: Program -> IO () eval (Program (xs, tags)) = evalS xs tags M.empty evalS :: [Statement] -> [(String, [Statement])] -> M.Map String Expr -> IO () evalS (s0:ss) tags context = s0 `seq` case s0 of Assign str expr -> evalS ss tags $ M.insert str (evalE expr context) context Inc str -> evalS ss tags $ M.adjust inc_expr str context where inc_expr (Number i) = Number $ i + 1 inc_expr _ = error $ "You can't increment " ++ str ++ ", it isn't numeric.\n" Dec str -> evalS ss tags $ M.adjust dec_expr str context where dec_expr (Number i) = Number $ i - 1 dec_expr _ = error $ "You can't increment " ++ str ++ ", it isn't numeric.\n" Cond test s1 s2 -> if evalT test context then evalS (s1:ss) tags context else evalS (s2:ss) tags context Goto str -> maybe (error $ "No such tag : " ++ str) (\nss -> evalS nss tags context) $ lookup str tags Print expr -> do putStr (show $ evalE expr context) evalS ss tags context Nl -> do putStrLn "" evalS ss tags context Input str -> do input <- getLine let expr = if (not $ null input) && all isDigit input then Number $ read input else Str input evalS ss tags $ M.insert str expr context evalS [] _ _ = return () evalE :: Expr -> M.Map String Expr -> Expr evalE (EVar str) context = maybe (error $ "There's no such variable : " ++ str) id $ M.lookup str context evalE e _ = e evalT :: Test -> M.Map String Expr -> Bool evalT t context = case t of Eq e1 e2 -> evalE e1 context == evalE e2 context Le e1 e2 -> evalE e1 context < evalE e2 context Ge e1 e2 -> evalE e1 context > evalE e2 context And t1 t2 -> evalT t1 context && evalT t2 context Or t1 t2 -> evalT t1 context || evalT t2 context Not t1 -> not $ evalT t1 context ############################################## module MinimParser ############################################## module MinimParser (parseFile) where import Minim import Text.ParserCombinators.Parsec hiding (spaces, parseTest) import Text.ParserCombinators.Parsec.Expr import Text.ParserCombinators.Parsec.Token hiding (symbol) import Control.Monad spaces :: Parser () spaces = skipMany1 $ char ' ' symbol :: Parser String symbol = many1 letter litVar :: Parser Expr litVar = liftM EVar symbol litString :: Parser Expr litString = do char '"' s <- many (noneOf "\"") char '"' return $ Str s litNumber :: Parser Expr litNumber = return . Number . read =<< many digit parseExpr :: Parser Expr parseExpr = litVar <|> litString <|> litNumber opTable = [ [Infix (string "and" >> return And) AssocNone, Infix (string "or" >> return Or) AssocNone], [Prefix (string "not" >> return Not)] ] parseTest :: Parser Test parseTest = buildExpressionParser opTable simpleTest simpleTest :: Parser Test simpleTest = (do char '(' spaces test <- parseTest spaces char ')' return test ) <|> do e1 <- parseExpr spaces op <- oneOf "=<>" spaces e2 <- parseExpr return $ case op of '=' -> Eq e1 e2 '<' -> Le e1 e2 '>' -> Ge e1 e2 printS :: Parser Statement printS = do string "print" spaces expr <- parseExpr return $ Print expr inputS :: Parser Statement inputS = do string "input" spaces var <- symbol return $ Input var assignS :: Parser Statement assignS = do var <- symbol spaces string "is" spaces expr <- parseExpr return $ Assign var expr gotoS :: Parser Statement gotoS = liftM Goto $ string "goto" >> spaces >> symbol incS :: Parser Statement incS = liftM Inc $ string "++" >> spaces >> symbol decS :: Parser Statement decS = liftM Dec $ string "--" >> spaces >> symbol condS :: Parser Statement condS = do string "if" spaces test <- parseTest spaces string "then" spaces s1 <- parseStatement spaces string "else" spaces s2 <- parseStatement return $ Cond test s1 s2 parseStatement :: Parser Statement parseStatement = incS <|> decS <|> printS <|> try condS <|> inputS <|> gotoS <|> (string "nl" >> return Nl) <|> assignS parseProgram :: Parser Program parseProgram = try (do stat <- parseStatement newline program <- parseProgram case program of Program (stats, tags) -> return $ Program (stat:stats, tags) ) <|> (do tag <- symbol newline program <- parseProgram case program of Program (stats, tags) -> return $ Program (stats, (tag,stats):tags) ) <|> (eof >> ( return $ Program ([], []) )) parseFile :: String -> IO Program parseFile fileName = do input <- readFile fileName case (parse parseProgram fileName input) of Left err -> error $ show err Right p -> return p ############################################## main module (nothing there of course) ############################################## module Main where import MinimParser import Minim (eval) import System import System.IO main :: IO () main = do hSetBuffering stdout NoBuffering arg <- getArgs program <- parseFile $ arg!!0 eval program ############################################## -- Jedaï