JIT, extern , evaluation completed

Author: vijayphoenix

package.yaml

@@ -2,9 +2,9 @@ name:                Haskull
 version:             0.1.0.0
 github:              "https://github.com/IITH-SBJoshi/haskell-11"
 license:             BSD3
-author:              "Anjani Kumar"
-maintainer:          "cs17btech11002@iith.ac.in"
-copyright:           "2019 Anjani Kumar"
+author:              "Vijay"
+maintainer:          "cs17btech11040@iith.ac.in"
+copyright:           "2019 Vijay"
 
 extra-source-files:
 - README.md

src/AST.hs

@@ -80,6 +80,7 @@ data Op
     | Minus
     | Mul 
     | Divide
+    | Null
     deriving (Show, Ord, Eq)
 
 data Type 

src/CodeGen.hs

@@ -20,6 +20,7 @@ module CodeGen (
   getvar,
   assign,
   createBlocks,
+  external,
   Codegen(..),
   CodegenState(..),
   BlockState(..),
@@ -84,6 +85,11 @@ define retty label argtys body = addDef $
   , basicBlocks = body
   }
 
+
+-- | Defines a function here the return type is Type 
+external ::  ASTL.Type -> String -> [(ASTL.Type, ASTL.Name)] -> LLVM ()
+external retty label argtys = define retty label argtys []
+
 addDef :: ASTL.Definition -> LLVM ()
 addDef def = do 
     prev <- gets ASTL.moduleDefinitions

src/Emit.hs

@@ -16,11 +16,10 @@ module Emit (
     varDeclGen,
     literalGen,
     moduleGen,
+    codegenTop',
     call,
     toArgs,
 
-    x',
-    y',
     funcCallGen,
 
 )where 
@@ -46,7 +45,7 @@ import qualified LLVM.AST.Attribute as A
 
 import Control.Monad.State
 import Control.Applicative
-
+import JIT
 -- | Parser ASTL to LLVM code
 
 
@@ -77,16 +76,16 @@ binops = Map.fromList [
 
 -- Arithmetic and Constants
 fadd :: ASTL.Operand -> ASTL.Operand -> Codegen ASTL.Operand
-fadd a b = instr $ FAdd NoFastMathFlags a b []
+fadd a b = instr $ ASTL.Add False False a b []
 
 fsub :: ASTL.Operand -> ASTL.Operand -> Codegen ASTL.Operand
-fsub a b = instr $ FSub NoFastMathFlags a b []
+fsub a b = instr $ ASTL.Sub False False a b []
 
 fmul :: ASTL.Operand -> ASTL.Operand -> Codegen ASTL.Operand
-fmul a b = instr $ FMul NoFastMathFlags a b []
+fmul a b = instr $ ASTL.Mul False False a b []
 
 fdiv :: ASTL.Operand -> ASTL.Operand -> Codegen ASTL.Operand
-fdiv a b = instr $ FDiv NoFastMathFlags a b []
+fdiv a b = instr $ ASTL.UDiv False a b []
 
 externf :: ASTL.Name -> ASTL.Operand
 externf = ConstantOperand . C.GlobalReference intL
@@ -101,42 +100,50 @@ toArgs :: [ASTL.Operand] -> [(ASTL.Operand, [A.ParameterAttribute])]
 toArgs = map (\x -> (x, []))
 
 
+liftError :: ExceptT String IO a -> IO a
+liftError = runExceptT >=> either fail return
 
 
-y' :: Traversable t => t Func -> LLVM (t ())
-y' fns = mapM codegenTop fns
-
-x' :: ASTL.Module -> LLVM a -> ASTL.Module
-x' mod modn = runLLVM mod modn
-
+-- | Actions associated with each branch of ASTL
+-- | Used to refer to a variable
 
 
 -- withContext == Create a Context, run an action (to which it is provided), then destroy the Context.
+-- codegen :: ASTL.Module -> [ASTp.Func] -> IO ASTL.Module
+-- codegen mod fns = withContext $ \context -> -- fns  = [(Function "foo " ["a", "b"] (Float 1.0)) ]
+--   liftError $ withModuleFromAST context newast $ \m -> do
+--     llstr <- moduleLLVMAssembly m
+--     putStrLn llstr
+--     return newast
+--   where
+--     modn    = mapM codegenTop fns  -- list of LLVM ()
+--     newast  = runLLVM mod modn  
+
 codegen :: ASTL.Module -> [ASTp.Func] -> IO ASTL.Module
-codegen mod fns = withContext $ \context -> -- fns  = [(Function "foo " ["a", "b"] (Float 1.0)) ]
+codegen mod fns = do
+  res <- runJIT oldast
+  case res  of
+    Right newast -> return newast
+    Left err     -> putStrLn err >> return oldast
+  where
+    modn    = mapM codegenTop fns
+    oldast  = runLLVM mod modn
+
+codegen' :: ASTL.Module -> [ASTp.Declaration] -> IO ASTL.Module
+codegen' mod decl = withContext $ \context ->
   liftError $ withModuleFromAST context newast $ \m -> do
     llstr <- moduleLLVMAssembly m
     putStrLn llstr
     return newast
   where
-    modn    = mapM codegenTop fns  -- list of LLVM ()
+    modn    = mapM codegenTop' decl  -- list of LLVM ()
     newast  = runLLVM mod modn  
 
 
-
-
-
-
-liftError :: ExceptT String IO a -> IO a
-liftError = runExceptT >=> either fail return
-
-
-
--- funcGen :: ASTp.Func -> LLVM ()
--- funcGen x = addDef $ getDef x
-
--- declarationGen :: ASTp.Declaration -> LLVM ()
--- declarationGen c@(ASTp.ExternDecl _ _ _) = addDef $ getExtern c
+codegenTop' :: ASTp.Declaration -> LLVM ()
+codegenTop' (ASTp.ExternDecl name fnargs retT) = do
+  external intL name args
+  where args = getArgList fnargs
 
 
 
@@ -146,6 +153,9 @@ liftError = runExceptT >=> either fail return
 
 -- | Parser Module to LLVM Module
 moduleGen :: ASTL.Module -> ASTp.Module -> IO ASTL.Module
+moduleGen modL (ASTp.Command (DeclarationStmt c@(ExternDecl _ _ _))) =
+  codegen' modL [c]
+
 moduleGen modL (ASTp.Method func) = codegen modL [func]
 moduleGen modL (ASTp.Command expr) = codegen modL [rest] 
     where rest = ASTp.Func {

src/JIT.hs

@@ -0,0 +1,58 @@
+module JIT where
+
+import Data.Int
+import Data.Word
+import Foreign.Ptr ( FunPtr, castFunPtr )
+
+import Control.Monad.Except
+
+import LLVM.Target
+import LLVM.Context
+import LLVM.CodeModel
+import LLVM.Module as Mod
+import qualified LLVM.AST as AST
+
+import LLVM.PassManager
+import LLVM.Transforms
+import LLVM.Analysis
+
+import qualified LLVM.ExecutionEngine as EE
+
+foreign import ccall "dynamic" haskFun :: FunPtr (IO Int) -> (IO Int)
+
+run :: FunPtr a -> IO Int
+run fn = haskFun (castFunPtr fn :: FunPtr (IO Int))
+
+jit :: Context -> (EE.MCJIT -> IO a) -> IO a
+jit c = EE.withMCJIT c optlevel model ptrelim fastins
+  where
+    optlevel = Just 0  -- optimization level
+    model    = Nothing -- code model ( Default )
+    ptrelim  = Nothing -- frame pointer elimination
+    fastins  = Nothing -- fast instruction selection
+
+passes :: PassSetSpec
+passes = defaultCuratedPassSetSpec { optLevel = Just 3 }
+
+runJIT :: AST.Module -> IO (Either String AST.Module)
+runJIT mod = do
+  withContext $ \context ->
+    jit context $ \executionEngine ->
+      runExceptT $ withModuleFromAST context mod $ \m ->
+        withPassManager passes $ \pm -> do
+          -- Optimization Pass
+          runPassManager pm m
+          optmod <- moduleAST m
+          s <- moduleLLVMAssembly m
+          putStrLn s
+
+          EE.withModuleInEngine executionEngine m $ \ee -> do
+            mainfn <- EE.getFunction ee (AST.Name "main")
+            case mainfn of
+              Just fn -> do
+                res <- run fn
+                putStrLn $ "Evaluated to: " ++ show res
+              Nothing -> return ()
+
+          -- Return the optimized module
+          return optmod

src/Parser.hs

@@ -1,6 +1,5 @@
 module Parser (
     moduleParser,
-    z',
     funcParser
 )where 
 
@@ -13,9 +12,6 @@ import qualified Text.Parsec.Token as Tok
 import qualified Data.Map as Map 
 import AST 
 
-z' = [Func {fname = "x", argList = [(IntC,"p")], retType = IntC, body = [ DeclarationStmt (VarDecl {vType = IntC, vName = ["y"]}) ]}]
-
-
 moduleParser :: Parser Module 
 moduleParser = spaces >> ( try methodParser
            <|> commandParser )
@@ -49,8 +45,7 @@ funcParser = do
 
 
 exprParser :: Parser Expr
-exprParser = try binOpCallStmtParser
-           <|> try factor
+exprParser = try primary
            <|> declarationStmtParser
 
 variableParser :: Parser Expr
@@ -168,11 +163,24 @@ funcCallParser = do
     (spaces >> (char ')') >> spaces)
     return $ FuncCall callee args
 
+
 binOpCallStmtParser :: Parser Expr 
 binOpCallStmtParser = do
     res <- binOpCallParser
     return $ BinOpCallStmt res
 
+primary :: Parser Expr 
+primary = do
+    res <- factor
+    spaces 
+    lop <- try (lookAhead opParser) <|> return Null
+    if lop == Null 
+        then return res
+    else do 
+        lhs <- try (func res) <|> (return res)
+        return lhs
+
+
 binOpCallParser :: Parser BinOpCall
 binOpCallParser = do 
     temp <- factor