Re: [Haskell-cafe] Minim interpreter
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
Re: [Haskell-cafe] Minim interpreter
There was more than some bugs, and a lack of strictness that led to
a stack overflow for high values of x... So here is a better version
(not quite there still, but better).
--
Jedaï
{-# OPTIONS -fbang-patterns -funbox-strict-fields #-}
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
| 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 =
case s0 of
Assign str expr - evalS ss tags
$ M.insert str (evalE expr context) context
Inc str - evalS ss tags $ M.insertWith' inc_expr str undefined 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.insertWith' dec_expr str undefined 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
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 (parseFile) where
import Minim
import Text.ParserCombinators.Parsec hiding (spaces, parseTest, token)
import Text.ParserCombinators.Parsec.Expr
import Text.ParserCombinators.Parsec.Token hiding (symbol)
import Control.Monad
sp :: Parser ()
sp = skipMany $ char ' '
spaces :: Parser ()
spaces = skipMany1 $ char ' '
token :: Parser a - Parser ()
token p = spaces p spaces
symbol :: Parser String
symbol = many1 letter
litVar :: Parser Expr
litVar = liftM EVar symbol
litString :: Parser Expr
litString = liftM Str $ between (char '') (char '') $ many (noneOf \)
litNumber :: Parser Expr
litNumber = return . Number . read = many digit
parseExpr :: Parser Expr
parseExpr = litVar | litString | litNumber
opTable = [ [infixOp and And AssocNone, infixOp or Or AssocNone],
[Prefix (string not spaces return Not)] ]
infixOp name op assoc =
Infix (try $ token (string name) return op) assoc
parseTest :: Parser Test
parseTest = buildExpressionParser opTable simpleTest
simpleTest :: Parser Test
simpleTest =
between (char '(' sp) (sp char ')') parseTest |
do e1 - parseExpr
op - between sp sp $ oneOf =
e2 - parseExpr
return $ case op of
'=' - Eq e1 e2
'' - Le e1 e2
'' - Le e2 e1
printS :: Parser Statement
printS = liftM Print $ string print spaces parseExpr
inputS :: Parser Statement
inputS = liftM Input $ string input spaces symbol
assignS :: Parser Statement
assignS = do
var - symbol
token $ string is
expr - parseExpr
return $ Assign var expr
gotoS :: Parser Statement
gotoS = liftM Goto $ string goto spaces symbol
incS :: Parser Statement
incS = liftM Inc $ string ++ sp symbol
decS :: Parser Statement
decS = liftM Dec $
Re: [Haskell-cafe] Minim interpreter
On Saturday 21 July 2007 01:41:58 Hugh Perkins wrote: Ok, that got the variables working. ... Don't fizzle out on me now: this was just getting interesting! :-) -- Dr Jon D Harrop, Flying Frog Consultancy Ltd. OCaml for Scientists http://www.ffconsultancy.com/products/ocaml_for_scientists/?e ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Minim interpreter
heh! well everyone was busy working on icfp or something, so the newsgroup was pretty dead :-) And I played with opengl a little, which gave better results than I thought, but not good enough to pursue, and the whole program was in imperative dos anyway, so I couldnt quite see what was the point of moving to a non-imperative language! End of rant... It looks like there's a huge amount of documentation on the parsing process, but it's kindof more fun to just figure it out ourselves, I think? Anyway, for handling loops, what I'm thinking is maybe the Map that holds variables, rather than holding a Double type should hold a variant type, something like: data Variant = VDouble Double | VString String | ... etc... then, to handle loops, which basically involves creating a pointer variable, we simply add a variant type that holds a program: data Variant = ... | VProgram Program ... and then we can just assign to the Variant type in the map corresponding to the symbol the rest of the program that follows that symbol. Note that we have to reverse the Program data type to get this to work effectively: data Program = ProgramLeaf Statement | ProgramTree Statement Program deriving(Show) ... errr... I think... because that way we can grab any part of the program tree and store that as a Variant in the map. How does that sound? That ought to get looping working? Then we just have to handle conditionals, which I havent thought at all about yet. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Minim interpreter
Newbie question: why does the following give Not in scope 'c' for the last line? string :: Parsec.Parser String string = do c - Parsec.letter do cs - string return c:cs Parsec.| return [c] (This is copied more or less rote from http://legacy.cs.uu.nl/daan/download/parsec/parsec.html , so I'm guessing there's some sort of command-line option I'm missing?) ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Minim interpreter
On Fri, Jul 20, 2007 at 10:10:58PM +0200, Hugh Perkins wrote:
Newbie question: why does the following give Not in scope 'c' for the last
line?
I assume you meant
string :: Parsec.Parser String
string = do c - Parsec.letter
do cs - string
return c:cs
Parsec.| return [c]
Without adding that indentation, the second do cuts of the first block
and you get a rather different error.
The problem here is that the line beginning Parsec.| is lined up
with the first token after do, so layout adds a semicolon in front
of it, but a statement can't begin with an operator, so to avoid that
parse error the layout rules add the close brace and end the do block.
It parses like this:
string = ( do { c - Parsec.letter
; cs - string
; return c:cs
} )
Parsec.| (return [c]
The parse error rule is there so a do block will be closed by the end of
surrounding parens or braces, maybe it has other uses.
In any case, you really ought to use many1.
string = Parsec.many1 Parsec.letter
Brandon
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Minim interpreter
Kindof vaguely made a start on this, but cant quite see how to handle variables. I guess variables can be stored as a (Map.Map String Double), at least for a first draft? Then, I'm building up two hierarchies in parallel: - a set of parsec functions to parse the incoming string into a Program hierarchy - a set of data types to represent a program Then, there's a class called Eval containing a function eval which is instanced for each bit of the program hierarchy, so we simply call eval on the top level, and the program is executed. That works just fine as long as the only thing eval has to cope with is print statements (so eval has type IO ()), but I'm guessing the clean solution is to thread a Map.Map through that somehow? Solution so far: -- parsing hierarchy (pretty basic, but this bit doesnt seem particularly scary) string :: Parsec.Parser String string = Parsec.many1 Parsec.letter minimprint = do Parsec.string print Parsec.many1 (Parsec.char ' ') Parsec.char '' stringvalue - string Parsec.char '' return (Print stringvalue) -- program data type hierarchy data Program = ProgramLeaf Statement | ProgramTree Program Statement deriving(Show) data Statement = PrintStatement Print | AssignmentStatement Assignment deriving(Show) data Print = Print String deriving(Show) data Assignment = VarAssignment Variable Value | Increment Variable | Decrement Variable deriving(Show) data Variable = Variable String deriving(Show) data Value = ValueFromConstant Constant | ValueFromVariable Variable deriving(Show) newtype Constant = Constant Int deriving(Show) -- eval instances class Eval a where eval :: a - IO() instance Eval Program where eval (ProgramLeaf statement) = eval statement eval (ProgramTree program statement) = do eval program eval statement instance Eval Statement where eval ( PrintStatement print) = eval print eval ( AssignmentStatement assignment) = return () instance Eval Print where eval (Print value) = putStrLn value -- some code to test this minimparse minimsentence = case (Parsec.runParser minimprint () minimsentence) of (Right statement) - eval statement Left error - putStrLn(error: ++ show(error)) test = minimparse print \hello\ Running test correctly gives an output of hello, which is a good start. ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Minim interpreter
Hugh Perkins wrote: That works just fine as long as the only thing eval has to cope with is print statements (so eval has type IO ()), but I'm guessing the clean solution is to thread a Map.Map through that somehow? You could do that but your code starts to become messy and you'll hit other limitations. The standard approach to this problem is to use a State monad. Since you are already using one monad, IO, you can can stack the monads using Monad transformers which makes them both available (although you will need to use liftIO, see below) import Control.Monad import Control.Monad.State import Data.Map type Env = Map String String type InterpM = StateT Env IO eval :: a - InterpM t instance Eval Print where eval (Print value) = liftIO $ putStrLn value You access and store the state using get and put. For example: eval (Variable s) = do s - get lookup the value and return it. There is a paper on using Monads with interpreters (http://web.cecs.pdx.edu/~mpj/pubs/modinterp.html) and an example described at http://www.haskell.org/haskellwiki/Libraries_and_tools/HJS. Mark ___ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
Re: [Haskell-cafe] Minim interpreter
Ok, that got the variables working.
Example:
*Minim evaluateprog $ ProgramTree ( ProgramLeaf $ AssignmentStatement(
VarAssignment (Variable test) ( ValueFromConstant (Constant 3 (
PrintStatement (PrintValue( ValueFromVariable(Variable test
3.0
3.0
I'm having eval return the IO monad, the Map, and a Double. That means we
can use the same Eval class to evaluate for example the value of a Value.
Next step is either to get the parsing working for the functional eval
parts, or to get looping working.
Yes, I'm aware that this is Haskell 101 :-D
module Minim
where
import Char
import List
import Control.Monad
import Control.Monad.State
import Control.Monad.Reader
import qualified Text.ParserCombinators.Parsec as Parsec
import qualified Data.Map as Map
{-
program := statement
| statement program;
statement := assignment
| conditional
| goto
| tag;
| print
| input
assignment := (var is val) { assign a value to a variable }
| (++ var) { increment a variable }
| (-- var);{ decrement a variable }
val := constant | var;
var := any symbol;
constant := any number
conditional := (if test then statement else statement);
test := (val comp val)
| (test and test); { boolean AND}
| (test or test) {boolean OR}
| (not test);{boolean NOT}
comp := | | =;
goto := (goto tag); {go to}
tag := any symbol
print := (print string) | (print val); nl; {nl is new line}
input := (input var); {input the users response to
var}
string := any string;
-}
testtry = Parsec.try (Parsec.string hello)
Parsec.| Parsec.string help
string :: Parsec.Parser String
string = Parsec.many1 Parsec.letter
minimprint = do Parsec.string print
Parsec.many1 (Parsec.char ' ')
Parsec.char ''
stringvalue - string
Parsec.char ''
return (Print stringvalue)
parens :: Parsec.Parser ()
parens = do Parsec.char '('
parens
Parsec.char ')'
parens
Parsec.| return ()
class Eval a where
eval :: a - StateT (Map.Map String Double) IO Double
data Program = ProgramLeaf Statement | ProgramTree Program Statement
deriving(Show)
instance Eval Program where
eval (ProgramLeaf statement) = eval statement
eval (ProgramTree program statement) = do eval program
eval statement
data Statement = PrintStatement Print |
AssignmentStatement Assignment
deriving(Show)
instance Eval Statement where
eval ( PrintStatement print) = eval print
eval ( AssignmentStatement assignment) = eval assignment
data Print = Print String | PrintValue Value
deriving(Show)
instance Eval Print where
eval (Print value) = do liftIO $ putStrLn value
return 0
eval (PrintValue value) = do evaluatedvalue - eval value
liftIO $ putStrLn (show(evaluatedvalue))
return evaluatedvalue
data Assignment = VarAssignment Variable Value |
Increment Variable |
Decrement Variable
deriving(Show)
instance Eval Assignment where
eval (VarAssignment (Variable varname) (ValueFromConstant (Constant
constant))) = do oldmap - get
let newmap = Map.insert varname constant oldmap
put newmap
return constant
data Variable = Variable String
deriving(Show)
data Value = ValueFromConstant Constant | ValueFromVariable Variable
deriving(Show)
instance Eval Value where
eval (ValueFromConstant (Constant i )) = return i
eval (ValueFromVariable (Variable varname )) = do map - get
return (map Map.!
varname)
newtype Constant = Constant Double
deriving(Show)
instance Eval Constant where
eval (Constant i) = return i
evaluateprog prog = evalStateT( eval prog ) Map.empty
minimparse minimsentence = case (Parsec.runParser minimprint ()
minimsentence) of
(Right statement) - evaluateprog statement
Left error - do putStrLn(error: ++
show(error))
return 0
test = minimparse print \hello\
___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
