Created
August 21, 2018 09:02
-
-
Save Tritlo/1b4c49161d3edd4b7842b12c6b386a18 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE GADTs #-} | |
import Data.List | |
import Data.Monoid | |
import Data.Typeable | |
import Data.Dynamic | |
import GHC.Err | |
import GHC.Prim | |
data PyVal = PyVal { valTy :: TypeRep, val :: String } | ErrorMsg String | |
data PyStatement where | |
Import :: String -> PyStatement | |
RawStmtm :: String -> PyStatement | |
RawVal :: PyVal -> PyStatement | |
renderPyStatement :: PyStatement -> String | |
renderPyStatement (Import a) = "import " <> a | |
renderPyStatement (RawStmtm a) = a | |
renderPyStatement (RawVal (PyVal _ s)) = s | |
renderPyStatement (RawVal (ErrorMsg msg)) = error msg | |
-- ToDo: Ensure imports are Import | |
data PyLib = PyLib { imports :: [PyStatement] | |
, functions :: [PyFunction] } | |
data PyFunction = LocalFunction { arguments :: [String] | |
, name :: String | |
, funTy :: TypeRep | |
, statements :: [PyStatement] } | |
| ImportedFunction { name :: String | |
, funTy :: TypeRep } | |
f :: PyFunction | |
f = LocalFunction { arguments = ["a", "b", "c"] | |
, name = "f" | |
, funTy = typeRep (Proxy :: Proxy (Int -> Int -> Int -> Int)) | |
, statements = [RawStmtm "return (a + b + c)"] } | |
-- From stdlib | |
pyPrint :: PyFunction | |
pyPrint = ImportedFunction { name = "print" | |
, funTy = typeRep (Proxy :: Proxy (Dynamic -> ()))} | |
-- For now, only things that have the same representation in | |
-- Haskell and in Python (e.g. Integers) | |
toPyVal :: (Typeable a, Show a) => a -> PyVal | |
toPyVal a = PyVal { valTy = typeOf a, val = show a } | |
funToVal :: PyFunction -> PyVal | |
funToVal f = PyVal { valTy = funTy f, val = name f} | |
py1 :: PyVal | |
py1 = toPyVal (1 :: Int) | |
py2 :: PyVal | |
py2 = toPyVal (2 :: Int) | |
py3 :: PyVal | |
py3 = toPyVal (3 :: Int) | |
fVal :: PyVal | |
fVal = funToVal f | |
printVal = funToVal pyPrint | |
showTyR :: TypeRep -> String | |
showTyR t = showsTypeRep t "" | |
arity :: TypeRep -> Int | |
arity rep = case (splitTyConApp rep) of | |
(tc, [arg, result]) | tc == funcTyCon -> 1 + (arity result) | |
_ -> 0 | |
where funcTyCon = typeRepTyCon $ typeRep (Proxy :: Proxy (Int -> Int)) | |
applyPyVal :: PyVal -> PyVal -> PyVal | |
applyPyVal _ (ErrorMsg emsg) = ErrorMsg emsg | |
applyPyVal (ErrorMsg emsg) _ = ErrorMsg emsg | |
applyPyVal (PyVal {valTy = ft, val = nm }) (PyVal {valTy = vt, val = v }) | |
= case (funResultTy ft vt) of | |
Just rt -> newVal rt | |
Nothing -> case typeRepArgs ft of | |
[tr, rt] | typeRepTyCon tr == tyConOfDynamic -> newVal rt | |
_ -> ErrorMsg ( "cannot apply function " <> nm <> " of type " | |
<> (showTyR ft) <> " to " <> v <> " of type " | |
<> showTyR vt ) | |
where newVal rt = PyVal { valTy = rt | |
, val = case arity rt of | |
0 -> appl | |
_ -> "partial(" <> nm <> "," <> v <> ")"} | |
appl = nm <> "(" <> v <> ")" | |
tyConOfDynamic = typeRepTyCon $ typeRep (Proxy :: Proxy Dynamic) | |
renderPyFunc :: PyFunction -> String | |
renderPyFunc (LocalFunction {name = nm, arguments = args, statements = stmts, funTy = ty }) | |
= unlines $ [ "" | |
, "# " <> show ty <> " of arity " <> show (arity ty) | |
, "def " <> nm <> "(" <> (intercalate "," args) <> ")" <> ":" | |
, unlines $ map ((<>) " " . renderPyStatement) stmts] | |
myProg :: PyLib | |
myProg = PyLib { imports = map Import [ "datetime", "math", "random" ] | |
, functions = [f] } | |
genPyLib :: PyLib -> String | |
genPyLib (PyLib { imports = imp, functions = functions }) = | |
concat [ renderPyStatement $ RawStmtm "from functools import partial\n" | |
, unlines $ map renderPyStatement imp | |
, unlines $ map renderPyFunc functions] | |
main :: IO () | |
main = do putStrLn $ genPyLib myProg | |
putStrLn $ renderPyStatement $ | |
RawVal $ applyPyVal printVal | |
$ applyPyVal (applyPyVal (applyPyVal fVal py1) py2) py3 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment