Skip to content
Browse files

.

  • Loading branch information...
1 parent 0a7abcf commit dd1623b7c39677f2a08e13ec2b9b99efffc5010c @janm399 janm399 committed
View
3 core/main/Custom/Generator.hs
@@ -4,8 +4,9 @@ import Prelude hiding (lookup)
import Custom.Codegen
import Custom.Emit
import Custom.Syntax
+import GeneratorSupport
-mkGenerator :: [Expr] -> ([Int] -> IO b) -> IO b
+mkGenerator :: [Expr] -> GeneratorFunction Int b
mkGenerator expr f = do
_ <- codegen (emptyModule "jit") expr
f []
View
75 core/main/Generator.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
-module Generator(generator, Generator(..), GeneratorDelay) where
+module Generator(generator, permgenGenerator, newPermgen, Generator(..), GeneratorDelay, Permgen, GeneratorValue) where
import Syntax
import GeneratorSupport
@@ -16,24 +16,26 @@ 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 (Generator a b)
+type Permgen a b = M.Map Distribution (GeneratorFunction a b)
-- |Generator is a type that performs a step of the generation process
newtype Generator a 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
- -> IO b -- ^The final result
+ runGenerator :: GeneratorDelay -- ^The delaying function. You can pass in @threadDelay@, for example.
+ -> ([a] -> IO b) -- ^The operation to execute in every step
+ -> IO b -- ^The final result
}
-- |Perpares new permgen space for the caching generator
-newPermgen :: State Distribution (Permgen a b)
-newPermgen = return M.empty
+newPermgen :: Permgen GeneratorValue a
+newPermgen = M.empty
--- |Prepares a generator by parsing the input string. It returns a value that
--- you can use to get the generated values.
+-- |Prepares a generator by parsing the input string. It returns a generator that
+-- you can use to get the values.
--
-- Typically, you'd have code similar to
-- @
@@ -41,27 +43,42 @@ newPermgen = return M.empty
-- Left err -> ... -- what do you want, a cookie?
-- Right gen -> runGenerator gen threadDelay (\nums -> ...) -- good user, have numbers
-- @
-generator :: String -- ^The expression to parse
- -> Either ParseError (Generator [Int] b) -- ^The result with errors or the ready Generator
-generator input = do
+generator :: String -- ^The expression to parse
+ -> Either ParseError (Generator GeneratorValue 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
+ -> String
+ -> Either ParseError (Permgen GeneratorValue a, Generator GeneratorValue a)
+permgenGenerator permgen input = do
(Expression exp rep del) <- P.parseExpression input
- gen <- case exp of
- Standard body -> SG.mkGenerator <$> SP.parseToplevel body
- Custom body -> CG.mkGenerator <$> CP.parseToplevel body
-
- return $ 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)) }
- }
+ 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)
+ }
+ where
+ newGenerator :: Distribution -> Either ParseError (GeneratorFunction GeneratorValue b)
+ 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 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)) }
+ }
-times :: (Monad m) => Int -> m a -> m a
-times 1 m = m
-times x m = m >> times (x - 1) m
+ times :: (Monad m) => Int -> m a -> m a
+ times 1 m = m
+ times x m = m >> times (x - 1) m
-delayed :: Delay -> GeneratorDelay -> IO a -> IO a
-delayed (Fixed delayRange) sleep !m = do
- delay <- fromRange delayRange
- sleep delay
- m
+ delayed :: Delay -> GeneratorDelay -> IO a -> IO a
+ delayed (Fixed delayRange) sleep !m = do
+ delay <- fromRange delayRange
+ sleep delay
+ m
View
5 core/main/GeneratorSupport.hs
@@ -1,4 +1,4 @@
-module GeneratorSupport(fromRange, GeneratorDelay) where
+module GeneratorSupport(fromRange, GeneratorDelay, GeneratorFunction) where
import Syntax
import System.Random (randomIO)
@@ -8,6 +8,9 @@ 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)
+
-- |Picks one random value from the given range
fromRange :: Range -> IO Int
fromRange (Exact x) = return x
View
2 core/main/Standard/Generator.hs
@@ -5,7 +5,7 @@ import Control.Monad (replicateM)
import Standard.Syntax
import GeneratorSupport
-mkGenerator :: Expr -> ([Int] -> IO b) -> IO b
+mkGenerator :: Expr -> GeneratorFunction Int b
mkGenerator (EvenDistr countRange valueRange) !f = do
count <- fromRange countRange
values <- replicateM count (fromRange valueRange)
View
11 core/test/Custom/GeneratorSpec.hs
@@ -2,9 +2,20 @@ 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; foo(1, 1); } once" `shouldReturn` [1]
+
+ 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
+ (_, values2) <- permgenGenerate' permgen1 expr
+
+ print (M.keys permgen1)
+ values1 `shouldBe` values2
View
9 core/test/GeneratorSpecSupport.hs
@@ -1,4 +1,4 @@
-module GeneratorSpecSupport(generate', error', avg) where
+module GeneratorSpecSupport(generate', permgenGenerate', error', avg) where
import Generator
import Control.Applicative ((<$>))
@@ -8,10 +8,15 @@ error' expr =
let Left err = generator expr
in show err
-generate' :: String -> IO [Int]
+generate' :: String -> IO [GeneratorValue]
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 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
View
1 hwsexp.cabal
@@ -48,6 +48,7 @@ test-suite core-spec
hwsexp
, base >= 4.6
, parsec >= 3.1.3
+ , containers >= 0.5.0.0
, hspec >= 1.3
executable ws
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 Int () -- ^ 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 dd1623b

Please sign in to comment.
Something went wrong with that request. Please try again.