Permalink
Browse files

Merge pull request #14 from janm399/master

Permgen. Ready for [].
  • Loading branch information...
2 parents e64e92a + c273fef commit 81f283a33cae891c1a27cde79e71f3c16d6037d6 @janm399 janm399 committed Jan 31, 2014
Showing with 22 additions and 68 deletions.
  1. +11 −16 core/main/Custom/Emit.hs
  2. +10 −35 core/main/Generator.hs
  3. +0 −11 core/test/Custom/GeneratorSpec.hs
  4. +1 −6 core/test/GeneratorSpecSupport.hs
View
@@ -97,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
@@ -114,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
- withDefaultTargetMachine $ \target -> do
- writeAssemblyToFile target "/Users/janmachacek/foo.S" m
- writeObjectToFile target "/Users/janmachacek/foo.o" m
- llstr <- moduleString m
- putStrLn llstr
- return newast
- --}
where
modn = mapM codegenTop fns
newast = runLLVM mod modn
@@ -135,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,33 +34,17 @@ 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 <- 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)
+ gen <- newGeneratorCore exp
+ return $ newGenerator gen rep del
where
- newGenerator :: Distribution -> Either ParseError (GeneratorCallback a -> IO a)
- newGenerator (Standard body) = SG.mkGenerator <$> SP.parseToplevel body
- newGenerator (Custom body) = CG.mkGenerator <$> CP.parseToplevel body
+ newGeneratorCore :: Distribution -> Either ParseError (GeneratorCallback a -> IO a)
+ newGeneratorCore (Standard body) = SG.mkGenerator <$> SP.parseToplevel body
+ newGeneratorCore (Custom body) = CG.mkGenerator <$> CP.parseToplevel body
- buildGenerator :: (GeneratorCallback a -> IO a) -> Repetition -> Delay -> Generator a
- buildGenerator gen rep del = Generator { runGenerator = \sleep -> \f ->
+ newGenerator :: (GeneratorCallback a -> IO a) -> Repetition -> Delay -> Generator a
+ newGenerator gen rep del = Generator { runGenerator = \sleep -> \f ->
case rep of
Forever -> forever (delayed del sleep (gen f))
Times r -> do { t <- fromRange r; times t (delayed del sleep (gen f)) }
@@ -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 81f283a

Please sign in to comment.