copilot-core 0.2 → 0.2.1

raw patch · 6 files changed

+280/−194 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• copilot-core.cabal +1/−1
• src/Copilot/Core/Interpret/Eval.hs +1/−0
• src/Copilot/Core/Random.hs +249/−170
• src/Copilot/Core/Random/Gen.hs +24/−22
• src/Copilot/Core/Random/Weights.hs +4/−0
• src/Copilot/Core/Type/Dynamic.hs +1/−1

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                copilot-core-version:             0.2+version:             0.2.1 synopsis:            An intermediate representation for Copilot. description:         Intermediate representation for Copilot.                      Strictly follows Haskell 2010 except for universal

@@ -8,6 +8,7 @@  module Copilot.Core.Interpret.Eval   ( ExtEnv (..)+  , Env    , Output   , ExecTrace (..)   , eval

@@ -6,20 +6,20 @@  module Copilot.Core.Random   ( randomSpec-  ) where+  , randomExtVals ) where -import Control.Monad-import Copilot.Core (UExpr (..))-import qualified Copilot.Core as E-import Copilot.Core.Spec+import Copilot.Core +import Copilot.Core.Interpret.Eval (ExtEnv (..), Env) import Copilot.Core.Random.Gen import Copilot.Core.Random.Weights-import Copilot.Core.Type-import Copilot.Core.Type.Equality-import Data.Int-import Data.Word+import Copilot.Core.Type.Dynamic+import Copilot.Core.Type.Equality ((=~=))++import Control.Monad+import Data.List (foldl', nubBy) import Prelude hiding (id) import System.Random (StdGen)+import Control.Monad.Reader  -------------------------------------------------------------------------------- @@ -29,28 +29,41 @@ --------------------------------------------------------------------------------  genSpec :: Gen Spec-genSpec =-  do-    ws <- weights-    numTriggers <- choose (1, maxTriggers ws)-    ss <- genStreamInfo's-    streams  <- mapM (genStream ss) ss-    triggers <- mapM (genTrigger ss) (map mkTriggerName [0..numTriggers-1])-    return-      Spec-        { specStreams   = streams-        , specObservers = []-        , specTriggers  = triggers }-+genSpec = do+  ws          <- weights+  numTriggers <- choose (1, maxTriggers ws)+  ss          <- genStreamInfo's+  extVars     <- genExtVars+  streams     <- runReaderT (mapM (genStream ss) ss) extVars+  triggers    <- +    runReaderT (mapM (genTrigger ss) (map mkTriggerName [0..numTriggers-1]))+               extVars+  return Spec { specStreams   = streams+              , specObservers = []+              , specTriggers  = triggers }   where--  mkTriggerName :: Int -> E.Name+  mkTriggerName :: Int -> Name   mkTriggerName k = "f" ++ show k +  -- Possibly generate external variables to be shared among streams.+  genExtVars :: Gen [DynExtVar]+  genExtVars = do+    ws <- weights+    n  <- choose (0, maxExtVars ws)+    let lst = [1..n] -- empty list if n == 0+    mapM genExtVar lst+    where+    genExtVar :: Int -> Gen DynExtVar+    genExtVar i = do +      ws <- weights                 +      WrapType t <- genType ws+      let expr = ExternVar t ("ext" ++ show i)+      return $ toDynF t expr+ --------------------------------------------------------------------------------  data StreamInfo = forall a . (Eq a, Ord a) => StreamInfo-  { streamInfoId         :: E.Id+  { streamInfoId         :: Id   , streamInfoType       :: Type a   , streamInfoBufferSize :: Int } @@ -78,129 +91,141 @@ --------------------------------------------------------------------------------  genStreamInfo's :: Gen [StreamInfo]-genStreamInfo's =-  do-    let-      s0 = StreamInfo 0 (typeOf :: Type Bool) 1-    ws <- weights-    ss <- mapM genStreamInfo [1 .. numStreams ws - 1]-    return (s0 : ss)+genStreamInfo's = do+  let s0 = StreamInfo 0 (typeOf :: Type Bool) 1+  ws      <- weights+  ss      <- mapM genStreamInfo [1 .. numStreams ws - 1]+  return (s0 : ss)    where   genStreamInfo :: Int -> Gen StreamInfo-  genStreamInfo id =-    do-      ws <- weights-      k  <- choose (1, maxBuffSize ws)-      WrapType t <- genType ws-      return-        StreamInfo-          { streamInfoId         = id-          , streamInfoType       = t-          , streamInfoBufferSize = k }+  genStreamInfo id = do+    ws <- weights+    k  <- choose (1, maxBuffSize ws)+    WrapType t <- genType ws+    return+      StreamInfo+        { streamInfoId         = id+        , streamInfoType       = t+        , streamInfoBufferSize = k }  -------------------------------------------------------------------------------- -genStream :: [StreamInfo] -> StreamInfo -> Gen Stream+-- External variables+type DynExtVar = DynamicF Expr Type++type StreamEnv = ReaderT [DynExtVar] Gen++--------------------------------------------------------------------------------++genStream :: [StreamInfo] -> StreamInfo -> StreamEnv Stream genStream ss   StreamInfo     { streamInfoId         = id     , streamInfoType       = t-    , streamInfoBufferSize = k } =-  do-    xs <- replicateM k (randomFromType t)-    w  <- genExpr ss t-    return+    , streamInfoBufferSize = k } +  = do+  xs <- lift $ replicateM k (randomFromType t)+  extVars <- ask+  w  <- lift $ genExpr extVars ss t+  return        Stream         { streamId       = id         , streamBuffer   = xs-        , streamGuard    = E.Const (typeOf :: Type Bool) True+        , streamGuard    = Const (typeOf :: Type Bool) True         , streamExpr     = w         , streamExprType = t }  -------------------------------------------------------------------------------- -genTrigger :: [StreamInfo] -> E.Name -> Gen Trigger-genTrigger ss name =-  do-    w  <- genExpr ss (typeOf :: Type Bool)-    ws <- weights-    i  <- choose (1, maxTrigArgs ws)-    args <- replicateM i genArg-    return-      Trigger-        { triggerName  = name-        , triggerGuard = w-        , triggerArgs  = args }+genTrigger :: [StreamInfo] -> Name -> StreamEnv Trigger+genTrigger ss name = do+  extVars <- ask+  w  <- lift $ genExpr extVars ss (typeOf :: Type Bool)+  ws <- lift $ weights+  i  <- lift $ choose (1, maxTrigArgs ws)+  args <- replicateM i genArg+  return+    Trigger+      { triggerName  = name+      , triggerGuard = w+      , triggerArgs  = args }    where--  genArg :: Gen UExpr-  genArg =-    do-      WrapType t <- genTypeFromStreamInfo's ss-      w <- genExpr ss t-      return-        UExpr-          { uExprExpr = w-          , uExprType = t }+  genArg :: StreamEnv UExpr+  genArg = do+    WrapType t <- lift $ genTypeFromStreamInfo's ss+    extVars <- ask+    w <- lift $ genExpr extVars ss t+    return+      UExpr+        { uExprExpr = w+        , uExprType = t }  -------------------------------------------------------------------------------- -genExpr :: [StreamInfo] -> Type a -> Gen (E.Expr a)-genExpr ss t =-  do-    dp <- depth-    ws <- weights-    if dp >= maxExprDepth ws-      then freq-        [ (constFreq ws, genConst)-        , (dropFreq  ws, genDrop) ]-      else freq-        [ (constFreq ws, genConst)-        , (dropFreq  ws, genDrop)-        , (op1Freq   ws, genOp1)-        , (op2Freq   ws, genOp2)-        , (op3Freq   ws, genOp3) ]+genExpr :: [DynExtVar] -> [StreamInfo] -> Type a -> Gen (Expr a)+genExpr extVars ss t = do+  dp <- depth+  ws <- weights+  if dp >= maxExprDepth ws+    then freq (terminalLst ws)+    else freq $ +      terminalLst ws +++      [ (op1Freq   ws, genOp1)+      , (op2Freq   ws, genOp2)+      , (op3Freq   ws, genOp3) ]    where-  genConst =-    do-      x <- randomFromType t-      return $ E.Const t x-  genDrop =-    do-      s <- findStreamInfoWithMatchingType-      k <- choose (0, streamInfoBufferSize s - 1)-      return $ E.Drop t (fromIntegral k) (streamInfoId s)+  terminalLst ws = +    (extVarFreq' ws, genExtVar) : [ (constFreq ws, genConst)+                                  , (dropFreq  ws, genDrop) ]  +  extVarFreq' ws = if null typedExtVars then 0 else extVarFreq ws+  +  genExtVar = do+    let vars = typedExtVars+    r <- choose (0, length vars - 1)+    return (vars !! r)++  typedExtVars = foldl' typedExtVar [] extVars+    where typedExtVar vars dyn = +            case fromDynF t dyn of+                   Nothing   -> vars+                   Just expr -> expr:vars++  genConst = do +    x <- randomFromType t +    return $ Const t x++  genDrop = do+    s <- findStreamInfoWithMatchingType+    k <- choose (0, streamInfoBufferSize s - 1)+    return $ Drop t (fromIntegral k) (streamInfoId s)     where     findStreamInfoWithMatchingType =-      let-        p (StreamInfo _ t1 _) =-          case t =~= t1 of-            Just _ -> True-            _      -> False-      in-        elements (filter p ss)+      let p (StreamInfo _ t1 _) = case t =~= t1 of+                                    Just _ -> True+                                    _      -> False+      in  elements (filter p ss)    genOp1 = incDepth $ case t of-    Bool   -> genOp1Bool ss-    Int8   -> genOp1Num  ss t-    Int16  -> genOp1Num  ss t-    Int32  -> genOp1Num  ss t-    Int64  -> genOp1Num  ss t-    Word8  -> genOp1Num  ss t-    Word16 -> genOp1Num  ss t-    Word32 -> genOp1Num  ss t-    Word64 -> genOp1Num  ss t-    Float  -> genOp1Num  ss t-    Double -> genOp1Num  ss t+    Bool   -> genOp1Bool extVars ss+    Int8   -> genOp1Num  extVars ss t+    Int16  -> genOp1Num  extVars ss t+    Int32  -> genOp1Num  extVars ss t+    Int64  -> genOp1Num  extVars ss t+    Word8  -> genOp1Num  extVars ss t+    Word16 -> genOp1Num  extVars ss t+    Word32 -> genOp1Num  extVars ss t+    Word64 -> genOp1Num  extVars ss t+    Float  -> genOp1Num  extVars ss t+    Double -> genOp1Num  extVars ss t    genOp2 = incDepth $ case t of -- XXX  --    Bool    -> oneOf [genOp2Bool ss, genOp2Eq ss, genOp2Ord ss]-    Bool    -> oneOf [genOp2Bool ss, genOp2Eq ss]+    Bool    -> oneOf [genOp2Bool extVars ss, genOp2Eq extVars ss]     Int8    -> intOrWord NumWit IntegralWit     Int16   -> intOrWord NumWit IntegralWit     Int32   -> intOrWord NumWit IntegralWit@@ -217,95 +242,149 @@       intOrWord numWit integralWit = do          ws <- weights          if divModFreq ws -          then oneOf $ num ++ [genOp2Integral ss t integralWit ]+          then oneOf $ num ++ [ genOp2Integral extVars ss t integralWit ]           else oneOf num-        where num = [ genOp2Num ss t numWit ]+        where num = [ genOp2Num extVars ss t numWit ]        floatOrDouble numWit = oneOf-        [ genOp2Num ss t numWit ]+        [ genOp2Num extVars ss t numWit ] -  genOp3 = incDepth (genOp3Mux ss t)+  genOp3 = incDepth (genOp3Mux extVars ss t)      -------------------------------------------------------------------------------- -genOp1Bool :: [StreamInfo] -> Gen (E.Expr Bool)-genOp1Bool ss =+genOp1Bool :: [DynExtVar] -> [StreamInfo] -> Gen (Expr Bool)+genOp1Bool extVars ss =   do-    ew <- genExpr ss (typeOf :: Type Bool)-    return $ E.Op1 E.Not ew+    ew <- genExpr extVars ss (typeOf :: Type Bool)+    return $ Op1 Not ew -genOp1Num :: Num a => [StreamInfo] -> Type a -> Gen (E.Expr a)-genOp1Num ss t =+genOp1Num :: Num a => [DynExtVar] -> [StreamInfo] -> Type a -> Gen (Expr a)+genOp1Num extVars ss t =   do-    ew  <- genExpr ss t-    opw <- elements [E.Abs t, E.Sign t]-    return $ E.Op1 opw ew+    ew  <- genExpr extVars ss t+    opw <- elements [Abs t, Sign t]+    return $ Op1 opw ew -genOp2Bool :: [StreamInfo] -> Gen (E.Expr Bool)-genOp2Bool ss =+genOp2Bool :: [DynExtVar] -> [StreamInfo] -> Gen (Expr Bool)+genOp2Bool extVars ss =   do-    ew1 <- genExpr ss (typeOf :: Type Bool)-    ew2 <- genExpr ss (typeOf :: Type Bool)-    opw <- elements [E.And, E.Or]-    return $ E.Op2 opw ew1 ew2+    ew1 <- genExpr extVars ss (typeOf :: Type Bool)+    ew2 <- genExpr extVars ss (typeOf :: Type Bool)+    opw <- elements [And, Or]+    return $ Op2 opw ew1 ew2 -genOp2Eq :: [StreamInfo] -> Gen (E.Expr Bool)-genOp2Eq ss =+genOp2Eq :: [DynExtVar] -> [StreamInfo] -> Gen (Expr Bool)+genOp2Eq extVars ss =   do     WrapType t <- genTypeFromStreamInfo's ss-    ew1 <- genExpr ss t-    ew2 <- genExpr ss t-    opw <- elements [E.Eq t, E.Ne t]-    return $ E.Op2 opw ew1 ew2+    ew1 <- genExpr extVars ss t+    ew2 <- genExpr extVars ss t+    opw <- elements [Eq t, Ne t]+    return $ Op2 opw ew1 ew2  -- XXX -- Figure out how to ensure t comes from a Numeric Class--- genOp2Ord :: [StreamInfo] -> Gen (E.Expr Bool)+-- genOp2Ord :: [StreamInfo] -> Gen (Expr Bool) -- genOp2Ord ss = --   do --     WrapType t <- genTypeFromStreamInfo's ss---     ew1 <- genExpr ss t---     ew2 <- genExpr ss t+--     ew1 <- genExpr extVars ss t+--     ew2 <- genExpr extVars ss t --     opw <- elements---       [ (E.Lt t)---       , (E.Gt t)---       , (E.Le t)---       , (E.Ge t) ]---     return $ E.Op2 opw ew1 ew2+--       [ (Lt t)+--       , (Gt t)+--       , (Le t)+--       , (Ge t) ]+--     return $ Op2 opw ew1 ew2 -genOp2Num :: [StreamInfo] -> Type a -> NumWit a -> Gen (E.Expr a)-genOp2Num ss t NumWit =+genOp2Num :: [DynExtVar] -> [StreamInfo] -> Type a -> NumWit a -> Gen (Expr a)+genOp2Num extVars ss t NumWit =   do-    ew1 <- genExpr ss t-    ew2 <- genExpr ss t-    opw <-+    ew1 <- genExpr extVars ss t+    ew2 <- genExpr extVars ss t+    opw <-        elements-        [ (E.Add t)-        , (E.Sub t)-        , (E.Mul t) ]+        [ (Add t)+        , (Sub t)+        , (Mul t) ]     return-      $ E.Op2 opw ew1 ew2+      $ Op2 opw ew1 ew2 -genOp2Integral :: [StreamInfo] -> Type a -> IntegralWit a -> Gen (E.Expr a)-genOp2Integral ss t IntegralWit =+genOp2Integral :: +  [DynExtVar] -> [StreamInfo] -> Type a -> IntegralWit a -> Gen (Expr a)+genOp2Integral extVars ss t IntegralWit =   do-    ew1 <- genExpr ss t-    ew2 <- genExpr ss t-    opw <-+    ew1 <- genExpr extVars ss t+    ew2 <- genExpr extVars ss t+    opw <-        elements-        [ (E.Div t)-        , (E.Mod t) ]+        [ (Div t)+        , (Mod t) ]     return-      $ E.Op2 opw ew1 ew2+      $ Op2 opw ew1 ew2 -genOp3Mux :: [StreamInfo] -> Type a -> Gen (E.Expr a)-genOp3Mux ss t =+genOp3Mux :: [DynExtVar] -> [StreamInfo] -> Type a -> Gen (Expr a)+genOp3Mux extVars ss t =   do-    ew1 <- genExpr ss (typeOf :: Type Bool)-    ew2 <- genExpr ss t-    ew3 <- genExpr ss t-    return $ E.Op3 (E.Mux t) ew1 ew2 ew3+    ew1 <- genExpr extVars ss (typeOf :: Type Bool)+    ew2 <- genExpr extVars ss t+    ew3 <- genExpr extVars ss t+    return $ Op3 (Mux t) ew1 ew2 ew3  data NumWit a = Num a => NumWit  data IntegralWit a = Integral a => IntegralWit++--------------------------------------------------------------------------------++randomExtVals :: Int -> Spec -> Weights -> StdGen -> ExtEnv+randomExtVals rnds spec = runGen env 0+  where env = do vars <- extVals rnds spec+                 return ExtEnv { varEnv = vars+                               , arrEnv = []+                               , funcEnv = []+                               }++--------------------------------------------------------------------------------++-- Extract the external variables, returning randomly-generated lists for their+-- values.+extVals :: Int -> Spec -> Gen (Env Name)+extVals rnds Spec { specStreams = strms+                  , specTriggers = triggers } +  = +  let vars = nubBy (\a b -> fst a == fst b) $ +               concatMap strmExts strms ++ +               concatMap triggerExts triggers  in+  mapM randomLst vars++  where +  randomLst :: (Name, UType) -> Gen (Name, DynamicF [] Type)+  randomLst (nm, UType { uTypeType = t }) = do+    rnd <- randomReplicate rnds t+    return $ (nm, toDynF t rnd)++  strmExts Stream { streamExpr = expr } = extsFromExpr expr++  triggerExts Trigger { triggerGuard = grd+                      , triggerArgs = args } = +    extsFromExpr grd ++ concatMap getExpr args+      where getExpr UExpr { uExprExpr = expr } = extsFromExpr expr+  +  extsFromExpr :: Expr a -> [(Name, UType)]+  extsFromExpr expr =+    case expr of+      Const _ _              -> []+      Drop _ _ _             -> []+      Local _ _ _ e1 e2      -> extsFromExpr e1 ++ extsFromExpr e2+      Var _ _                -> []+      ExternVar t name       -> [(name, UType { uTypeType = t })]+      ExternFun _ _ _ _      -> []+      ExternArray _ _ _ _ _  -> []+      Op1 _ e                -> extsFromExpr e+      Op2 _ e1 e2            -> extsFromExpr e1 ++ extsFromExpr e2+      Op3 _ e1 e2 e3         -> extsFromExpr e1 ++ extsFromExpr e2+                                  ++ extsFromExpr e3++--------------------------------------------------------------------------------

@@ -15,11 +15,13 @@   , depth   , weights   , incDepth+  , randomReplicate   ) where  import Copilot.Core.Random.Weights import Copilot.Core.Error import Copilot.Core.Type+ import System.Random (StdGen, Random, random, randomR, split)  --------------------------------------------------------------------------------@@ -28,14 +30,11 @@ -- the standard random generator. newtype Gen a = MkGen { runGen :: Depth -> Weights -> StdGen -> a } ---------------------------------------------------------------------------------- instance Functor Gen where   fmap f (MkGen h) = MkGen (\ d ws r -> f (h d ws r))  instance Monad Gen where   return x = MkGen (\ _ _ _ -> x)-   MkGen m >>= k = MkGen $ \ d ws r ->     let (r1, r2) = split r       in     let MkGen m' = k (m d ws r1) in@@ -75,31 +74,35 @@   where    genBool :: Gen Bool-  genBool =-    do-      g <- stdGen-      return $ fst (random g)+  genBool = do+    g <- stdGen+    return $ fst (random g)    genBoundedIntegral :: (Bounded a, Integral a) => Gen a-  genBoundedIntegral =-    do let mn = minBound-           mx = maxBound `asTypeOf` mn-       n <- choose (toInteger mn, toInteger mx)-       return (fromInteger n `asTypeOf` mn)+  genBoundedIntegral = do+    let mn = minBound+        mx = maxBound `asTypeOf` mn+    n <- choose (toInteger mn, toInteger mx)+    return (fromInteger n `asTypeOf` mn)    genFractional :: (Random a, Fractional a) => Gen a-  genFractional =-    do-      g <- stdGen-      return $ fst (random g)+  genFractional = do+    g <- stdGen+    return $ fst (random g)  -------------------------------------------------------------------------------- +-- Given an int i and type t, make a list of length i containing random values+-- over the type.+randomReplicate :: Int -> Type a -> Gen [a]+randomReplicate i t = mapM (\_ -> randomFromType t) [1..i]++--------------------------------------------------------------------------------+ choose :: Random a => (a, a) -> Gen a-choose rng =-  do-    g <- stdGen-    return $ fst (randomR rng g)+choose rng = do+  g <- stdGen+  return $ fst (randomR rng g)  oneOf :: [Gen a] -> Gen a oneOf [] = impossible "oneof" "copilot-core" @@ -112,8 +115,7 @@ freq :: [(Int, Gen a)] -> Gen a freq [] = impossible "feq" "copilot-core"  freq xs0 = choose (1, tot) >>= (`pick` xs0)-- where+  where   tot = sum (map fst xs0)   pick n ((k,x):xs)     | n <= k    = x

@@ -14,10 +14,12 @@   , maxBuffSize  :: Int   , maxTriggers  :: Int   , maxTrigArgs  :: Int+  , maxExtVars   :: Int   , maxObservers :: Int   , numStreams   :: Int   -- Expression frequencies:   , constFreq    :: Int+  , extVarFreq   :: Int   , drop0Freq    :: Int   , dropFreq     :: Int   , externFreq   :: Int@@ -44,10 +46,12 @@   , maxBuffSize  = 8   , maxTriggers  = 5   , maxTrigArgs  = 5+  , maxExtVars   = 5   , maxObservers = 8   , numStreams   = 10   -- Expression frequencies:   , constFreq    = 1+  , extVarFreq   = 1   , drop0Freq    = 1   , dropFreq     = 1   , externFreq   = 1

@@ -16,7 +16,7 @@  module Copilot.Core.Type.Dynamic   ( Dynamic-  , DynamicF+  , DynamicF (..)   , toDyn   , fromDyn   , toDynF