ToPython.hs

-- | Sifflet to abstract syntax tree for Python.
-- Use Python module's pretty to pretty-print the result.

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        -- Cabal-generated paths module

-- | Options for Python export.
-- Should probably include choices like Python2 or Python3;
-- if statement or if expression.  Right now, just a placeholder.

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 ->
          -- 2 choices here: Python if statement (condS)
          -- or Python if expression (condE)
          condE (exprToPExpr cond) 
                (exprToPExpr action)
                (exprToPExpr altAction)
      EList exprs -> 
          call "li" (map exprToPExpr exprs)
      ECall (Symbol fname) args -> 
          -- Python distinguishes between functions and operators
          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" -- fix!  Is it fixable? ***
          -- Scheme: SFunction f

-- | Convert Sifflet name (of a function) to Python name
nameToPython :: String -> Either POperator String
nameToPython name =
    case name of 
      "+" -> Left opPlus
      "-" -> Left opMinus
      "*" -> Left opTimes
      "div" -> Left opIDiv
      "mod" -> Left opMod
      "/" -> Left opFDiv -- invalid for integers in Python 2!
      "==" -> 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)

-- | Remove characters that are not valid in a Python identifier,
-- and in some cases, insert other characters to show what's missing

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
                         -- other cases can be inserted here
                         _ -> "_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
                 -- copy sifflet.py to the same directory as path
                 {
                   libSrc <- pythonLibSiffletPath 
                 ; copyFile libSrc libDest
                 }
               )
      ; writeFile path (header ++ (functionsToPrettyPy funcs))
      }

pythonLibSiffletPath :: IO FilePath
pythonLibSiffletPath = getDataFileName "sifflet.py"