module Sifflet.Foreign.Python
(PModule(..)
, PStatement(..)
, PExpr(..)
, PIdentifier(..)
, PParameter(..)
, POperator(..)
, Precedence
, alterParens
, atomic
, compound
, ret
, condS
, condE
, var
, ident
, pInt
, pFloat
, bool
, char
, string
, paren
, noParens
, fullParens
, bestParens
, simplifyParens
, par
, unpar
, call
, param
, fun
, opTimes
, opIDiv
, opFDiv
, opMod
, opPlus
, opMinus
, opEq
, opNe
, opGt
, opGe
, opLt
, opLe
)
where
import Sifflet.Text.Pretty
prettyParens :: (Pretty a) => [a] -> String
prettyParens = prettyList "(" ", " ")"
prettyBrackets :: (Pretty a) => [a] -> String
prettyBrackets = prettyList "[" ", " "]"
data PModule = PModule [PStatement]
deriving (Eq, Show)
instance Pretty PModule where
pretty (PModule ss) = sepLines2 (map pretty ss)
data PStatement = PReturn PExpr
| PImport String
| PCondS PExpr
PStatement
PStatement
| PFun PIdentifier
[PParameter]
PStatement
deriving (Eq, Show)
instance Pretty PStatement where
pretty s =
case s of
PReturn e -> "return " ++ pretty e
PImport modName -> "import " ++ modName
PCondS c a b ->
sepLines ["if " ++ pretty c ++ ":",
indentLine 4 (pretty a),
"else:",
indentLine 4 (pretty b)]
PFun fid params body ->
sepLines ["def " ++ pretty fid ++
prettyParens params ++ ":",
indentLine 4 (pretty body)]
data PExpr = PCondE PExpr
PExpr
PExpr
| PParen PExpr
| PCall PExpr
[PExpr]
| POperate POperator
PExpr
PExpr
| PVariable PIdentifier
| PInt Integer
| PFloat Double
| PBool Bool
| PString String
deriving (Eq, Show)
instance Pretty PExpr where
pretty pexpr =
case pexpr of
PCondE c a b ->
unwords [pretty a, "if", pretty c, "else", pretty b]
PParen e -> prettyParens [e]
PVariable vid -> pretty vid
PInt i -> show i
PFloat x -> show x
PBool b -> show b
PString s -> show s
PCall fexpr argExprs ->
concat [pretty fexpr, prettyParens argExprs]
POperate op left right ->
unwords [pretty left, pretty op, pretty right]
data PIdentifier = PIdentifier String
deriving (Eq, Show)
instance Pretty PIdentifier where
pretty (PIdentifier s) = s
data PParameter = PParameter PIdentifier
deriving (Eq, Show)
instance Pretty PParameter where
pretty (PParameter pident) = pretty pident
data POperator = POperator {opName :: String,
opPrec :: Precedence,
opAssoc :: Bool
}
deriving (Eq, Show)
instance Pretty POperator where
pretty (POperator s _ _) = s
type Precedence = Int
alterParens :: (PExpr -> PExpr) -> PStatement -> PStatement
alterParens t s =
case s of
PReturn e -> PReturn (t e)
PCondS c a b -> PCondS (t c) (alterParens t a) (alterParens t b)
PFun fid params b -> PFun fid params (alterParens t b)
_ -> s
atomic :: PExpr -> Bool
atomic pexpr =
case pexpr of
PVariable _ -> True
PInt _ -> True
PFloat _ -> True
PBool _ -> True
PString _ -> True
_ -> False
compound :: PExpr -> Bool
compound = not . atomic
ret :: PExpr -> PStatement
ret pexpr = PReturn pexpr
condS :: PExpr -> PExpr -> PExpr -> PStatement
condS c a b = PCondS c (ret a) (ret b)
condE :: PExpr -> PExpr -> PExpr -> PExpr
condE c a b = PCondE c a b
var :: String -> PExpr
var name = PVariable (PIdentifier name)
ident :: String -> PIdentifier
ident s = PIdentifier s
pInt :: Integer -> PExpr
pInt i = PInt i
pFloat :: Double -> PExpr
pFloat x = PFloat x
bool :: Bool -> PExpr
bool b = PBool b
char :: Char -> PExpr
char c = string [c]
string :: String -> PExpr
string s = PString s
paren :: PExpr -> PExpr
paren pexpr = PParen pexpr
noParens :: PExpr -> PExpr
noParens pexpr =
let t = noParens
in case pexpr of
PParen e -> t e
PCondE c a b -> PCondE (t c) (t a) (t b)
PCall fe aes -> PCall (t fe) (map t aes)
POperate op left right -> POperate op (t left) (t right)
_ -> pexpr
fullParens :: PExpr -> PExpr
fullParens pexpr =
let t = paren . fullParens
in case pexpr of
PCondE c a b -> PCondE (t c) (t a) (t b)
PCall fe aes -> PCall (t fe) (map t aes)
POperate op left right -> POperate op (t left) (t right)
_ -> pexpr
bestParens :: PExpr -> PExpr
bestParens = simplifyParens . fullParens
simplifyParens :: PExpr -> PExpr
simplifyParens pexpr =
let t = simplifyParens
ut = unpar . t
in case pexpr of
PParen e ->
if atomic e
then e
else case e of
PCall _ _ -> ut e
_ -> PParen (t e)
PCondE c a b -> PCondE (ut c) (ut a) (ut b)
PCall fe aes -> PCall (t fe) (map ut aes)
POperate op left right ->
sop (POperate op (t left) (t right))
_ -> pexpr
sop :: PExpr -> PExpr
sop = sopLeft . sopRight
sopLeft :: PExpr -> PExpr
sopLeft pexpr =
case pexpr of
POperate op1 (PParen (POperate op2 left2 right2)) right ->
if opPrec op2 > opPrec op1
then POperate op1 (POperate op2 left2 right2) right
else if opPrec op2 == opPrec op1
then POperate op1 (POperate op2 left2 right2) right
else pexpr
_ -> pexpr
sopRight :: PExpr -> PExpr
sopRight pexpr =
case pexpr of
POperate op1 left (PParen (POperate op2 left2 right2)) ->
if opPrec op2 > opPrec op1
then POperate op1 left (POperate op2 left2 right2)
else if op1 == op2 && opAssoc op1
then POperate op1 left (POperate op2 left2 right2)
else pexpr
_ -> pexpr
par :: PExpr -> PExpr
par e = PParen e
unpar :: PExpr -> PExpr
unpar pexpr =
case pexpr of
PParen e -> e
_ -> pexpr
exprPrec :: PExpr -> Precedence
exprPrec pexpr =
case pexpr of
POperate op _ _ -> opPrec op
_ -> (1)
call :: String -> [PExpr] -> PExpr
call fname argExprs = PCall (var fname) argExprs
param :: String -> PParameter
param name = PParameter (ident name)
fun :: String -> [String] -> PExpr -> PStatement
fun fname paramNames bodyExpr =
PFun (ident fname) (map param paramNames) (ret bodyExpr)
opTimes, opIDiv, opFDiv, opMod, opPlus, opMinus :: POperator
opTimes = POperator "*" 7 True
opIDiv = POperator "//" 7 False
opFDiv = POperator "/" 7 False
opMod = POperator "%" 7 False
opPlus = POperator "+" 6 True
opMinus = POperator "-" 6 False
opEq, opNe, opGt, opGe, opLt, opLe :: POperator
opEq = POperator "==" 4 False
opNe = POperator "!=" 4 False
opGt = POperator ">" 4 False
opGe = POperator ">=" 4 False
opLt = POperator "<" 4 False
opLe = POperator "<=" 4 False