Created
January 30, 2015 18:04
-
-
Save csabahruska/8688fb220ff181b02f81 to your computer and use it in GitHub Desktop.
indentation example
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Data.ByteString.Char8 (unpack,pack) | |
import qualified Data.ByteString.Char8 as BS | |
import Control.Applicative | |
import Text.Trifecta | |
import Text.Trifecta.Indentation as I | |
import Text.Trifecta.Delta | |
import Text.Parser.Token.Style | |
import qualified Data.HashSet as HashSet | |
type EName = String | |
data Lit | |
= LInt | |
| LChar | |
| LFloat | |
deriving (Show,Eq,Ord) | |
data PrimFun | |
= PAddI | |
| PUpper | |
| PMulF | |
| PShow | |
| PRead | |
deriving (Show,Eq,Ord) | |
type Range = (Delta,Delta) | |
data Exp | |
= ELit Range Lit | |
| EPrimFun Range PrimFun | |
| EVar Range EName | |
| EApp Range Exp Exp | |
| ELam Range EName Exp | |
| ELet Range EName Exp Exp | |
-- | EFix EName Exp | |
deriving (Show,Eq,Ord) | |
type P a = IndentationParserT Char Parser a | |
lcIdents = emptyIdents { _styleReserved = HashSet.fromList reservedIdents } | |
where | |
reservedIdents = | |
[ "let" | |
, "upper" | |
, "in" | |
, "add" | |
, "show" | |
, "read" | |
] | |
kw w = reserve lcIdents w | |
op w = reserve haskellOps w | |
var :: P String | |
var = ident lcIdents | |
lit :: P Lit | |
lit = LFloat <$ try double <|> LInt <$ integer <|> LChar <$ charLiteral | |
letin :: P Exp | |
letin = do | |
localIndentation Ge $ do | |
l <- kw "let" *> (localIndentation Gt $ some $ localAbsoluteIndentation $ def) -- WORKS | |
a <- kw "in" *> (localIndentation Gt expr) | |
return $ foldr ($) a l | |
def :: P (Exp -> Exp) | |
def = (\p1 n d p2 e -> ELet (p1,p2) n d e) <$> position <*> var <* kw "=" <*> expr <*> position | |
expr :: P Exp | |
expr = letin <|> lam <|> formula | |
formula = (\p1 l p2 -> foldl1 (EApp (p1,p2)) l) <$> position <*> some atom <*> position | |
atom = | |
(\p1 f p2 -> EPrimFun (p1,p2) f) <$> position <*> primFun <*> position <|> | |
(\p1 l p2 -> ELit (p1,p2) l) <$> position <*> lit <*> position <|> | |
(\p1 v p2 -> EVar (p1,p2) v) <$> position <*> var <*> position <|> | |
parens expr | |
primFun = PUpper <$ kw "upper" <|> | |
PAddI <$ kw "add" <|> | |
PShow <$ kw "show" <|> | |
PRead <$ kw "read" | |
lam :: P Exp | |
lam = (\p1 n e p2 -> ELam (p1,p2) n e) <$> position <* op "\\" <*> var <* op "->" <*> expr <*> position | |
indentState = mkIndentationState 1 infIndentation True Gt | |
src = pack $ unlines | |
[ "" | |
, "" | |
, "let id = \\x -> x" | |
, " c = ' '" | |
, " i = 1" | |
, " a = id c" | |
, " b = id i" | |
, " inc = \\x -> add 1 x" | |
, "in id inc" | |
, "" | |
, "" | |
] | |
test :: IO () | |
test = do | |
case parseByteString (evalIndentationParserT (kw "" *> expr <* eof) indentState) (Directed BS.empty 0 0 0 0) src of | |
Failure m -> print m | |
Success e -> return () |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment