copilot-core 3.0.1 → 3.1

raw patch · 12 files changed

+30/−627 lines, 12 filesdep −randomnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies removed: random

API changes (from Hackage documentation)

Files

• copilot-core.cabal +1/−5
• src/Copilot/Core/Error.hs +3/−2
• src/Copilot/Core/Expr.hs +0/−2
• src/Copilot/Core/External.hs +2/−33
• src/Copilot/Core/Interpret/Eval.hs +0/−4
• src/Copilot/Core/Locals.hs +0/−1
• src/Copilot/Core/MakeTags.hs +0/−3
• src/Copilot/Core/PrettyDot.hs +0/−4
• src/Copilot/Core/PrettyPrint.hs +24/−26
• src/Copilot/Core/Random.hs +0/−336
• src/Copilot/Core/Random/Gen.hs +0/−136
• src/Copilot/Core/Random/Weights.hs +0/−75

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                copilot-core-version:             3.0.1+version:             3.1 synopsis:            An intermediate representation for Copilot. description:   Intermediate representation for Copilot.@@ -43,7 +43,6 @@     base       >= 4.9 && < 5,     containers >= 0.4 && < 0.7,     pretty     >= 1.0 && < 1.2,-    random     > 1.0  && < 1.2,     mtl        >= 2.0 && < 2.3,     dlist @@ -60,9 +59,6 @@     Copilot.Core.Operators     Copilot.Core.Spec     Copilot.Core.Locals-    Copilot.Core.Random-    Copilot.Core.Random.Gen-    Copilot.Core.Random.Weights     Copilot.Core.Type     Copilot.Core.Type.Array     Copilot.Core.Type.Dynamic

@@ -12,8 +12,9 @@ impossible function package =   error $ "\"Impossible\" error in function "     ++ function ++ ", in package " ++ package-    ++ ".  Please email Lee Pike at <lee pike @ gmail . com> " ++-       "(remove spaces) or file a bug report on github.com."+    ++ ". Please file an issue at "+    ++ "https://github.com/Copilot-Language/copilot/issues"+    ++ "or email the maintainers at <dev@dedden.net>"  badUsage :: String -> a badUsage msg = error $ "Copilot error: " ++ msg

@@ -48,8 +48,6 @@   Local        :: Typeable a => Type a -> Type b -> Name -> Expr a -> Expr b -> Expr b   Var          :: Typeable a => Type a -> Name -> Expr a   ExternVar    :: Typeable a => Type a -> Name -> Maybe [a] -> Expr a-  ExternFun    :: Typeable a => Type a -> Name -> [UExpr] -> Maybe (Expr a)-               -> Maybe Tag -> Expr a   Op1          :: Typeable a => Op1 a b -> Expr a -> Expr b   Op2          :: (Typeable a, Typeable b) => Op2 a b c -> Expr a -> Expr b -> Expr c   Op3          :: (Typeable a, Typeable b, Typeable c) => Op3 a b c d -> Expr a -> Expr b -> Expr c -> Expr d

@@ -7,8 +7,8 @@ {-# LANGUAGE Rank2Types #-}  module Copilot.Core.External-  ( ExtVar (..), ExtFun (..)-  , externVars, externFuns+  ( ExtVar (..)+  , externVars   ) where  import Copilot.Core.Expr@@ -26,12 +26,6 @@   { externVarName :: Name   , externVarType :: UType } -data ExtFun = forall a . Typeable a => ExtFun-  { externFunName      :: Name-  , externFunType      :: Type a-  , externFunArgs      :: [UExpr]-  , externFunTag       :: Maybe Tag }- --------------------------------------------------------------------------------  externVars :: Spec -> [ExtVar]@@ -48,7 +42,6 @@   Local _ _ _ e1 e2         -> externVarsExpr e1 `append` externVarsExpr e2   Var _ _                   -> empty   ExternVar t name _        -> singleton (ExtVar name (UType t))-  ExternFun _ _ ues _ _     -> concat (map externVarsUExpr ues)   Op1 _ e                   -> externVarsExpr e   Op2 _ e1 e2               -> externVarsExpr e1 `append` externVarsExpr e2   Op3 _ e1 e2 e3            -> externVarsExpr e1 `append`@@ -58,30 +51,6 @@  externVarsUExpr :: UExpr -> DList ExtVar externVarsUExpr UExpr { uExprExpr = e } = externVarsExpr e------------------------------------------------------------------------------------externFuns :: Spec -> [ExtFun]-externFuns = toList . all externFunsExpr--externFunsExpr :: Expr a -> DList ExtFun-externFunsExpr e0 = case e0 of-  Const  _ _                  -> empty-  Drop   _ _ _                -> empty-  Local _ _ _ e1 e2           -> externFunsExpr e1 `append` externFunsExpr e2-  Var _ _                     -> empty-  ExternVar _ _ _             -> empty-  ExternFun t name ues _ tag  -> concat $ singleton (ExtFun name t ues tag) : (map externFunsUExpr ues)-  Op1 _ e                     -> externFunsExpr e-  Op2 _ e1 e2                 -> externFunsExpr e1 `append` externFunsExpr e2-  Op3 _ e1 e2 e3              -> externFunsExpr e1 `append`-                                 externFunsExpr e2 `append`-                                 externFunsExpr e3-  Label _ _ e                 -> externFunsExpr e--externFunsUExpr :: UExpr -> DList ExtFun-externFunsUExpr UExpr { uExprExpr = e } = externFunsExpr e-  -------------------------------------------------------------------------------- 

@@ -168,10 +168,6 @@     x `seq` locs' `seq` evalExpr_ k e2  locs' strms   Var t name                         -> fromJust $ lookup name locs >>= fromDynamic   ExternVar _ name xs                -> evalExternVar k name xs-  ExternFun _ name _ expr _          -> --evalFunc k t name expr-    case expr of-      Nothing -> throw (NoExtsInterp name)-      Just e  -> evalExpr_ k e locs strms   Op1 op e1                          ->     let ev1 = evalExpr_ k e1 locs strms in     let op1 = evalOp1 op                in

@@ -77,7 +77,6 @@                                         `append` locsExpr e2   Var _ _                    -> empty   ExternVar _ _ _            -> empty-  ExternFun _ _ _ _ _        -> empty   Op1 _ e                    -> locsExpr e   Op2 _ e1 e2                -> locsExpr e1 `append` locsExpr e2   Op3 _ e1 e2 e3             -> locsExpr e1 `append` locsExpr e2

@@ -104,9 +104,6 @@   Local t1 t2 name e1 e2         -> liftM2 (Local t1 t2 name) (mkTagsExpr e1) (mkTagsExpr e2)   Var t name                     -> return $ Var t name   ExternVar t name e             -> return $ ExternVar t name e-  ExternFun t name args expr _   -> do args' <- mapM mkTagsUExpr args-                                       k <- next-                                       return $ ExternFun t name args' expr (Just k)   Op1 op e                       -> liftM  (Op1 op) (mkTagsExpr e)   Op2 op e1 e2                   -> liftM2 (Op2 op) (mkTagsExpr e1) (mkTagsExpr e2)   Op3 op e1 e2 e3                -> liftM3 (Op3 op) (mkTagsExpr e1) (mkTagsExpr e2) (mkTagsExpr e3)

@@ -41,10 +41,6 @@                   <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)),ii+1)   ExternVar _ name _         -> (if bb then (text (printf "%s [label=\"externV: %s\",color=cyan1, style=filled]\n" (show ii::String) (name::String)) <> text (printf "%s -> %s\n" (show pere::String) (show ii::String))) else (text (printf "%s [label=\"%s\",color=cyan1, style=filled]\n" (show ii::String) (mkExtTmpVar name)) <> text (printf "%s -> %s\n" (show pere::String) (show ii::String)))                   ,ii+1)-  ExternFun _ name args _ tag  -> let (r1, i1) = ppUExprL (ii+1) ii bb args in-            (if bb then (text (printf "%s [label=\"externF: %s\",color=cyan4, style=filled]\n" (show ii::String) (name::String)) <> text (printf "%s -> %s\n" (show pere::String) (show ii::String))-                  <> (hcat (r1))) else (text (printf "%s [label=\"%s\",color=cyan4, style=filled]\n" (show ii::String) (mkExtTmpTag name tag))<> text (printf "%s -> %s\n" (show pere::String) (show ii::String)))-                  ,i1)   Local _ _ name e1 e2       -> let (r1, i1) = ppExprDot (ii+2) (ii+1) bb e1                                 in let (r2, i2) = ppExprDot (i1) ii bb e2                                 in (text (printf "%s [label=\"local:\",color=blue, style=filled]\n" (show ii::String) )

@@ -31,10 +31,6 @@   Drop _ 0 id                -> strmName id   Drop _ i id                -> text "drop" <+> text (show i) <+> strmName id   ExternVar _ name _         -> text "Ext_" <> (text name)-  ExternFun _ name args _ _  ->-    text "Extf_" <> (text name) <> lparen <>-         (hcat (punctuate (comma <> space) (map ppUExpr args))-       <> rparen)   Local _ _ name e1 e2       -> text "local" <+> doubleQuotes (text name) <+> equals                                           <+> ppExpr e1 $$ text "in" <+> ppExpr e2   Var _ name                 -> text "var" <+> doubleQuotes (text name)@@ -48,27 +44,29 @@  ppOp1 :: Op1 a b -> Doc -> Doc ppOp1 op = case op of-  Not      -> ppPrefix "not"-  Abs _    -> ppPrefix "abs"-  Sign _   -> ppPrefix "signum"-  Recip _  -> ppPrefix "recip"-  Exp _    -> ppPrefix "exp"-  Sqrt _   -> ppPrefix "sqrt"-  Log _    -> ppPrefix "log"-  Sin _    -> ppPrefix "sin"-  Tan _    -> ppPrefix "tan"-  Cos _    -> ppPrefix "cos"-  Asin _   -> ppPrefix "asin"-  Atan _   -> ppPrefix "atan"-  Acos _   -> ppPrefix "acos"-  Sinh _   -> ppPrefix "sinh"-  Tanh _   -> ppPrefix "tanh"-  Cosh _   -> ppPrefix "cosh"-  Asinh _  -> ppPrefix "asinh"-  Atanh _  -> ppPrefix "atanh"-  Acosh _  -> ppPrefix "acosh"-  BwNot _  -> ppPrefix "~"-  Cast _ _ -> ppPrefix "(cast)"+  Not                     -> ppPrefix "not"+  Abs _                   -> ppPrefix "abs"+  Sign _                  -> ppPrefix "signum"+  Recip _                 -> ppPrefix "recip"+  Exp _                   -> ppPrefix "exp"+  Sqrt _                  -> ppPrefix "sqrt"+  Log _                   -> ppPrefix "log"+  Sin _                   -> ppPrefix "sin"+  Tan _                   -> ppPrefix "tan"+  Cos _                   -> ppPrefix "cos"+  Asin _                  -> ppPrefix "asin"+  Atan _                  -> ppPrefix "atan"+  Acos _                  -> ppPrefix "acos"+  Sinh _                  -> ppPrefix "sinh"+  Tanh _                  -> ppPrefix "tanh"+  Cosh _                  -> ppPrefix "cosh"+  Asinh _                 -> ppPrefix "asinh"+  Atanh _                 -> ppPrefix "atanh"+  Acosh _                 -> ppPrefix "acosh"+  BwNot _                 -> ppPrefix "~"+  Cast _ _                -> ppPrefix "(cast)"+  GetField (Struct _) _ f -> \e -> ppInfix "#" e (text $ accessorname f)+  GetField _ _ _          -> impossible "ppOp1" "Copilot.Core.PrettyPrint"  ppOp2 :: Op2 a b c -> Doc -> Doc -> Doc ppOp2 op = case op of@@ -93,7 +91,7 @@   BwXor    _   -> ppInfix "^"   BwShiftL _ _ -> ppInfix "<<"   BwShiftR _ _ -> ppInfix ">>"-  --GetField _ _ -> ppInfix "."+  Index    _   -> ppInfix ".!!"  ppOp3 :: Op3 a b c d -> Doc -> Doc -> Doc -> Doc ppOp3 op = case op of

@@ -1,336 +0,0 @@------------------------------------------------------------------------------------ Copyright © 2011 National Institute of Aerospace / Galois, Inc.------------------------------------------------------------------------------------- | Random spec generator.--{-# LANGUAGE Safe #-}-{-# LANGUAGE GADTs, ExistentialQuantification #-}--module Copilot.Core.Random-  ( randomSpec ) where--import Copilot.Core-import Copilot.Core.Random.Gen-import Copilot.Core.Random.Weights-import Copilot.Core.Type.Dynamic-import Copilot.Core.Type.Equality ((=~=))--import Control.Monad-import Data.List (foldl')-import Prelude hiding (id)-import System.Random (StdGen)-import Control.Monad.Reader--import Data.Typeable (Typeable)------------------------------------------------------------------------------------randomSpec :: Int -> Weights -> StdGen -> Spec-randomSpec rnds = runGen (genSpec rnds) 0------------------------------------------------------------------------------------genSpec :: Int -> Gen Spec-genSpec rnds = 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-              , specProperties = [] }-  where-  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-      evalExpr <- randomReplicate rnds t-      let expr = ExternVar t ("ext" ++ show i) (Just evalExpr)-      return $ toDynF t expr------------------------------------------------------------------------------------data StreamInfo = forall a . (Eq a, Ord a, Typed a) => StreamInfo-  { streamInfoId         :: Id-  , streamInfoType       :: Type a-  , streamInfoBufferSize :: Int }------------------------------------------------------------------------------------data WrapType = forall a . (Eq a, Ord a, Typed a) => WrapType (Type a)--genType :: Weights -> Gen WrapType-genType ws = freq-  [ (boolFreq   ws, return $ WrapType (typeOf :: Type Bool  ))-  , (int8Freq   ws, return $ WrapType (typeOf :: Type Int8  ))-  , (int16Freq  ws, return $ WrapType (typeOf :: Type Int16 ))-  , (int32Freq  ws, return $ WrapType (typeOf :: Type Int32 ))-  , (int64Freq  ws, return $ WrapType (typeOf :: Type Int64 ))-  , (word8Freq  ws, return $ WrapType (typeOf :: Type Word8 ))-  , (word16Freq ws, return $ WrapType (typeOf :: Type Word16))-  , (word32Freq ws, return $ WrapType (typeOf :: Type Word32))-  , (word64Freq ws, return $ WrapType (typeOf :: Type Word64))-  , (floatFreq  ws, return $ WrapType (typeOf :: Type Float ))-  , (floatFreq  ws, return $ WrapType (typeOf :: Type Double)) ]--genTypeFromStreamInfo's :: [StreamInfo] -> Gen WrapType-genTypeFromStreamInfo's = elements . map (\(StreamInfo _ t _) -> WrapType t)------------------------------------------------------------------------------------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)--  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 }-------------------------------------------------------------------------------------- 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 <- lift $ replicateM k (randomFromType t)-  extVars <- ask-  w  <- lift $ genExpr extVars ss t-  return-      Stream-        { streamId       = id-        , streamBuffer   = xs-        , streamExpr     = w-        , streamExprType = t }------------------------------------------------------------------------------------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 :: 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 :: Typeable a => [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-  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)--  genOp3 = incDepth (genOp3Mux extVars ss t)--  genOp1 = incDepth $ case t of-    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-    Bool    -> oneOf [ genOp2Bool extVars ss-                     , genOp2Eq extVars ss-                     , genOp2Ord extVars ss-                     ]-    Int8    -> intOrWord NumWit IntegralWit-    Int16   -> intOrWord NumWit IntegralWit-    Int32   -> intOrWord NumWit IntegralWit-    Int64   -> intOrWord NumWit IntegralWit-    Word8   -> intOrWord NumWit IntegralWit-    Word16  -> intOrWord NumWit IntegralWit-    Word32  -> intOrWord NumWit IntegralWit-    Word64  -> intOrWord NumWit IntegralWit-    Float   -> floatOrDouble NumWit-    Double  -> floatOrDouble NumWit--    where-    floatOrDouble numWit = oneOf [ genOp2Num extVars ss t numWit ]--    intOrWord numWit integralWit = do-      ws <- weights-      if divModFreq ws-        then oneOf $ num ++ [ genOp2Integral extVars ss t integralWit ]-        else oneOf num-      where-      num = [ genOp2Num extVars ss t numWit ]-------------------------------------------------------------------------------------genOp1Bool :: [DynExtVar] -> [StreamInfo] -> Gen (Expr Bool)-genOp1Bool extVars ss = do-  ew <- genExpr extVars ss (typeOf :: Type Bool)-  return $ Op1 Not ew--genOp1Num :: (Typeable a, Num a) => [DynExtVar] -> [StreamInfo] -> Type a -> Gen (Expr a)-genOp1Num extVars ss t = do-  ew  <- genExpr extVars ss t-  opw <- elements [Abs t, Sign t]-  return $ Op1 opw ew--genOp2Bool :: [DynExtVar] -> [StreamInfo] -> Gen (Expr Bool)-genOp2Bool extVars ss = do-  ew1 <- genExpr extVars ss (typeOf :: Type Bool)-  ew2 <- genExpr extVars ss (typeOf :: Type Bool)-  opw <- elements [And, Or]-  return $ Op2 opw ew1 ew2--genOp2Eq :: [DynExtVar] -> [StreamInfo] -> Gen (Expr Bool)-genOp2Eq extVars ss = do-  WrapType t <- genTypeFromStreamInfo's ss-  ew1 <- genExpr extVars ss t-  ew2 <- genExpr extVars ss t-  opw <- elements [Eq t, Ne t]-  return $ Op2 opw ew1 ew2--genOp2Ord :: [DynExtVar] -> [StreamInfo] -> Gen (Expr Bool)-genOp2Ord extVars ss =-  let ss' = findStreamOmittingType Bool in-  if (null ss') then genExpr extVars ss Bool-    else do-      WrapType t <- genTypeFromStreamInfo's ss'-      ew1 <- genExpr extVars ss t-      ew2 <- genExpr extVars ss t-      opw <- elements [ (Lt t)-                      , (Gt t)-                      , (Le t)-                      , (Ge t) ]-      return $ Op2 opw ew1 ew2-  where-  findStreamOmittingType :: Type a -> [StreamInfo]-  findStreamOmittingType t0 =-    let p (StreamInfo _ t1 _) = case t0 =~= t1 of-                                  Just _ -> True-                                  _      -> False-    in  filter (not . p) ss--genOp2Num :: Typeable a => [DynExtVar] -> [StreamInfo] -> Type a -> NumWit a -> Gen (Expr a)-genOp2Num extVars ss t NumWit = do-  ew1 <- genExpr extVars ss t-  ew2 <- genExpr extVars ss t-  opw <- elements [ (Add t)-                  , (Sub t)-                  , (Mul t) ]-  return $ Op2 opw ew1 ew2--genOp2Integral :: Typeable a =>-  [DynExtVar] -> [StreamInfo] -> Type a -> IntegralWit a -> Gen (Expr a)-genOp2Integral extVars ss t IntegralWit = do-  ew1 <- genExpr extVars ss t-  ew2 <- genExpr extVars ss t-  opw <- elements [ (Div t)-                  , (Mod t) ]-  return $ Op2 opw ew1 ew2--genOp3Mux :: Typeable a => [DynExtVar] -> [StreamInfo] -> Type a -> Gen (Expr a)-genOp3Mux extVars ss t = do-  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-

@@ -1,136 +0,0 @@------------------------------------------------------------------------------------ Copyright © 2011 National Institute of Aerospace / Galois, Inc.-----------------------------------------------------------------------------------{-# LANGUAGE Safe #-}-{-# LANGUAGE GADTs, ExistentialQuantification #-}--module Copilot.Core.Random.Gen-  ( Gen-  , runGen-  , randomFromType-  , oneOf-  , freq-  , choose-  , elements-  , depth-  , weights-  , incDepth-  , randomReplicate-  ) where--import Copilot.Core.Random.Weights-import Copilot.Core.Error-import Copilot.Core.Type--import Control.Applicative-import Control.Monad-import System.Random (StdGen, Random, random, randomR, split)-------------------------------------------------------------------------------------- | @runGen@ takes a @Gen a@, a max depth of the expression, the weights, and--- 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 Applicative Gen where-  pure = return-  (<*>) = ap--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-    m' d ws r2------------------------------------------------------------------------------------stdGen :: Gen StdGen-stdGen = MkGen $ \ _ _ g -> g--depth :: Gen Depth-depth = MkGen $ \ d _ _ -> d--weights :: Gen Weights-weights = MkGen $ \ _ ws _ -> ws--incDepth :: Gen a -> Gen a-incDepth gen = MkGen $ \ d ws g -> runGen gen (succ d) ws g------------------------------------------------------------------------------------randomFromType :: Type a -> Gen a-randomFromType t =-  case t of-    Bool   -> genBool-    Int8   -> genBoundedIntegral-    Int16  -> genBoundedIntegral-    Int32  -> genBoundedIntegral-    Int64  -> genBoundedIntegral-    Word8  -> genBoundedIntegral-    Word16 -> genBoundedIntegral-    Word32 -> genBoundedIntegral-    Word64 -> genBoundedIntegral-    Float  -> genFractional-    Double -> genFractional--  where--  genBool :: Gen Bool-  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)--  genFractional :: Random a => Gen a-  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)--oneOf :: [Gen a] -> Gen a-oneOf [] = impossible "oneof" "copilot-core"-oneOf gs = choose (0,length gs - 1) >>= (gs !!)---- | Takes a list of pairs (weight, Gen), and choose the Gen based on the--- weights.  To get the frequency of choosing a Gen, sum up all the weights, and--- choose c between 1 and the total.  Now recurse down the list, choosing an--- item only when c <= weight.  If not, subtract the current weight from c.-freq :: [(Int, Gen a)] -> Gen a-freq [] = impossible "feq" "copilot-core"-freq xs0 = choose (1, tot) >>= (`pick` xs0)-  where-  tot = sum (map fst xs0)-  pick n ((k,x):xs)-    | n <= k    = x-    | otherwise = pick (n-k) xs-  pick _ _  = impossible "pick" "copilot-core"--elements :: [a] -> Gen a-elements [] = impossible "elements" "copilot-core"-elements xs = (xs !!) `fmap` choose (0, length xs - 1)----------------------------------------------------------------------------------

@@ -1,75 +0,0 @@------------------------------------------------------------------------------------ Copyright © 2011 National Institute of Aerospace / Galois, Inc.-----------------------------------------------------------------------------------{-# LANGUAGE Safe #-}--module Copilot.Core.Random.Weights-  ( Depth-  , Weights (..)-  , simpleWeights ) where--type Depth = Int--data Weights = Weights-  { maxExprDepth :: Int-  , maxBuffSize  :: Int-  , maxTriggers  :: Int-  , maxTrigArgs  :: Int-  , maxExtVars   :: Int-  , maxObservers :: Int-  , numStreams   :: Int-  -- Expression frequencies:-  , constFreq    :: Int-  , extVarFreq   :: Int-  , drop0Freq    :: Int-  , dropFreq     :: Int-  , externFreq   :: Int-  , op1Freq      :: Int-  , op2Freq      :: Int-  , op3Freq      :: Int-  -- Type frequencies:-  , boolFreq     :: Int-  , int8Freq     :: Int-  , int16Freq    :: Int-  , int32Freq    :: Int-  , int64Freq    :: Int-  , word8Freq    :: Int-  , word16Freq   :: Int-  , word32Freq   :: Int-  , word64Freq   :: Int-  , floatFreq    :: Int-  , doubleFreq   :: Int-  , divModFreq   :: Bool }--simpleWeights :: Weights-simpleWeights = Weights-  { maxExprDepth = 10-  , maxBuffSize  = 8-  , maxTriggers  = 5-  , maxTrigArgs  = 5-  , maxExtVars   = 5-  , maxObservers = 8-  , numStreams   = 10-  -- Expression frequencies:-  , constFreq    = 1-  , extVarFreq   = 1-  , drop0Freq    = 1-  , dropFreq     = 1-  , externFreq   = 1-  , op1Freq      = 1-  , op2Freq      = 1-  , op3Freq      = 1-  -- Type frequencies:-  , boolFreq     = 1-  , int8Freq     = 1-  , int16Freq    = 1-  , int32Freq    = 1-  , int64Freq    = 1-  , word8Freq    = 1-  , word16Freq   = 1-  , word32Freq   = 1-  , word64Freq   = 1-  , floatFreq    = 1-  , doubleFreq   = 1-  , divModFreq   = True }