Create a gist now

Instantly share code, notes, and snippets.

@osa1 /gist:9414577
Last active Nov 4, 2017

What would you like to do?
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative ((<*))
import qualified Data.Set as S
import Prelude hiding (exp)
import Text.Parsec
import Debug.Trace
type MarksSeen = S.Set Int
type RecParser s m a = ParsecT s MarksSeen m a
putMark i = do
is <- getState
if S.member i is
then fail "recursion"
else putState $ S.insert i is
resetMarks = putState S.empty
plus = char '+' >> spaces
int = fmap (Int . read) $ many1 digit <* spaces
data Exp = Add Exp Exp
| App Exp Exp
| Int Int
deriving (Show)
add = do
putMark 1
e1 <- exp
resetMarks
plus
e2 <- exp
return $ Add e1 e2
app = do
putMark 2
fn <- exp
resetMarks
putMark 2
as <- many1 exp
resetMarks
return $ foldl App fn as
exp = choice [try add, try app, int] <* spaces
pgm = exp <* eof
rec = putMark 0 >> rec >> resetMarks
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment