Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# Language TemplateHaskell, QuasiQuotes, FlexibleContexts #-}
- module Main where
- import Text.Peggy hiding ( Expr, parse )
- import Text.Peggy.LeftRec
- import Prelude
- type Id = String
- data Prog = Prog Id [Decl] Stmt deriving (Show)
- data Lit = IntL Integer | StrL String deriving (Show)
- data Decl = VarD Id Id deriving (Show)
- data Stmt = AssignS Id Expr | IfS Expr Stmt (Maybe Stmt) | SubS [Stmt] deriving (Show)
- data Expr = AppE Expr Op Expr | LitE Lit | VarE Id deriving (Show)
- data Op = Add | Sub | Mul | Div | Eqv deriving (Show)
- genParser [] $ removeLeftRecursion [peggy|
- regionComment :: () =
- '(*' (regionComment / !'*)' . {()})* '*)' {()}
- nm :: Id = [a-z_] [a-zA-Z0-9_]* { $1 : $2 }
- ty :: Id = nm
- strLit :: Lit = ( '\"' (!'\"' .)* '\"'
- / '\'' (!'\'' .)* '\'') { StrL $1 }
- intLit :: Lit = [0-9]+ { IntL (read $1) }
- stmt :: Stmt
- = "if" expr "then" stmt ("else" stmt)? { IfS $1 $2 $3 }
- / "begin" (stmt ";")* "end" { SubS $1 }
- / nm ":=" expr { AssignS $1 $2 }
- op :: Op = "+" { Add } / "-" { Sub }
- / "*" { Mul } / "/" { Div } / "=" { Eqv }
- expr :: Expr
- = expr op expr { AppE $1 $2 $3 }
- / "(" expr ")" { $1 }
- / lit:(strLit / intLit) { LitE lit }
- / nm { VarE $1 }
- program :: Prog
- = "program" nm ";"
- ("var" nm ("," nm)* ":" ty ";" { ($1 : $2, $3) })*
- stmt
- { Prog $1
- (concatMap (\(vs,t) -> map (VarD t) vs) $2)
- $3
- }
- |]
- parse code = parseString program "" code
- check code = either (const True) (const False) code
- main = print . parse =<< getContents
- test = print $ parse
- "program rrr; \
- \var y, lala : integer; \
- \begin \
- \ if y = 0 then begin \
- \ c := \"Hey?\"+10*20; \
- \ end \
- \ else begin \
- \ c := 'Hoe!' / (30-20); \
- \ end; \
- \ c := 60; \
- \end."
- -- >
- {-
- Right (Prog "rrr" [VarD "integer" "y",VarD "integer" "lala"]
- (SubS [IfS (AppE (VarE "y") Eqv (LitE (IntL 0)))
- (SubS [AssignS "c" (AppE (LitE (StrL "Hey?")) Add
- (AppE (LitE (IntL 10)) Mul (LitE (IntL 20))))])
- (Just (SubS [AssignS "c" (AppE (LitE (StrL "Hoe!")) Div
- (AppE (LitE (IntL 30)) Sub (LitE (IntL 20))))]))
- , AssignS "c" (LitE (IntL 60))
- ]))
Add Comment
Please, Sign In to add comment