Permalink
Browse files

Permgen done

  • Loading branch information...
janm399 committed Jan 31, 2014
1 parent 5197f05 commit c273fef3e50b0b30564e8ece62ace9f740a51219
Showing with 16 additions and 63 deletions.
  1. +11 −17 core/main/Custom/Emit.hs
  2. +4 −29 core/main/Generator.hs
  3. +0 −11 core/test/Custom/GeneratorSpec.hs
  4. +1 −6 core/test/GeneratorSpecSupport.hs
View
@@ -4,7 +4,6 @@ module Custom.Emit(codegen, run) where
import LLVM.General.Module
import LLVM.General.Context
-import LLVM.General.Target
import LLVM.General.ExecutionEngine
import Foreign.Ptr
@@ -98,12 +97,17 @@ cgen (S.Function _ _ _) = fail "Must not generate Function"
liftError :: ErrorT String IO a -> IO a
liftError = runErrorT >=> either fail return
-type MainFunction = IO Int64
-foreign import ccall unsafe "dynamic"
- jitFun :: FunPtr MainFunction -> MainFunction
+type MainFunctionS = IO Int64
+type MainFunctionM = IO (Ptr Int64)
-runJitFun :: FunPtr a -> MainFunction
-runJitFun fn = jitFun (castFunPtr fn :: FunPtr MainFunction)
+foreign import ccall unsafe "dynamic" singleJitFun :: FunPtr MainFunctionS -> MainFunctionS
+foreign import ccall unsafe "dynamic" multipleJitFun :: FunPtr MainFunctionM -> MainFunctionM
+
+runSingleJitFun :: FunPtr a -> MainFunctionS
+runSingleJitFun fn = singleJitFun (castFunPtr fn :: FunPtr MainFunctionS)
+
+runMultipleJitFun :: FunPtr a -> MainFunctionM
+runMultipleJitFun fn = multipleJitFun (castFunPtr fn :: FunPtr MainFunctionM)
jit :: Context -> (MCJIT -> IO a) -> IO a
jit c = withMCJIT c optlevel model ptrelim fastins
@@ -115,16 +119,6 @@ jit c = withMCJIT c optlevel model ptrelim fastins
codegen :: AST.Module -> [S.Expr] -> IO AST.Module
codegen mod fns = return newast
- {--
- withContext $ \context ->
- liftError $ withModuleFromAST context newast $ \m -> do
- 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
- return newast
- --}
where
modn = mapM codegenTop fns
newast = runLLVM mod modn
@@ -136,5 +130,5 @@ run mod = withContext $ \context ->
withModuleInEngine executionEngine m $ \em -> do
maybeFun <- getFunction em (AST.Name mainName)
case maybeFun of
- Just fun -> runJitFun fun
+ Just fun -> runSingleJitFun fun
Nothing -> return 0
View
@@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
-module Generator(generator, permgenGenerator, newPermgen, Generator(..), GeneratorDelay, Permgen) where
+module Generator(generator, Generator(..), GeneratorDelay) where
import Syntax
import GeneratorSupport
@@ -14,11 +14,6 @@ import qualified Custom.Parser as CP
import qualified Standard.Generator as SG
import qualified Custom.Generator as CG
-import qualified Data.Map as M
-
--- |Permgen space holding the prepared generators given the generating expression
-type Permgen a = M.Map Distribution (IO a)
-
-- |Generator is a type that performs a step of the generation process
newtype Generator b = Generator {
@@ -28,10 +23,6 @@ newtype Generator b = Generator {
-> IO b -- ^The final result
}
--- |Perpares new permgen space for the caching generator
-newPermgen :: Permgen a
-newPermgen = M.empty
-
-- |Prepares a generator by parsing the input string. It returns a generator that
-- you can use to get the values.
--
@@ -43,26 +34,10 @@ newPermgen = M.empty
-- @
generator :: String -- ^The expression to parse
-> 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 a
- -> String
- -> Either ParseError (Permgen a, Generator a)
-permgenGenerator permgen input = do
+generator input = do
(Expression exp rep del) <- P.parseExpression input
gen <- newGeneratorCore 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, newGenerator gen rep del)
+ return $ newGenerator gen rep del
where
newGeneratorCore :: Distribution -> Either ParseError (GeneratorCallback a -> IO a)
newGeneratorCore (Standard body) = SG.mkGenerator <$> SP.parseToplevel body
@@ -83,4 +58,4 @@ permgenGenerator permgen input = do
delayed (Fixed delayRange) sleep !m = do
delay <- fromRange delayRange
sleep delay
- m
+ m
@@ -2,20 +2,9 @@ module Custom.GeneratorSpec(spec) where
import Test.Hspec
import GeneratorSpecSupport
-import Generator (newPermgen)
-import qualified Data.Map as M
spec :: Spec
spec = do
describe "Do expression" $ do
it "Generates fixed count of ranges" $ do
generate' "do { def foo(a b) a * b + 3; foo(1, 2); } once" `shouldReturn` [5]
-
- describe "Permgen generator" $ do
- it "Makes use of the permgen space" $ do
- let expr = "do { def foo(a b) a * b; foo(1, 1); } once"
- (permgen1, values1) <- permgenGenerate' newPermgen expr
- (permgen2, values2) <- permgenGenerate' permgen1 expr
-
- (M.keys permgen1) `shouldBe` (M.keys permgen2)
- values1 `shouldBe` values2
@@ -1,4 +1,4 @@
-module GeneratorSpecSupport(generate', permgenGenerate', error', avg) where
+module GeneratorSpecSupport(generate', error', avg) where
import Generator
import Control.Applicative ((<$>))
@@ -13,10 +13,5 @@ generate' expr =
let Right f = runGenerator <$> generator expr
in f (const $ return ()) return
-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))
-
avg :: [Int] -> Int
avg xs = sum xs `div` length xs

0 comments on commit c273fef

Please sign in to comment.