Permalink
Browse files

LLVM JIT working

  • Loading branch information...
1 parent 002e22b commit 6062f8e61f0f5440f2aae4de0ed0d269bcae50e2 @janm399 janm399 committed Jan 29, 2014
View
44 core/main/Custom/Emit.hs
@@ -5,6 +5,11 @@ module Custom.Emit where
import LLVM.General.Module
import LLVM.General.Context
+import LLVM.General.Target
+import LLVM.General.ExecutionEngine
+import Foreign.Ptr
+import Foreign.C.Types
+
import qualified LLVM.General.AST as AST
import qualified LLVM.General.AST.Constant as C
import qualified LLVM.General.AST.Float as F
@@ -41,7 +46,7 @@ codegenTop (S.Extern name args) = do
where fnargs = toSig args
codegenTop exp = do
- define double "main" [] blks
+ define double "start" [] blks
where
blks = createBlocks $ execCodegen $ do
entry <- addBlock entryBlockName
@@ -93,11 +98,44 @@ cgen (S.Call fn args) = do
liftError :: ErrorT String IO a -> IO a
liftError = runErrorT >=> either fail return
+type StartFunction = IO Double
+foreign import ccall "dynamic"
+ haskFun :: FunPtr StartFunction -> StartFunction
+
+run :: FunPtr a -> IO Double
+run fn = haskFun (castFunPtr fn :: FunPtr (IO Double))
+
+jit :: Context -> (MCJIT -> IO a) -> IO a
+jit c = withMCJIT c optlevel model ptrelim fastins
+ where
+ optlevel = Just 2 -- optimization level
+ model = Nothing -- code model ( Default )
+ ptrelim = Nothing -- frame pointer elimination
+ fastins = Nothing -- fast instruction selection
+
codegen :: AST.Module -> [S.Expr] -> IO AST.Module
codegen mod fns = withContext $ \context ->
liftError $ withModuleFromAST context newast $ \m -> do
- llstr <- moduleString m
- putStrLn llstr
+ liftError $ withDefaultTargetMachine $ \target -> do
+ liftError $ writeAssemblyToFile target "/Users/janmachacek/foo.S" m
+ liftError $ writeObjectToFile target "/Users/janmachacek/foo.o" m
+ llstr <- moduleString m
+ putStrLn llstr
+
+ jit context $ \executionEngine -> do
+ withModuleInEngine executionEngine m $ \em -> do
+ maybeFun <- getFunction em (AST.Name "main")
+ case maybeFun of
+ Just fun -> do
+ val <- run fun
+ putStrLn $ "******** :) " ++ (show val)
+ Nothing ->
+ putStrLn ":("
+
+ return ()
+
+ --withDefaultTargetMachine $ \machine -> moduleAssembly machine m
+ --astr <- moduleAssembly
return newast
where
modn = mapM codegenTop fns
View
4 core/main/Custom/Generator.hs
@@ -6,7 +6,7 @@ import Custom.Emit
import Custom.Syntax
import GeneratorSupport
-mkGenerator :: [Expr] -> GeneratorFunction Int b
+mkGenerator :: [Expr] -> GeneratorCallback a -> IO a
mkGenerator expr f = do
- _ <- codegen (emptyModule "jit") expr
+ mod <- codegen (emptyModule "jit") expr
f []
View
26 core/main/Generator.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
-module Generator(generator, permgenGenerator, newPermgen, Generator(..), GeneratorDelay, Permgen, GeneratorValue) where
+module Generator(generator, permgenGenerator, newPermgen, Generator(..), GeneratorDelay, Permgen) where
import Syntax
import GeneratorSupport
@@ -16,22 +16,20 @@ import qualified Custom.Generator as CG
import qualified Data.Map as M
-type GeneratorValue = Int
-
-- |Permgen space holding the prepared generators given the generating expression
-type Permgen a b = M.Map Distribution (GeneratorFunction a b)
+type Permgen a = M.Map Distribution (IO a)
-- |Generator is a type that performs a step of the generation process
-newtype Generator a b = Generator {
+newtype Generator b = Generator {
-- |Performs the generator step
runGenerator :: GeneratorDelay -- ^The delaying function. You can pass in @threadDelay@, for example.
- -> ([a] -> IO b) -- ^The operation to execute in every step
+ -> ([Int] -> IO b) -- ^The operation to execute in every step
-> IO b -- ^The final result
}
-- |Perpares new permgen space for the caching generator
-newPermgen :: Permgen GeneratorValue a
+newPermgen :: Permgen a
newPermgen = M.empty
-- |Prepares a generator by parsing the input string. It returns a generator that
@@ -44,29 +42,33 @@ newPermgen = M.empty
-- Right gen -> runGenerator gen threadDelay (\nums -> ...) -- good user, have numbers
-- @
generator :: String -- ^The expression to parse
- -> Either ParseError (Generator GeneratorValue a) -- ^The result with errors or the ready Generator
+ -> Either ParseError (Generator a) -- ^The result with errors or the ready Generator
generator input = permgenGenerator newPermgen input >>= return . snd
-- |Prepares a generator by looking up existing generator in @permgen@; if not found, it proceeds to parse the
-- input string and attempting to build a new generator. It returns a new permgen and a generator that
-- you can use to get the values.
-permgenGenerator :: Permgen GeneratorValue a
+permgenGenerator :: Permgen a
-> String
- -> Either ParseError (Permgen GeneratorValue a, Generator GeneratorValue a)
+ -> Either ParseError (Permgen a, Generator a)
permgenGenerator permgen input = do
(Expression exp rep del) <- P.parseExpression input
+ gen <- newGenerator exp
+ {--
case M.lookup exp permgen of
Just genF -> return $ (permgen, buildGenerator genF rep del)
Nothing -> do { gen <- newGenerator exp
; let permgen' = M.insert exp gen permgen
; return $ (permgen', buildGenerator gen rep del)
}
+ --}
+ return $ (permgen, buildGenerator gen rep del)
where
- newGenerator :: Distribution -> Either ParseError (GeneratorFunction GeneratorValue b)
+ newGenerator :: Distribution -> Either ParseError (GeneratorCallback a -> IO a)
newGenerator (Standard body) = SG.mkGenerator <$> SP.parseToplevel body
newGenerator (Custom body) = CG.mkGenerator <$> CP.parseToplevel body
- buildGenerator :: (GeneratorFunction GeneratorValue b) -> Repetition -> Delay -> Generator GeneratorValue b
+ buildGenerator :: (GeneratorCallback a -> IO a) -> Repetition -> Delay -> Generator a
buildGenerator gen rep del = Generator { runGenerator = \sleep -> \f ->
case rep of
Forever -> forever (delayed del sleep (gen f))
View
6 core/main/GeneratorSupport.hs
@@ -1,4 +1,4 @@
-module GeneratorSupport(fromRange, GeneratorDelay, GeneratorFunction) where
+module GeneratorSupport(fromRange, GeneratorDelay, GeneratorCallback) where
import Syntax
import System.Random (randomIO)
@@ -8,8 +8,8 @@ import Control.Applicative ((<$>))
-- A suitable value is @threadDelay@
type GeneratorDelay = Int -> IO ()
--- |Function that can be applied to some callback to generate the values
-type GeneratorFunction a b = (([a] -> IO b) -> IO b)
+-- |Function that can be passed to the generator that is called in every step
+type GeneratorCallback a = [Int] -> IO a
-- |Picks one random value from the given range
fromRange :: Range -> IO Int
View
2 core/main/Standard/Generator.hs
@@ -5,7 +5,7 @@ import Control.Monad (replicateM)
import Standard.Syntax
import GeneratorSupport
-mkGenerator :: Expr -> GeneratorFunction Int b
+mkGenerator :: Expr -> GeneratorCallback a -> IO a
mkGenerator (EvenDistr countRange valueRange) !f = do
count <- fromRange countRange
values <- replicateM count (fromRange valueRange)
View
4 core/test/Custom/GeneratorSpec.hs
@@ -9,7 +9,7 @@ spec :: Spec
spec = do
describe "Do expression" $ do
it "Generates fixed count of ranges" $ do
- generate' "do { def foo(a b) a * b; foo(1, 1); } once" `shouldReturn` [1]
+ generate' "do { def foo(a b) a * b + 3; def main() foo(1, 2); foo(1, 2); } once" `shouldReturn` [1]
describe "Permgen generator" $ do
it "Makes use of the permgen space" $ do
@@ -18,4 +18,4 @@ spec = do
(permgen2, values2) <- permgenGenerate' permgen1 expr
(M.keys permgen1) `shouldBe` (M.keys permgen2)
- values1 `shouldBe` values2
+ values1 `shouldBe` values2
View
4 core/test/GeneratorSpecSupport.hs
@@ -8,12 +8,12 @@ error' expr =
let Left err = generator expr
in show err
-generate' :: String -> IO [GeneratorValue]
+generate' :: String -> IO [Int]
generate' expr =
let Right f = runGenerator <$> generator expr
in f (const $ return ()) return
-permgenGenerate' :: Permgen GeneratorValue [GeneratorValue] -> String -> IO (Permgen GeneratorValue [GeneratorValue], [GeneratorValue])
+permgenGenerate' :: Permgen [Int] -> String -> IO (Permgen [Int], [Int])
permgenGenerate' permgen expr =
let Right (permgen', gen) = permgenGenerator permgen expr
in (runGenerator gen (const $ return ()) return) >>= (\nums -> return (permgen', nums))
View
2 ws/main/Main.hs
@@ -53,7 +53,7 @@ application state pending = do
-- |Performs the query on behalf of the client, cleaning up after itself when the client disconnects
perform :: MVar ServerState -- ^ The server state
-> Client -- ^ The client tuple (the query to perform and the connection for the responses)
- -> Generator Int () -- ^ The value generator
+ -> Generator () -- ^ The value generator
-> IO () -- ^ The output
perform state client@(query, conn) gen = handle catchDisconnect $ do
runGenerator gen threadDelay (\numbers -> WS.sendTextData conn (T.pack $ show numbers))

0 comments on commit 6062f8e

Please sign in to comment.