module Sifflet.Foreign.ToPython
(
PythonOptions(..)
, defaultPythonOptions
, exprToPExpr
, valueToPExpr
, nameToPython
, fixIdentifierChars
, functionToPyDef
, defToPy
, functionsToPyModule
, functionsToPrettyPy
, exportPython
)
where
import Char (isAlpha, isDigit, ord)
import Control.Monad (unless)
import Sifflet.Foreign.Exporter
import Sifflet.Foreign.Python
import Sifflet.Language.Expr
import Sifflet.Text.Pretty
import System.Directory (copyFile, doesFileExist)
import System.FilePath (replaceFileName)
import Paths_sifflet_lib
data PythonOptions = PythonOptions
deriving (Eq, Show)
defaultPythonOptions :: PythonOptions
defaultPythonOptions = PythonOptions
exprToPExpr :: Expr -> PExpr
exprToPExpr expr =
case expr of
EUndefined -> var "undefined"
ESymbol (Symbol str) -> var str
ELit value -> valueToPExpr value
EIf cond action altAction ->
condE (exprToPExpr cond)
(exprToPExpr action)
(exprToPExpr altAction)
EList exprs ->
call "li" (map exprToPExpr exprs)
ECall (Symbol fname) args ->
case nameToPython fname of
Left operator ->
case args of
[left, right] ->
POperate operator
(exprToPExpr left)
(exprToPExpr right)
_ -> error "exprToPExpr: operation does not have 2 operands"
Right pname ->
call pname (map exprToPExpr args)
valueToPExpr :: Value -> PExpr
valueToPExpr value =
case value of
VList vs -> call "li" (map valueToPExpr vs)
VBool b -> bool b
VChar c -> char c
VInt i -> pInt i
VFloat x -> pFloat x
VStr s -> string s
VFun f -> var "undefined"
nameToPython :: String -> Either POperator String
nameToPython name =
case name of
"+" -> Left opPlus
"-" -> Left opMinus
"*" -> Left opTimes
"div" -> Left opIDiv
"mod" -> Left opMod
"/" -> Left opFDiv
"==" -> Left opEq
"/=" -> Left opNe
">" -> Left opGt
">=" -> Left opGe
"<" -> Left opLt
"<=" -> Left opLe
"add1" -> Right "add1"
"sub1" -> Right "sub1"
"zero?" -> Right "eqZero"
"positive?" -> Right "gtZero"
"negative?" -> Right "ltZero"
"null" -> Right "null"
"head" -> Right "head"
"tail" -> Right "tail"
":" -> Right "cons"
_ -> Right (fixIdentifierChars name)
fixIdentifierChars :: String -> String
fixIdentifierChars =
let fix s =
case s of
[] -> []
c:cs ->
if isAlpha c || isDigit c || c == '_'
then c : fix cs
else case c of
'?' -> "_QUESTION_" ++ fix cs
_ -> "_CHR" ++ show (ord c) ++ "_" ++ fix cs
in fix
functionToPyDef :: Function -> PStatement
functionToPyDef = defToPy . functionToDef
defToPy :: FunctionDefTuple -> PStatement
defToPy (fname, paramNames, _, _, body) =
fun (fixIdentifierChars fname) paramNames (exprToPExpr body)
functionsToPyModule :: Functions -> PModule
functionsToPyModule (Functions fs) = PModule (map functionToPyDef fs)
functionsToPrettyPy :: Functions -> String
functionsToPrettyPy = pretty . functionsToPyModule
exportPython :: PythonOptions -> Exporter
exportPython _options funcs path =
let header = "# File: " ++ path ++
"\n# Generated by the Sifflet->Python exporter.\n\n" ++
"from sifflet import *\n\n"
libDest = replaceFileName path "sifflet.py"
in do
{
libDestExists <- doesFileExist libDest
; unless libDestExists
(do
{
libSrc <- pythonLibSiffletPath
; copyFile libSrc libDest
}
)
; writeFile path (header ++ (functionsToPrettyPy funcs))
}
pythonLibSiffletPath :: IO FilePath
pythonLibSiffletPath = getDataFileName "sifflet.py"