diff --git a/code/cs325-langs/src/Common.hs b/code/cs325-langs/src/Common.hs new file mode 100644 index 0000000..a78ed8a --- /dev/null +++ b/code/cs325-langs/src/Common.hs @@ -0,0 +1,15 @@ +module Common where +import PythonAst +import PythonGen +import Text.Parsec + +compile :: (String -> String -> Either ParseError p) -> (p -> [PyStmt]) -> String -> IO () +compile p t f = do + let inputName = f ++ ".lang" + let outputName = f ++ ".py" + file <- readFile inputName + let either = p inputName file + case either of + Right prog -> writeFile outputName (translate $ t prog) + Left e -> print e + diff --git a/code/cs325-langs/src/PythonAst.hs b/code/cs325-langs/src/PythonAst.hs new file mode 100644 index 0000000..bf7949f --- /dev/null +++ b/code/cs325-langs/src/PythonAst.hs @@ -0,0 +1,47 @@ +module PythonAst where + +data PyBinOp + = Add + | Subtract + | Multiply + | Divide + | LessThan + | LessThanEq + | GreaterThan + | GreaterThanEq + | Equal + | NotEqual + | And + | Or + +data PyExpr + = BinOp PyBinOp PyExpr PyExpr + | IntLiteral Int + | StrLiteral String + | BoolLiteral Bool + | ListLiteral [PyExpr] + | DictLiteral [(PyExpr, PyExpr)] + | Lambda [PyPat] PyExpr + | Var String + | Tuple [PyExpr] + | FunctionCall PyExpr [PyExpr] + | Access PyExpr [PyExpr] + | Ternary PyExpr PyExpr PyExpr + | Member PyExpr String + | In PyExpr PyExpr + | NotIn PyExpr PyExpr + +data PyPat + = VarPat String + | IgnorePat + | TuplePat [PyPat] + | AccessPat PyExpr [PyExpr] + +data PyStmt + = Assign PyPat PyExpr + | IfElse PyExpr [PyStmt] [(PyExpr, [PyStmt])] (Maybe [PyStmt]) + | While PyExpr [PyStmt] + | For PyPat PyExpr [PyStmt] + | FunctionDef String [String] [PyStmt] + | Return PyExpr + | Standalone PyExpr diff --git a/code/cs325-langs/src/PythonGen.hs b/code/cs325-langs/src/PythonGen.hs new file mode 100644 index 0000000..9a58176 --- /dev/null +++ b/code/cs325-langs/src/PythonGen.hs @@ -0,0 +1,132 @@ +module PythonGen where +import PythonAst +import Data.List +import Data.Bifunctor +import Data.Maybe + +indent :: String -> String +indent = (" " ++) + +stmtBlock :: [PyStmt] -> [String] +stmtBlock = concatMap translateStmt + +block :: String -> [String] -> [String] +block s ss = (s ++ ":") : map indent ss + +prefix :: String -> PyExpr -> [PyStmt] -> [String] +prefix s e sts = block (s ++ " " ++ translateExpr e) $ stmtBlock sts + +if_ :: PyExpr -> [PyStmt] -> [String] +if_ = prefix "if" + +elif :: PyExpr -> [PyStmt] -> [String] +elif = prefix "elif" + +else_ :: [PyStmt] -> [String] +else_ = block "else" . stmtBlock + +while :: PyExpr -> [PyStmt] -> [String] +while = prefix "while" + +parenth :: String -> String +parenth s = "(" ++ s ++ ")" + +translateStmt :: PyStmt -> [String] +translateStmt (Assign p e) = [translatePat p ++ " = " ++ translateExpr e] +translateStmt (IfElse i t es e) = + if_ i t ++ concatMap (uncurry elif) es ++ maybe [] else_ e +translateStmt (While c t) = while c t +translateStmt (For x in_ b) = block head body + where + head = "for " ++ translatePat x ++ " in " ++ translateExpr in_ + body = stmtBlock b +translateStmt (FunctionDef s ps b) = block head body + where + head = "def " ++ s ++ "(" ++ intercalate "," ps ++ ")" + body = stmtBlock b +translateStmt (Return e) = ["return " ++ translateExpr e] +translateStmt (Standalone e) = [translateExpr e] + +precedence :: PyBinOp -> Int +precedence Add = 3 +precedence Subtract = 3 +precedence Multiply = 4 +precedence Divide = 4 +precedence LessThan = 2 +precedence LessThanEq = 2 +precedence GreaterThan = 2 +precedence GreaterThanEq = 2 +precedence Equal = 2 +precedence And = 1 +precedence Or = 0 + +opString :: PyBinOp -> String +opString Add = "+" +opString Subtract = "-" +opString Multiply = "*" +opString Divide = "/" +opString LessThan = "<" +opString LessThanEq = "<=" +opString GreaterThan = ">" +opString GreaterThanEq = ">=" +opString Equal = "==" +opString NotEqual = "!=" +opString And = "and" +opString Or = "or" + +translateOp :: PyBinOp -> PyBinOp -> PyExpr -> String +translateOp o o' = + if precedence o < precedence o' + then parenth . translateExpr + else translateExpr + +dictMapping :: PyExpr -> PyExpr -> String +dictMapping f t = translateExpr f ++ ": " ++ translateExpr t + +list :: String -> String -> [PyExpr] -> String +list o c es = o ++ intercalate ", " (map translateExpr es) ++ c + +translateExpr :: PyExpr -> String +translateExpr (BinOp o l@(BinOp o1 _ _) r@(BinOp o2 _ _)) = + translateOp o o1 l ++ opString o ++ translateOp o o2 r +translateExpr (BinOp o l@(BinOp o1 _ _) r) = + translateOp o o1 l ++ opString o ++ translateExpr r +translateExpr (BinOp o l r@(BinOp o2 _ _)) = + translateExpr l ++ opString o ++ translateOp o o2 r +translateExpr (BinOp o l r) = + translateExpr l ++ opString o ++ translateExpr r +translateExpr (IntLiteral i) = show i +translateExpr (StrLiteral s) = "\"" ++ s ++ "\"" +translateExpr (BoolLiteral b) = if b then "true" else "false" +translateExpr (ListLiteral l) = list "[" "]" l +translateExpr (DictLiteral l) = + "{" ++ intercalate ", " (map (uncurry dictMapping) l) ++ "}" +translateExpr (Lambda ps e) = parenth (head ++ ": " ++ body) + where + head = "lambda " ++ intercalate ", " (map translatePat ps) + body = translateExpr e +translateExpr (Var s) = s +translateExpr (Tuple es) = list "(" ")" es +translateExpr (FunctionCall f ps) = translateExpr f ++ list "(" ")" ps +translateExpr (Access (Var s) e) = s ++ list "[" "]" e +translateExpr (Access e@Access{} i) = translateExpr e ++ list "[" "]" i +translateExpr (Access e i) = "(" ++ translateExpr e ++ ")" ++ list "[" "]" i +translateExpr (Ternary c t e) = + translateExpr t ++ " if " ++ translateExpr c ++ " else " ++ translateExpr e +translateExpr (Member (Var s) m) = s ++ "." ++ m +translateExpr (Member e@Member{} m) = translateExpr e ++ "." ++ m +translateExpr (Member e m) = "(" ++ translateExpr e ++ ")." ++ m +translateExpr (In m c) = + "(" ++ translateExpr m ++ ") in (" ++ translateExpr c ++ ")" +translateExpr (NotIn m c) = + "(" ++ translateExpr m ++ ") not in (" ++ translateExpr c ++ ")" + +translatePat :: PyPat -> String +translatePat (VarPat s) = s +translatePat IgnorePat = "_" +translatePat (TuplePat ps) = + "(" ++ intercalate "," (map translatePat ps) ++ ")" +translatePat (AccessPat e es) = translateExpr (Access e es) + +translate :: [PyStmt] -> String +translate = intercalate "\n" . concatMap translateStmt