.

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 []

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,52 +16,69 @@ 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
 --  @
 --      case (generator "{evendistr 5 [1..20]} every 50ms") of
 --          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

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

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)

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

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

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

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))