HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Prolog parser written in Haskell

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
parserwrittenprologhaskell

Problem

I am writing a very simple Prolog intepreter in Haskell. It's a class assignment and I really want to do it right.

I was able to (quite quickly) write a parser for the language. Today I borrowed a copy of Programming in Haskell by Graham Hutton and I decided I would rewrite my code to a more function-oriented style, using fancy Haskell features.

I spent my whole day reading about Monads and how they can simplify the code. Then I tried coding the book's examples, but they seem a bit outdated and incomplete.

Now, I have a working Prolog parser I am not happy with (because I am sure I can do shorter and terser).

I would like if anyone could review my code and give advice as how to move towards a more "Haskellish" approach. I don't want to use Parsec or any other ready-made parser in my code. I am looking for a minimalist working solution.

```
import Data.Char

data Category = Atom | Variable | Number | Operator | Complex deriving (Show, Eq)

data Token = Token {
category :: Category,
token :: String
}

instance Show Token where
show (Token {token = token}) = show token

data Term = Term {
tokenType :: Category,
name :: String,
args :: [Term]
}

instance Show Term where
show (Term {tokenType = tokenType, name = name, args = args}) =
name ++ if tokenType == Complex then
"(" ++ showTermList args ++ ")"
else []

showTermList [] = []
showTermList (t : []) = show t
showTermList (t : ts) = show t ++ ", " ++ showTermList ts

data Rule = Rule {
lhs :: Maybe Term,
rhs :: [Term]
}

instance Show Rule where
show (Rule { lhs = lhs, rhs = rhs }) =
show lhs ++ " :- " ++ showTermList rhs

operators = "()[];"
smileyOperator = ":-"
openParen = "("
closeParen = ")"
comma = ","
dot = "."

parse :: [Token] -> [Rule]
parse [] = []
parse ts =
let (rule, ts') = parseRule ts
in (rule : parse ts')

parseRule :: [Token] -> (Rule, [Token])
parseRule [] = error "No tokens to parse"
parseRule t

Solution

Built-ins

The function showTermList applies show to each item in the list (map show) and puts , [COMMA] between any two items of the list (intercalate ","). You can just use this predefined functions to write:

showTermList = intercalate ","  . map show


Also in tokens:

| isSpace c = tokens cs -- eat all whitespace


Eating all white-space is better expressed as filter (not . isSpace).

tokens :: String -> [Token]
tokens = tokens' . filter (not . isSpace)
  where
    tokens' [] = []
    tokens' (c:cs) = let (token, cs') = nextToken (c : cs)
        in token : tokens cs'


Repetition

You have the repetition of (rule, in your function:

parseRule :: [Token] -> (Rule, [Token])
parseRule [] = error "No tokens to parse"
parseRule ts =
    if null ts' || token (head ts') /= dot then
        (rule, ts')
    else
        (rule, tail ts')
    where (rule, ts') = parseRule' ts


You could avoid it by assigning a tail variable:

parseRule ts = (rule, tail)
    where
      (rule, ts') = parseRule' ts
      tail = if null ts' || token (head ts') /= dot then ts' else tail ts'


Guards are even more visually immediate then if else:

parseRule ts = (rule, decideTail ts')
    where
      (rule, ts') = parseRule' ts
      decideTail ts'
        | null ts' || token (head ts') /= dot = ts'
        | otherwise = tail ts'


Now we note that:

(rule, decideTail ts')
     where
       (rule, ts') = parseRule' ts


Is built-in under the name of mapSnd

parseRule ts = mapSnd decideTail $  parseRule' ts
    where
      decideTail ts'
        | null ts' || token (head ts') /= dot = ts'
        | otherwise = tail ts'


Or even pointfree:

parseRule = mapSnd decideTail .  parseRule'
  where
      decideTail ts'
        | null ts' || token (head ts') /= dot = ts'
        | otherwise = tail ts'


accumulate

accumulate is a particularly fortunate case because it can be written as flip span using Haskell built-ins (just search String -> (Char -> Bool) -> (String, String) in Hoogle and you will find it (span is more general hence the a in the signature, in your case a = Char))

Code Snippets

showTermList = intercalate ","  . map show
| isSpace c = tokens cs -- eat all whitespace
tokens :: String -> [Token]
tokens = tokens' . filter (not . isSpace)
  where
    tokens' [] = []
    tokens' (c:cs) = let (token, cs') = nextToken (c : cs)
        in token : tokens cs'
parseRule :: [Token] -> (Rule, [Token])
parseRule [] = error "No tokens to parse"
parseRule ts =
    if null ts' || token (head ts') /= dot then
        (rule, ts')
    else
        (rule, tail ts')
    where (rule, ts') = parseRule' ts
parseRule ts = (rule, tail)
    where
      (rule, ts') = parseRule' ts
      tail = if null ts' || token (head ts') /= dot then ts' else tail ts'

Context

StackExchange Code Review Q#123600, answer score: 4

Revisions (0)

No revisions yet.