Add solution to CS325 hw2
This commit is contained in:
parent
6e88780f8b
commit
382102f071
242
code/cs325-langs/src/LanguageTwo.hs
Normal file
242
code/cs325-langs/src/LanguageTwo.hs
Normal file
|
|
@ -0,0 +1,242 @@
|
|||
module LanguageTwo where
|
||||
import qualified PythonAst as Py
|
||||
import Data.Char
|
||||
import Data.Functor
|
||||
import Text.Parsec
|
||||
import Text.Parsec.Char
|
||||
import Text.Parsec.Combinator
|
||||
|
||||
{- Data Types -}
|
||||
data Op
|
||||
= Add
|
||||
| Subtract
|
||||
| Multiply
|
||||
| Divide
|
||||
| Equal
|
||||
| NotEqual
|
||||
| And
|
||||
| Or
|
||||
|
||||
data Expr
|
||||
= IntLiteral Int
|
||||
| BinOp Op Expr Expr
|
||||
| Var String
|
||||
| Length Expr
|
||||
|
||||
data Stmt
|
||||
= IfElse Expr Stmt (Maybe Stmt)
|
||||
| Assign String Expr
|
||||
| Block [Stmt]
|
||||
|
||||
data Prog = Prog Expr [Stmt] [Stmt]
|
||||
|
||||
{- Parser -}
|
||||
type Parser = Parsec String ()
|
||||
|
||||
parseKw :: String -> Parser ()
|
||||
parseKw s = string s $> ()
|
||||
|
||||
parseKwIf :: Parser ()
|
||||
parseKwIf = parseKw "if"
|
||||
|
||||
parseKwElse :: Parser ()
|
||||
parseKwElse = parseKw "else"
|
||||
|
||||
parseKwState :: Parser ()
|
||||
parseKwState = parseKw "state"
|
||||
|
||||
parseKwEffect :: Parser ()
|
||||
parseKwEffect = parseKw "effect"
|
||||
|
||||
parseKwCombine :: Parser ()
|
||||
parseKwCombine = parseKw "combine"
|
||||
|
||||
parseOp :: String -> Op -> Parser Op
|
||||
parseOp s o = string s $> o
|
||||
|
||||
parseInt :: Parser Int
|
||||
parseInt = read <$> (many1 digit <* spaces)
|
||||
|
||||
parseVar :: Parser String
|
||||
parseVar =
|
||||
do
|
||||
c <- satisfy $ \c -> isLetter c || c == '_'
|
||||
cs <- many (satisfy isLetter <|> digit) <* spaces
|
||||
let name = c:cs
|
||||
if name `elem` ["if", "else", "state", "effect", "combine"]
|
||||
then fail "Can't use reserved keyword as identifier"
|
||||
else return name
|
||||
|
||||
parseSurrounded :: Char -> Char -> Parser a -> Parser a
|
||||
parseSurrounded c1 c2 pe =
|
||||
do
|
||||
char c1 >> spaces
|
||||
e <- pe
|
||||
spaces >> char c2 >> spaces
|
||||
return e
|
||||
|
||||
parseLength :: Parser Expr
|
||||
parseLength = Length <$> parseSurrounded '|' '|' parseExpr
|
||||
|
||||
parseParenthesized :: Parser Expr
|
||||
parseParenthesized = parseSurrounded '(' ')' parseExpr
|
||||
|
||||
parseBasic :: Parser Expr
|
||||
parseBasic = choice
|
||||
[ IntLiteral <$> parseInt
|
||||
, Var <$> parseVar
|
||||
, parseLength
|
||||
, parseParenthesized
|
||||
]
|
||||
|
||||
parseLevel :: Parser Op -> Parser Expr -> Parser Expr
|
||||
parseLevel po pe =
|
||||
do
|
||||
e <- pe <* spaces
|
||||
ops <- many ((flip . BinOp <$> (po <* spaces) <*> pe) <* spaces)
|
||||
return $ foldl (flip ($)) e ops
|
||||
|
||||
parseExpr :: Parser Expr
|
||||
parseExpr = foldl (flip parseLevel) parseBasic
|
||||
[ parseOp "*" Multiply <|> parseOp "/" Divide
|
||||
, parseOp "+" Add <|> parseOp "-" Subtract
|
||||
, parseOp "==" Equal <|> parseOp "!=" NotEqual
|
||||
, parseOp "&&" And
|
||||
, try $ parseOp "||" Or
|
||||
]
|
||||
|
||||
parseIf :: Parser Stmt
|
||||
parseIf = do
|
||||
parseKwIf >> spaces
|
||||
c <- parseParenthesized
|
||||
t <- parseStmt <* spaces
|
||||
e <- (Just <$> (parseKwElse >> spaces *> parseStmt)) <|> return Nothing
|
||||
return $ IfElse c t e
|
||||
|
||||
parseBlockStmts :: Parser [Stmt]
|
||||
parseBlockStmts = parseSurrounded '{' '}' (many parseStmt)
|
||||
|
||||
parseBlock :: Parser Stmt
|
||||
parseBlock = Block <$> parseBlockStmts
|
||||
|
||||
parseAssign :: Parser Stmt
|
||||
parseAssign = Assign <$>
|
||||
(parseVar <* spaces <* char '=' <* spaces) <*>
|
||||
parseExpr <* (char ';' >> spaces)
|
||||
|
||||
parseStmt :: Parser Stmt
|
||||
parseStmt = choice
|
||||
[ parseIf
|
||||
, parseAssign
|
||||
, parseBlock
|
||||
]
|
||||
|
||||
parseProgram :: Parser Prog
|
||||
parseProgram = do
|
||||
state <- parseKwState >> spaces *> parseExpr <* char ';' <* spaces
|
||||
effect <- parseKwEffect >> spaces *> parseBlockStmts <* spaces
|
||||
combined <- parseKwCombine >> spaces *> parseBlockStmts <* spaces
|
||||
return $ Prog state effect combined
|
||||
|
||||
parse :: String -> String -> Either ParseError Prog
|
||||
parse = runParser parseProgram ()
|
||||
|
||||
{- Translation -}
|
||||
baseFunction :: Py.PyExpr -> [Py.PyStmt] -> [Py.PyStmt] -> Py.PyStmt
|
||||
baseFunction s e c = Py.FunctionDef "prog" ["xs"] $
|
||||
[Py.IfElse
|
||||
(Py.BinOp Py.LessThan
|
||||
(Py.FunctionCall (Py.Var "len") [Py.Var "xs"])
|
||||
(Py.IntLiteral 2))
|
||||
[Py.Return $ Py.Tuple [s, Py.Var "xs"]]
|
||||
[]
|
||||
Nothing
|
||||
, Py.Assign (Py.VarPat "leng")
|
||||
(Py.BinOp Py.FloorDiv
|
||||
(Py.FunctionCall (Py.Var "len") [Py.Var "xs"])
|
||||
(Py.IntLiteral 2))
|
||||
, Py.Assign (Py.VarPat "left")
|
||||
(Py.Access
|
||||
(Py.Var "xs")
|
||||
[Py.Slice Nothing $ Just (Py.Var "leng")])
|
||||
, Py.Assign (Py.VarPat "right")
|
||||
(Py.Access
|
||||
(Py.Var "xs")
|
||||
[Py.Slice (Just (Py.Var "leng")) Nothing])
|
||||
, Py.Assign (Py.TuplePat [Py.VarPat "ls", Py.VarPat "left"])
|
||||
(Py.FunctionCall (Py.Var "prog") [Py.Var "left"])
|
||||
, Py.Assign (Py.TuplePat [Py.VarPat "rs", Py.VarPat "right"])
|
||||
(Py.FunctionCall (Py.Var "prog") [Py.Var "right"])
|
||||
, Py.Standalone $
|
||||
Py.FunctionCall (Py.Member (Py.Var "left") "reverse") []
|
||||
, Py.Standalone $
|
||||
Py.FunctionCall (Py.Member (Py.Var "right") "reverse") []
|
||||
, Py.Assign (Py.VarPat "state") s
|
||||
, Py.Assign (Py.VarPat "source") (Py.IntLiteral 0)
|
||||
, Py.Assign (Py.VarPat "total") (Py.ListLiteral [])
|
||||
, Py.While
|
||||
(Py.BinOp Py.And
|
||||
(Py.BinOp Py.NotEqual (Py.Var "left") (Py.ListLiteral []))
|
||||
(Py.BinOp Py.NotEqual (Py.Var "right") (Py.ListLiteral []))) $
|
||||
[ Py.IfElse
|
||||
(Py.BinOp Py.LessThanEq
|
||||
(Py.Access (Py.Var "left") [Py.IntLiteral $ -1])
|
||||
(Py.Access (Py.Var "right") [Py.IntLiteral $ -1]))
|
||||
[ Py.Standalone $
|
||||
Py.FunctionCall (Py.Member (Py.Var "total") "append")
|
||||
[Py.FunctionCall (Py.Member (Py.Var "left") "pop") []]
|
||||
, Py.Assign (Py.VarPat "source") (Py.IntLiteral 1)
|
||||
]
|
||||
[] $
|
||||
Just
|
||||
[ Py.Standalone $
|
||||
Py.FunctionCall (Py.Member (Py.Var "total") "append")
|
||||
[Py.FunctionCall (Py.Member (Py.Var "right") "pop") []]
|
||||
, Py.Assign (Py.VarPat "source") (Py.IntLiteral 2)
|
||||
]
|
||||
] ++ e
|
||||
] ++ c ++
|
||||
[ Py.Standalone $ Py.FunctionCall (Py.Member (Py.Var "left") "reverse") []
|
||||
, Py.Standalone $ Py.FunctionCall (Py.Member (Py.Var "right") "reverse") []
|
||||
, Py.Return $ Py.Tuple
|
||||
[ Py.Var "state"
|
||||
, foldl (Py.BinOp Py.Add) (Py.Var "total") [Py.Var "left", Py.Var "right"]
|
||||
]
|
||||
]
|
||||
|
||||
translateExpr :: Expr -> Py.PyExpr
|
||||
translateExpr (IntLiteral i) = Py.IntLiteral i
|
||||
translateExpr (BinOp op l r) =
|
||||
Py.BinOp (translateOp op) (translateExpr l) (translateExpr r)
|
||||
translateExpr (Var s)
|
||||
| s == "SOURCE" = Py.Var "source"
|
||||
| s == "LEFT" = Py.Var "left"
|
||||
| s == "RIGHT" = Py.Var "right"
|
||||
| s == "STATE" = Py.Var "state"
|
||||
| s == "LSTATE" = Py.Var "ls"
|
||||
| s == "RSTATE" = Py.Var "rs"
|
||||
| s == "L" = Py.IntLiteral 1
|
||||
| s == "R" = Py.IntLiteral 2
|
||||
| otherwise = Py.Var s
|
||||
translateExpr (Length e) = Py.FunctionCall (Py.Var "len") [translateExpr e]
|
||||
|
||||
translateOp :: Op -> Py.PyBinOp
|
||||
translateOp Add = Py.Add
|
||||
translateOp Subtract = Py.Subtract
|
||||
translateOp Multiply = Py.Multiply
|
||||
translateOp Divide = Py.Divide
|
||||
translateOp Equal = Py.Equal
|
||||
translateOp NotEqual = Py.NotEqual
|
||||
translateOp And = Py.And
|
||||
translateOp Or = Py.Or
|
||||
|
||||
translateStmt :: Stmt -> [Py.PyStmt]
|
||||
translateStmt (IfElse c t e) =
|
||||
[Py.IfElse (translateExpr c) (translateStmt t) [] (translateStmt <$> e)]
|
||||
translateStmt (Assign "STATE" e) = [Py.Assign (Py.VarPat "state") (translateExpr e)]
|
||||
translateStmt (Assign v e) = [Py.Assign (Py.VarPat v) (translateExpr e)]
|
||||
translateStmt (Block s) = concatMap translateStmt s
|
||||
|
||||
translate :: Prog -> [Py.PyStmt]
|
||||
translate (Prog s e c) =
|
||||
[baseFunction (translateExpr s) (concatMap translateStmt e) (concatMap translateStmt c)]
|
||||
|
|
@ -5,6 +5,7 @@ data PyBinOp
|
|||
| Subtract
|
||||
| Multiply
|
||||
| Divide
|
||||
| FloorDiv
|
||||
| LessThan
|
||||
| LessThanEq
|
||||
| GreaterThan
|
||||
|
|
@ -30,6 +31,7 @@ data PyExpr
|
|||
| Member PyExpr String
|
||||
| In PyExpr PyExpr
|
||||
| NotIn PyExpr PyExpr
|
||||
| Slice (Maybe PyExpr) (Maybe PyExpr)
|
||||
|
||||
data PyPat
|
||||
= VarPat String
|
||||
|
|
|
|||
|
|
@ -52,11 +52,13 @@ precedence Add = 3
|
|||
precedence Subtract = 3
|
||||
precedence Multiply = 4
|
||||
precedence Divide = 4
|
||||
precedence FloorDiv = 4
|
||||
precedence LessThan = 2
|
||||
precedence LessThanEq = 2
|
||||
precedence GreaterThan = 2
|
||||
precedence GreaterThanEq = 2
|
||||
precedence Equal = 2
|
||||
precedence NotEqual = 2
|
||||
precedence And = 1
|
||||
precedence Or = 0
|
||||
|
||||
|
|
@ -65,6 +67,7 @@ opString Add = "+"
|
|||
opString Subtract = "-"
|
||||
opString Multiply = "*"
|
||||
opString Divide = "/"
|
||||
opString FloorDiv = "//"
|
||||
opString LessThan = "<"
|
||||
opString LessThanEq = "<="
|
||||
opString GreaterThan = ">"
|
||||
|
|
@ -120,6 +123,8 @@ translateExpr (In m c) =
|
|||
"(" ++ translateExpr m ++ ") in (" ++ translateExpr c ++ ")"
|
||||
translateExpr (NotIn m c) =
|
||||
"(" ++ translateExpr m ++ ") not in (" ++ translateExpr c ++ ")"
|
||||
translateExpr (Slice l r) =
|
||||
maybe [] (parenth . translateExpr) l ++ ":" ++ maybe [] (parenth . translateExpr) r
|
||||
|
||||
translatePat :: PyPat -> String
|
||||
translatePat (VarPat s) = s
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user