A parser and interpreter for a very small language by Mark Seemann
A single Haskell script file.
I recently took the final exam in a course on programming language design. One of the questions was about a tiny language, and since this was a take-home exam running over many days, I had time to spare. Although it wasn't part of any questions, I decided to write an interpreter to back up some claims I made in my answers.
This article documents my prototype parser and interpreter.
Language description #
To be clear, the exam question was not to implement an interpreter, but rather some questions about attributes of the language. The description here is reprinted with kind permission from Torben Ægidius Mogensen.
Consider a functional language where values can be Booleans and pairs. A syntax for the language is given below:
Program → Function+ Function → Fid Pattern+ = Exp Pattern → Vid | true|false| (Pattern, Pattern)Exp → Vid | true|false| Fid Exp+ | (Exp)where Fid denotes function identifiers (which are lower case) and Vid denotes variable identifiers (which are upper case). There can be multiple rules for each functions, but rules must have disjoint patterns. All function calls must be fully applied (no partial applications, so no higher-order functions). A program is executed by calling any function with any argument constructed by pairs and Booleans. An example program is
and true X = X and false X = false alltrue true = true alltrue false = false alltrue (X, Y) = and (alltrue X) (alltrue Y)Calling
alltrue (true, (false, true))will returnfalse, butalltrue ((true, true), (true, true))will returntrue.
The exam goes on to ask some questions about termination as a property of the language, and whether or not it's Turing complete, but that's not the scope of this article. Rather, I'd like to describe a prototype parser and interpreter I wrote as a single throwaway script file in Haskell.
Declarations and imports #
The code is a single Haskell module that I interacted with via GHCi (the GHC REPL). It starts with a single pragma, a module declaration, and imports.
{-# LANGUAGE FlexibleContexts #-}
module Bopa where
import Control.Monad.Identity (Identity)
import Data.Bifunctor (first)
import Data.Foldable (find)
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import Data.Set (Set)
import qualified Data.Set as Set
import Text.Parsec
The parsec API requires the FlexibleContexts language pragma. The name, Bopa I simply derived from Bools and Pairs, although I'm aware that this little combination of letters has quite an alternative connotation for many Danes, including myself.
Apart from the base library, the packages parsec and containers are required. I didn't use an explicit build system, but if they're not already present on your system, you can ask GHCi to load them.
AST #
The above language description is a context-free grammar, which translates easily into Haskell type declarations.
type Program = NonEmpty Function data Function = Function { fid :: String, fpats :: NonEmpty Pattern, fbody :: Exp } deriving (Eq, Show) data Pattern = VarPat String | TPat | FPat | PairPat Pattern Pattern deriving (Eq, Show) data Exp = VarExp String | TExp | FExp | CallExp String (NonEmpty Exp) deriving (Eq, Show)
The description doesn't explicitly state how to interpret the superscript +, but I've interpreted it as meaning one or more. Therefore, a Program is a NonEmpty list of Function values. The same line of reasoning applies for the other places where the + sign appears.
Notice that there's more than one representation of Boolean values; TPat is the true pattern, while TExp is the true expression, and likewise for false.
These types describe the entire language, and you can, in principle, create programs directly using this API. While I didn't do that (because I wrote a parser instead), here's what the above and function looks like as an abstract syntax tree (AST):
Function "and" (TPat :| [VarPat "X"]) (VarExp "X") :| [Function "and" (FPat :| [VarPat "X"]) FExp]
Recall that the :| operator is the NonEmpty data constructor.
Source code parsers #
I wanted to be able to write programs directly in the Bopa language, and not just as ASTs, so the next step was writing parsers for each of the data types defined above. As strongly implied by the above imports, I used the parsec package for that.
The Program type is only an alias, and once I have a parser for Function, that one should be straightforward. The parser of Function values is, however, more involved.
functionParser :: Stream s m Char => ParsecT s () m Function functionParser = do fnid <- many1 lower let pp = many1 (char ' ') >> patternParser -- Next line based on https://stackoverflow.com/a/65570028/126014 patterns <- (:|) <$> pp <*> pp `manyTill` try (many1 (char ' ') >> char '=') skipMany1 (char ' ') Function fnid patterns <$> expParser
I readily admit that I don't have much experience with parsec, so it's possible that this could be done more elegantly. As the comment indicates, I struggled somewhat with a detail or two. I had trouble making it consume patterns until it meets the '=' character.
The functionParser depends on another parser named pairPatParser, which again is composed from smaller parsers that handle each case of the Pattern sum type.
varPatParser :: Stream s m Char => ParsecT s () m Pattern varPatParser = VarPat <$> many1 upper tPatParser :: Stream s m Char => ParsecT s () m Pattern tPatParser = string "true" >> return TPat fPatParser :: Stream s m Char => ParsecT s () m Pattern fPatParser = string "false" >> return FPat pairPatParser :: Stream s m Char => ParsecT s () m Pattern pairPatParser = do _ <- char '(' p1 <- patternParser _ <- char ',' _ <- skipMany $ char ' ' p2 <- patternParser _ <- char ')' return $ PairPat p1 p2 patternParser :: Stream s m Char => ParsecT s () m Pattern patternParser = try varPatParser <|> try tPatParser <|> try fPatParser <|> try pairPatParser
You might argue that the first three are so simple that they may not really qualify for the status of top-level values, but being a parsec newbie, I found that it helped me to structure the code that way. The only one of those values more complicated than a one-liner is, obviously, pairPatParser. I later discovered between and sepBy1, so it's possible I could also have defined pairPatParser as a composition of such combinators. I didn't, however, try, since this is, after all, throwaway prototype code, and what's there already works as intended.
As an aside, I would usually keenly attempt such refactorings, but I was working without automated tests. Yes, shocking, I know, but setting up unit tests for Haskell is, unfortunately, a bit of a hassle, and given the nature of the work, I considered doing without tests a reasonable trade-off.
This takes care of parsing Pattern values, but notice that functionParser also depends on expParser, which, not surprisingly, parses Exp values. Like patternParser it does that by defining a helper parser for each sum type case, and then combining them into one larger parser.
varExpParser :: Stream s m Char => ParsecT s () m Exp varExpParser = VarExp <$> many1 upper tExpParser :: Stream s m Char => ParsecT s () m Exp tExpParser = string "true" >> return TExp fExpParser :: Stream s m Char => ParsecT s () m Exp fExpParser = string "false" >> return FExp callExpParser :: Stream s m Char => ParsecT s () m Exp callExpParser = do fnid <- many1 lower skipMany1 (char ' ') exps <- NE.fromList <$> expParser `sepBy1` many1 (char ' ') return $ CallExp fnid exps expParser :: Stream s m Char => ParsecT s () m Exp expParser = try varExpParser <|> try tExpParser <|> try fExpParser <|> try callExpParser <|> between (char '(') (char ')') expParser
Even though I generally favoured implementing each sum type case in a separate, named parser, I inlined parsing of the parenthesized expression; partly because it's so simple, and partly because I didn't know what to call it.
You can see that at this point, I'd discovered the between and sepBy1 combinators.
Finally, it's possible to compose all these smaller parsers together to a parser of Bopa programs.
programParser :: Stream s m Char => ParsecT s () m (NonEmpty Function) programParser = NE.fromList <$> functionParser `sepEndBy1` many1 endOfLine
This, however, is parser. How do you run it?
Here's a way:
parseProgram :: Stream s Identity Char => s -> Either ParseError (NonEmpty Function) parseProgram = parse programParser ""
You may, for example, try to parse the above and function:
ghci> parseProgram "and true X = X\nand false X = false"
Right (Function {fid = "and", fpats = TPat :| [VarPat "X"], fbody = VarExp "X"} :|
[Function {fid = "and", fpats = FPat :| [VarPat "X"], fbody = FExp}])
(Output manually formatted to improve readability.)
In practice, however, I didn't much do that. Instead, I created source code files and loaded them with the basic file-reading APIs included in the base package. You'll see examples of this later.
Arguments #
As described, running a program requires construction of a Boolean value, or pairs of Boolean values, something the language itself does not allow. That's the reason I haven't yet modelled it.
data Arg = TArg | FArg | PairArg Arg Arg deriving (Eq, Ord, Show)
Notice that true and false gets yet another representation as either TArg or FArg.
If I want to be able to run programs by typing alltrue (true, (false, true)), instead of painstakingly creating ASTs, I need a parser for this data type as well. That's not going to be a source code parser, but rather part of a command-line parser.
tArgParser :: Stream s m Char => ParsecT s () m Arg tArgParser = string "true" >> return TArg fArgParser :: Stream s m Char => ParsecT s () m Arg fArgParser = string "false" >> return FArg pairArgParser :: Stream s m Char => ParsecT s () m Arg pairArgParser = do _ <- char '(' p1 <- argParser _ <- char ',' _ <- skipMany $ char ' ' p2 <- argParser _ <- char ')' return $ PairArg p1 p2 argParser :: Stream s m Char => ParsecT s () m Arg argParser = tArgParser <|> fArgParser <|> pairArgParser
To be honest, I think that I just copied and pasted pairPatParser and changed a few things. It looks that way, doesn't it?
Entry points #
In order to execute a program, you need more than arguments. You need to define which function to call. I decided that this was close enough to defining a program entry point that it gave name to the next type.
data Entry = Entry String (NonEmpty Arg) deriving (Eq, Show)
The String value identifies the desired function by name, and the NonEmpty list supplies the arguments.
Since I wish to be able to run a program by writing e.g. alltrue ((true, true), (true, true)), I need a parser for that, too.
entryParser :: Stream s m Char => ParsecT s () m Entry entryParser = do fnid <- many1 lower skipMany1 (char ' ') args <- NE.fromList <$> argParser `sepBy1` many1 (char ' ') return $ Entry fnid args
This, again, is a parser; it's convenient to also define a function to run it against input.
parseEntry :: Stream s Identity Char => s -> Either ParseError Entry parseEntry = parse entryParser ""
Let's see if it works:
ghci> parseEntry "alltrue ((true, true), (true, true))" Right (Entry "alltrue" (PairArg (PairArg TArg TArg) (PairArg TArg TArg) :| []))
That seems promising.
Parameter binding #
Armed with the ability to parse programs as well as entry points, 'all' that remains is to execute the program. To that end, I wrote an interpreter. It works with a few helper functions, the first of which attempts to bind patterns to arguments.
For example, if we have a variable-name pattern such as X and an argument such as (true, false), we can bind X to that value. Some examples will help, but I'll show the function first, and then talk you through it.
-- Attempt pattern matching and, if possible, bind variables to arguments. -- Returns an association list of bound variables (an 'environment'), if any. -- Returns Left with an error message if no match. tryBind :: NonEmpty Pattern -> NonEmpty Arg -> Either String [(String, Arg)] tryBind (VarPat p :| []) (arg :| []) = Right [(p, arg)] tryBind (TPat :| []) (TArg :| []) = Right [] tryBind (FPat :| []) (FArg :| []) = Right [] tryBind (PairPat p1 p2 :| []) ((PairArg a1 a2) :| []) = let b1 = tryBind (NE.singleton p1) (NE.singleton a1) b2 = tryBind (NE.singleton p2) (NE.singleton a2) in (++) <$> b1 <*> b2 tryBind (pat :| (p:ps)) (arg :| (a:as)) = let b = tryBind (NE.singleton pat) (NE.singleton arg) bs = tryBind (p :| ps) (a :| as) in (++) <$> b <*> bs tryBind _ args = Left ("Could not match " ++ show args ++ ".")
Notice the type declaration: The function takes a NonEmpty list of Pattern values, and another NonEmpty list of Arg values. The first precondition in order to achieve a successful result is that these two lists need to have the same length. If we have more arguments than patterns, we run out of patterns. If we have more patterns than arguments, we can't bind all the parameters in the patterns, and partial application is not allowed.
The first four rules of the tryBind function attempt to match a single Pattern value to a single Arg value; notice the use of the :| NonEmpty data constructor: In all four cases, the tail of the NonEmpty lists only matches the empty list [].
The first rule, for example, has a single variable pattern, where p is the variable name, and a single argument arg, so that pattern matching succeeds and the variable name is bound to the argument. Here's an example:
ghci> tryBind (VarPat "X" :| []) (PairArg TArg FArg :| [])
Right [("X",PairArg TArg FArg)]
The result is a variable environment in which the variable name X is bound to the value PairArg TArg FArg (that is, (true, false)).
Sometimes, when matching literals, no variables are bound, in which case the environment is empty:
ghci> tryBind (TPat :| []) (TArg :| []) Right []
While the environment itself is empty, the result is still a Right case, indicating that the pattern matched the argument. This, of course, need not be the case:
ghci> tryBind (TPat :| []) (FArg :| []) Left "Could not match FArg :| []."
The rule that attempts to match a pair with a pair argument recursively calls tryBind for the left and the right element, and then uses the Applicative nature of Either to compose those two results.
ghci> tryBind (PairPat TPat (VarPat "Y") :| []) (PairArg TArg FArg :| [])
Right [("Y",FArg)]
In this example, you see how a pair pattern composed of (true, Y) matches the argument (true, false), resulting in the variable environment where Y is bound to false.
The final Right-valued match is when there's more than a single pattern, and more than a single argument. In that case, the function recursively calls itself with the heads of each NonEmpty list, as well as the tails of each NonEmpty list.
ghci> tryBind (PairPat TPat (VarPat "Y") :| [VarPat "Z"]) (PairArg TArg FArg :| [PairArg FArg TArg])
Right [("Y",FArg),("Z",PairArg FArg TArg)]
In this example, we try to bind the variables in the patterns (true, Y) Z with the arguments (true, false) (false, true), producing the variable environment where Y is bound to false, and Z is bound to (false, true).
This exhausts all the legal bindings, so the final, wildcard pattern in tryBind returns a Left value indicating the failure. You've already seen an example of that, above.
That function is a bit of a mouthful, but fortunately, we've now covered a major part of the interpreter.
Pattern matching #
The tryBind function attempts to bind a single list of patterns to a list of arguments. A function may, however, list several (non-overlapping) rules, so if the first pattern list doesn't match, the interpreter must try the second, the third, and so on, until there are no more patterns to try. While tryBind does the heavy lifting, another function goes through the list of rules.
-- Goes through one or more function rules, looking for a match. -- All the functions in the function list are assumed to have the same name, so -- that they are all rules of the same function. -- This precondition is not checked here, but handled by the caller. This isn't -- the best implementation decision, but this is, after all, a prototype. tryMatch :: NonEmpty Function -> NonEmpty Arg -> Either [Char] ([(String, Arg)], Exp) tryMatch (Function _ pats body :| []) args = (, body) <$> tryBind pats args tryMatch (Function _ pats body :| (f : fs)) args = case tryBind pats args of Right b -> Right (b, body) Left _ -> tryMatch (f :| fs) args
There are two (Haskell) rules for tryMatch: One where there's only one Function rule, and one where there's more than one.
In the first case, tryMatch delegates to tryBind, but if the binding attempt succeeds, also returns the body.
ghci> tryMatch (Function "and" (FPat :| [VarPat "X"]) FExp :| []) (FArg :| [TArg])
Right ([("X",TArg)],FExp)
This example attempts to bind the second rule of the above and function. Compare the input to the AST for and shown above. The result is a tuple where the first, or left, element is the variable environment, and the second, or right, element is the expression that matched.
It's important to return the matching expression, since tryMatch doesn't in itself evaluate the body. In case of multiple rules, the interpreter needs to know which body is associated with the matching pattern.
ghci> tryMatch (Function "and" (TPat :| [VarPat "X"]) (VarExp "X") :|
[Function "and" (FPat :| [VarPat "X"]) FExp])
(TArg :| [TArg])
Right ([("X",TArg)],VarExp "X")
ghci> tryMatch (Function "and" (TPat :| [VarPat "X"]) (VarExp "X") :|
[Function "and" (FPat :| [VarPat "X"]) FExp])
(FArg :| [TArg])
Right ([("X",TArg)],FExp)
(Inputs manually formatted for improved readability.)
These two examples try to pattern match the above and function. In the first example, the input is true false, which matches the first rule and true X = X. Therefore, the return value is Right ([("X",TArg)],VarExp "X"), indicating a new variable environment in which X is bound to true, and the matching body is VarExp "X", indicating that the variable X is returned.
In the second example, the input is (false, true), which now matches the second rule and false X = false. The returned tuple now indicates that X is still bound to true, but the returned body is now FExp, indicating the constant return value false.
In both cases, tryMatch starts in the second (Haskell) rule, since there are two parameters. In the first example, the first call to tryBind immediately returns a Right result, which is then returned. In the second example, on the other hand, the first call to tryBind returns a Left-value result, which causes tryMatch to recurse back on itself with the remaining (Bopa) rules.
Evaluation #
Given a variable environment and an expression, it's now possible to evaluate the expression to a value.
-- Evaluate an expression, given a program (AST) and an environment. -- Also required as input is a set used for cycle detection. Set elements are -- tuples, each consisting of a function identifier (name) and arguments to that -- function. If the evaluator recursively sees that tuple again, it has detected -- a cycle, and stops further evaluation. eval :: Foldable t => Set (String, NonEmpty Arg) -> t (NonEmpty Function) -> [(String, Arg)] -> Exp -> Either String Arg eval _ _ env (VarExp name) = maybe (Left ("Could not find variable " ++ name ++ ".")) Right $ lookup name env eval _ _ _ TExp = Right TArg eval _ _ _ FExp = Right FArg eval observedCalls prog env (CallExp fnid exps) = do rules <- maybe (Left ("Could not find function " ++ fnid ++ ".")) Right $ find ((fnid ==) . fid . NE.head) prog args <- traverse (eval observedCalls prog env) exps (env', body) <- tryMatch rules args if Set.member (fnid, args) observedCalls then Left "Cycle detected." else eval (Set.insert (fnid, args) observedCalls) prog env' body
This looks like quite a mouthful, but notice that almost half of this code listing is a comment and a type declaration.
As the comment indicates, this function includes cycle detection, which was prompted by the exam questions related to the property of termination. You'll see an example of this later.
The eval function pattern matches the four different cases of the Exp sum type. In the first case, if the expression is a variable expression, it tries to lookup the variable in the environment. If found, it's returned; otherwise, an error message is returned.
The two next (Haskell) rules simply translate the Boolean representations from patterns to argument values.
Finally, if the expression is a function call, more work needs to be done. First, eval tries to find the function in the program. The eval function expects the program prog to be grouped in function rules. For example, it'd expect the above and function to be a NonEmpty list of Function values, and it'd expect, say, alltrue to be another NonEmpty list containing three Function values.
If eval finds the named function, it proceeds to evaluate all the expressions (exps) that make up the arguments. It traverses exps and calls itself recursively for each argument.
Armed with both rules and args it calls tryMatch to get a new variable environment and the body that matched. If it gets past the cycle detection, it proceeds to call itself recursively with the new environment and the body that matched.
Supplying a direct example of calling this function is becoming awkward, as it requires balancing quite a few parentheses, but it can be done.
ghci> eval
Set.empty
[Function "and" (TPat :| [VarPat "X"]) (VarExp "X") :|
[Function "and" (FPat :| [VarPat "X"]) FExp]]
[("X",TArg)]
TExp
Right TArg
(Input manually formatted for improved readability.)
This example starts with an empty cycle-detection set, the rules group for and, a variable environment in which X is already bound to true, and evaluates the expression TExp (i.e. true). The result is TArg (i.e. true) wrapped in Right, indicating that evaluation was successful.
Interpretation #
All building blocks for an interpreter are now in place.
-- Interpret a program (AST), given an entry point and its arguments. interpret :: Foldable f => f Function -> Entry -> Either String Arg interpret prog (Entry fnid args) = do let functions = NE.groupWith fid prog -- Group function rules together -- The rules that make up `fnid`: rules <- maybe (Left ("Could not find function " ++ fnid ++ ".")) Right $ find ((fnid ==) . fid . NE.head) functions (env, body) <- tryMatch rules args eval Set.empty functions env body
This function expects that the program (prog) supplied to it is the raw result of parsing a program. The parser doesn't group identically-named function rules together, so that's the first thing that interpret does.
It then proceeds to look through functions to find the function indicated by the entry point. If it succeeds, it calls tryMatch to identify the environment and the body to be evaluated. Finally, it calls eval with these values.
ghci> interpret
[Function "and" (TPat :| [VarPat "X"]) (VarExp "X"),
Function "and" (FPat :| [VarPat "X"]) FExp]
(Entry "and" (TArg :| [TArg]))
Right TArg
(Input manually formatted for improved readability.)
Like all the above examples, this example processes the and function, calling it with the input values true true, which returns a value representing true, just as we'd expect.
The interpreter seems to be working as intended, but it works on the AST. It's time to connect the parsers with the interpreter.
Formatting results #
It'd be more convenient if we feed some source code and a function call into a function and have it spit out the result. In order to make the result prettier, I first added a little formatter for Arg:
formatArg :: Arg -> String formatArg TArg = "true" formatArg FArg = "false" formatArg (PairArg a1 a2) = "(" ++ formatArg a1 ++ ", " ++ formatArg a2 ++ ")"
Not surprisingly, formatArg calls itself recursively in order to deal with pairs, and nested pairs.
ghci> formatArg (PairArg TArg (PairArg FArg TArg)) "(true, (false, true))"
It's not really required in order to parse and run a program, but I think that such a function should produce output that looks like the input fed into it.
Running programs #
All building blocks are now in place to compose a function that parses and runs a program.
-- Run a given program source and a command that identifies entry point and -- arguments. -- Despite the generalized type, it can be called as -- String -> String -> Either String String run :: (Stream s1 Identity Char, Stream s2 Identity Char) => s1 -> s2 -> Either String String run source cmd = do prog <- first show $ parseProgram source exec <- first show $ parseEntry cmd formatArg <$> interpret prog exec
As the comment suggests, you can call it by feeding it two string literals:
ghci> run "and true X = X\nand false X = false" "and true true" Right "true"
Having to supply entire programs from the REPL gets old fast, however, so instead you can save source code as files. I saved the original examples (containing and and alltrue) in a file named ex.bopa. This enabled me to load the file and call functions in it:
ghci> run <$> readFile "ex.bopa" <*> pure "alltrue (true, (false, true))" Right "false" ghci> run <$> readFile "ex.bopa" <*> pure "alltrue ((true, true), (true, true))" Right "true"
Those are the two examples originally included in the exam set, and fortunately the results are correct.
A few more examples #
I wanted to subject my code to a bit more testing, so wrote a few more example programs. This one I saved in a file called evenodd.bopa:
and true X = X and false X = false or true X = true or false X = X not true = false not false = true odd true = true odd false = true odd (X, Y) = or (and (odd X) (even Y)) (and (even X) (odd Y)) even X = not (odd X)
The idea with odd is that it indicates whether the input contains an odd number of Boolean values; of course, even is then the negation of odd.
ghci> run <$> readFile "evenodd.bopa" <*> pure "odd true" Right "true" ghci> run <$> readFile "evenodd.bopa" <*> pure "even true" Right "false" ghci> run <$> readFile "evenodd.bopa" <*> pure "odd (true, false)" Right "false" ghci> run <$> readFile "evenodd.bopa" <*> pure "even (true, false)" Right "true" ghci> run <$> readFile "evenodd.bopa" <*> pure "odd (true, (false, true))" Right "true"
Ad hoc tests like these gave me confidence that things aren't completely wrong.
Cycle detection #
Finally, you may be curious to see whether the cycle detection works. The simplest example I could come up with was this:
ghci> run "forever X = forever X" "forever false" Left "Cycle detected."
Even so, I also wanted to test that it works for a small cycle that involves more than one function, so I saved the following in a file called tictactoe.bopa:
tic X = tac X tac X = toe X toe X = tic X foo (false, Y) = Y foo (true, Y) = tic Y
These functions may cause an infinite cycle, depending on input.
ghci> run <$> readFile "tictactoe.bopa" <*> pure "foo (false, (true, false))" Right "(true, false)" ghci> run <$> readFile "tictactoe.bopa" <*> pure "foo (true, (true, false))" Left "Cycle detected."
The run function implements an algorithm that is always able to determine, in finite time, whether a program terminates or not. Thus, in case you're wondering: The language isn't Turing complete.
Conclusion #
Implementing a parser and interpreter for the Bopa language wasn't part of the exam question, but I had some time to spare, and also found that I had trouble describing, in unambiguous terms, how to detect termination. I decided to write the interpreter to show a code example, and then took on the parser as an extra exercise.
It took me a long day of intense coding to produce the prototype shown here, including the various example Bopa programs. No AI was involved. It was fun.
