copilot 1.0.1 → 1.0.2
raw patch · 10 files changed
+122/−196 lines, 10 files
Files
- Language/Copilot/Compiler.hs +13/−86
- Language/Copilot/Core.hs +41/−48
- Language/Copilot/Examples/Examples.hs +15/−5
- Language/Copilot/Interface.hs +8/−8
- Language/Copilot/Language.hs +2/−24
- Language/Copilot/Language/FunctionCalls.hs +0/−1
- Language/Copilot/PrettyPrinter.hs +11/−11
- Language/Copilot/Tests/Random.hs +11/−11
- README +15/−0
- copilot.cabal +6/−2
Language/Copilot/Compiler.hs view
@@ -19,7 +19,7 @@ -- | Compiles an /Copilot/ specification to an /Atom/ one. -- The period is given as a Maybe : if it is Nothing, an optimal period will be chosen. copilotToAtom :: LangElems -> Maybe Period -> Name -> (Period, A.Atom ()) -copilotToAtom (LangElems streams sends triggers) p cFileName = +copilotToAtom (LangElems streams triggers) p cFileName = (p', A.period p' $ do prophArrs <- mapStreamableMapsM initProphArr streams outputs <- mapStreamableMapsM initOutput streams@@ -31,7 +31,8 @@ (return emptyTmpSamples) let nextStates = makeStates $ - mapStreamableMaps (nextSt streams prophArrs tmpSamples outputIndexes 0) + mapStreamableMaps + (nextSt streams prophArrs tmpSamples outputIndexes 0) streams -- One atom rule for each stream@@ -41,23 +42,17 @@ M.fold (makeTrigger outputs cFileName) (return ()) triggers - foldStreamableMaps (makeSend outputs) sends (return ())- -- Sampling of the external variables. Remove redundancies. sequence_ $ snd . unzip $ nubBy (\x y -> fst x == fst y) $ foldStreamableMaps (\_ -> sampleExts outputs tmpSamples cFileName) streams [] ) where p' = period p--- where--- optP = getOptimalPeriod streams sends - -- | For period n >= 5: -- Phase 0: Sample external vars (if any). -- Phase 1: state update. -- Phase 2: Compute output variables. -- Phase 3: Fire triggers (if any).--- Phase 3: send values (if any). -- Phase 4 up to n: update indexes. period :: Maybe Int -> Int period p = @@ -81,58 +76,6 @@ data BoundedArray a = B ArrIndex (Maybe (A.A a)) --- nextSt :: Streamable a => StreamableMaps Spec -> ProphArrs -> TmpSamples -> Indexes --- -> Spec a -> ArrIndex -> A.E a--- nextSt streams prophArrs tmpSamples outputIndexes s index = --- case s of--- PVar _ v -> --- let PhV var = getElem (tmpVarName v) (tmpVars tmpSamples) in--- A.value var--- PArr _ (v, idx) -> --- let PhA var = e tmp (tmpArrs tmpSamples) --- tmp = tmpArrName v (show idx) --- e a b = case getMaybeElem a b of--- Nothing -> --- error "Error in application of getElem in nextSt."--- Just x -> x --- in A.value var--- Var v -> nextStVar v streams prophArrs tmpSamples outputIndexes index--- Const e -> A.Const e--- F _ f s0 -> f $ next s0 index --- F2 _ f s0 s1 -> --- f (next s0 index) --- (next s1 index)--- F3 _ f s0 s1 s2 -> --- f (next s0 index) --- (next s1 index) --- (next s2 index)--- Append _ s0 -> next s0 index--- Drop i s0 -> next s0 (fromInteger (toInteger i) + index)--- where next :: Streamable b => Spec b -> ArrIndex -> A.E b--- next = nextSt streams prophArrs tmpSamples outputIndexes---- nextStVar v streams prophArrs tmpSamples outputIndexes index = --- let B initLen maybeArr = getElem v prophArrs in--- -- This check is extremely important It means that if x at time n depends on y--- -- at time n then x is obtained not by y, but by inlining the definition of y--- -- so it increases the size of code (sadly), but is the only thing preventing--- -- race conditions from occuring--- if index < initLen--- then getVar v initLen maybeArr --- else let s0 = getElem v streams in --- nextSt streams prophArrs tmpSamples outputIndexes s0 (index - initLen)--- where getVar :: Streamable a => Var -> ArrIndex -> Maybe (A.A a) -> A.E a--- getVar v initLen maybeArr =--- let outputIndex = case M.lookup v outputIndexes of--- Nothing -> error "Error in function getVar."--- Just x -> x--- arr = case maybeArr of--- Nothing -> error "Error in function getVar (maybeArr)."--- Just x -> x in --- arr A.!. ((A.Const index + A.VRef outputIndex) `A.mod_` --- (A.Const (initLen + 1)))-- -- | Takes the NextSts and walks over the tree building the Atom expression. makeStates :: StreamableMaps NextSt -> StreamableMaps A.E makeStates trees = @@ -339,7 +282,6 @@ index <- atomConstructor ("outputIndex__" ++ normalizeVar v) 0 return $ M.insert v index mindexes --- where nextSt' = nextSt streams prophArrs tmpSamples outputIndexes s 0 makeRule :: forall a. Streamable a => StreamableMaps A.E -> Outputs -> ProphArrs -> Indexes -> Indexes -> Var -> Spec a -> A.Atom () -> A.Atom ()@@ -350,7 +292,7 @@ Nothing -> -- Fusing together the update and the output if the prophecy array doesn't exist -- (ie if it would only have hold the output value)- A.exactPhase 2 $ A.atom ("updateOutput__" ++ normalizeVar v) $ do+ A.exactPhase 1 $ A.atom ("updateOutput__" ++ normalizeVar v) $ do ((getElem v outputs)::(A.V a)) A.<== getElem v exps Just arr -> do@@ -369,22 +311,7 @@ $ A.atom ("incrUpdateIndex__" ++ normalizeVar v) $ do updateIndex A.<== (A.VRef updateIndex + A.Const 1) `A.mod_` A.Const (n + 1)- -makeSend :: forall a. Streamable a - => Outputs -> String -> Send a -> A.Atom () -> A.Atom ()-makeSend outputs name (Send v port portName) r = do- r - A.exactPhase 3 $ A.atom ("__send_" ++ name) $- mkSend (A.value $ getElem (getMaybeVar v) outputs :: A.E a) - port - portName --- | Sending data over ports.-mkSend :: (Streamable a) => A.E a -> Port -> String -> A.Atom ()-mkSend e (Port port) portName =- A.action (\ueStr -> portName ++ "(" ++ head ueStr ++ "," ++ show port ++ ")") - [A.ue e]- sampleStr :: String sampleStr = "sample__" @@ -403,7 +330,6 @@ Const _ -> a PVar _ v -> let v' = tmpVarName v--- PhV var = getElem v' (tmpVars ts) :: PhasedValueVar a in PhV var = case getMaybeElem v' (tmpVars ts) :: Maybe (PhasedValueVar a) of Nothing -> error $ "Copilot error: variable " ++ v' ++ " was not defined!."@@ -430,14 +356,15 @@ sampleExts' s2 a Append _ s0 -> sampleExts' s0 a Drop _ s0 -> sampleExts' s0 a- where -- minSampPh :: Int- --minSampPh = 2- sampleExts' s' a' = sampleExts outputs ts cFileName s' a'- getSampleFuncVar v = case v of- ExtV extV -> extV- -- XXX A bit of a hack. Atom should be changed to allow- -- "out-of-Atom" assignments. But this works for now.- Fun nm args -> funcShow cFileName nm args+ where + sampleExts' :: Streamable b => Spec b -> [(Var, A.Atom ())] -> [(Var, A.Atom ())]+ sampleExts' s' a' = sampleExts outputs ts cFileName s' a'+ getSampleFuncVar v = + case v of+ ExtV extV -> extV+ -- XXX A bit of a hack. Atom should be changed to allow "out-of-Atom"+ -- assignments. But this works for now.+ Fun nm args -> funcShow cFileName nm args -- lookup the idx for external array accesses in the map.
Language/Copilot/Core.hs view
@@ -10,15 +10,15 @@ module Language.Copilot.Core ( Period, Var, Name, Port(..), Ext(..), Exs, ExtRet(..), Args, ArgConstVar(..),- Spec(..), Streams, Stream, Send(..), + Spec(..), Streams, Stream, Trigger(..), Triggers, LangElems(..), Streamable(..), StreamableMaps(..), emptySM, isEmptySM, getMaybeElem, getElem, foldStreamableMaps, mapStreamableMaps, mapStreamableMapsM, filterStreamableMaps, normalizeVar, getVars, Vars,- getAtomType, getSpecs, getSends, getTriggers, vPre, funcShow,- getMaybeVar, notConstVarErr+ getAtomType, getSpecs, getTriggers, vPre, funcShow,+ notConstVarErr ) where import qualified Language.Atom as A@@ -92,8 +92,13 @@ instance Show Trigger where show (Trigger s fnName args) =- "trigger_" ++ getMaybeVar s ++ "_" ++ fnName ++ "_" ++ normalizeVar (show args)+ "trigger_" ++ notConstVarErr s show ++ "_" ++ fnName ++ "_" ++ normalizeVar (show args) + -- getMaybeVar :: Streamable a => Spec a -> Var+ -- getMaybeVar (Var v) = v+ -- getMaybeVar s = + -- error $ "Expected a Copilot variable but provided " ++ show s ++ " instead."+ -- XXX change the constructors to SimpleVar and Function (or something like that) -- XXX in Ext, we throw away the type info for Args. This is because we're just -- making external calls, and we don't know anything about the types anyway (we@@ -164,33 +169,26 @@ (==) (Drop i s) (Drop i' s') = i == i' && s == s' (==) _ _ = False --- | Get a variable name from a spec; throw an error otherwise.-getMaybeVar :: Streamable a => Spec a -> Var-getMaybeVar (Var v) = v-getMaybeVar s = error $ "Expected a Copilot variable but provided " ++ show s ++ " instead."- -- | Copilot variable reference, taking the name of the generated C file. vPre :: Name -> String vPre cName = "copilotState" ++ cName ++ "." ++ cName ++ "." --- | An instruction to send data on a port at a given phase. --- data Send a = Sendable a => Send (Var, Phase, Port)-data Send a = - Send { sendVar :: Spec a - , sendPort :: Port- , sendName :: String}+-- -- | An instruction to send data on a port at a given phase. +-- -- data Send a = Sendable a => Send (Var, Phase, Port)+-- data Send a = +-- Send { sendVar :: Spec a +-- , sendPort :: Port+-- , sendName :: String} -instance Streamable a => Show (Send a) where - show (Send s (Port port) portName) = - portName ++ "_port_" ++ show port ++ "_var_" ++ getMaybeVar s+-- instance Streamable a => Show (Send a) where +-- show (Send s (Port port) portName) = +-- portName ++ "_port_" ++ show port ++ "_var_" ++ getMaybeVar s -- | Holds all the different kinds of language elements that are pushed into the--- Writer monad. This currently includes the actual specs, "send" directives,--- and trigger directives. (Use the functions in Language.hs to make sends and--- triggers.)+-- Writer monad. This currently includes the actual specs and trigger+-- directives. (Use the functions in Language.hs to make sends and triggers.) data LangElems = LangElems { strms :: StreamableMaps Spec- , snds :: StreamableMaps Send , trigs :: Triggers} -- | Container for mutually recursive streams, whose specifications may be@@ -199,17 +197,12 @@ getSpecs :: Streams -> StreamableMaps Spec getSpecs streams = - let (LangElems ss _ _) = execWriter streams+ let (LangElems ss _) = execWriter streams in ss -getSends :: Streams -> StreamableMaps Send-getSends streams = - let (LangElems _ sendMap _) = execWriter streams- in sendMap- getTriggers :: Streams -> Triggers getTriggers streams = - let (LangElems _ _ triggers) = execWriter streams+ let (LangElems _ triggers) = execWriter streams in triggers -- | A named stream@@ -218,10 +211,10 @@ -- | If the 'Spec' isn't a 'Var' or 'Const', then throw an error; otherwise, -- apply the function. notConstVarErr :: Streamable a => Spec a -> (ArgConstVar -> b) -> b-notConstVarErr s f =+notConstVarErr s f = f $ case s of- Var v -> f (V v)- Const c -> f (C (showAsC c))+ Var v -> V v+ Const c -> C (showAsC c) _ -> error $ "You provided specification \n" ++ " " ++ show s ++ "\n where you needed to give a Copilot variable or constant." @@ -404,17 +397,17 @@ (Streamable a => Var -> c a -> b -> b) -> StreamableMaps c -> b -> b foldStreamableMaps f (SM bm i8m i16m i32m i64m w8m w16m w32m w64m fm dm) acc =- let acc0 = M.foldWithKey f acc bm- acc1 = M.foldWithKey f acc0 i8m - acc2 = M.foldWithKey f acc1 i16m- acc3 = M.foldWithKey f acc2 i32m- acc4 = M.foldWithKey f acc3 i64m- acc5 = M.foldWithKey f acc4 w8m- acc6 = M.foldWithKey f acc5 w16m- acc7 = M.foldWithKey f acc6 w32m- acc8 = M.foldWithKey f acc7 w64m- acc9 = M.foldWithKey f acc8 fm - acc10 = M.foldWithKey f acc9 dm+ let acc0 = M.foldrWithKey f acc bm+ acc1 = M.foldrWithKey f acc0 i8m + acc2 = M.foldrWithKey f acc1 i16m+ acc3 = M.foldrWithKey f acc2 i32m+ acc4 = M.foldrWithKey f acc3 i64m+ acc5 = M.foldrWithKey f acc4 w8m+ acc6 = M.foldrWithKey f acc5 w16m+ acc7 = M.foldrWithKey f acc6 w32m+ acc8 = M.foldrWithKey f acc7 w64m+ acc9 = M.foldrWithKey f acc8 fm + acc10 = M.foldrWithKey f acc9 dm in acc10 {-# INLINE mapStreamableMaps #-}@@ -492,16 +485,16 @@ mappend x y = overlap x y instance Monoid LangElems where- mempty = LangElems emptySM emptySM M.empty- mappend (LangElems x y z) (LangElems x' y' z') = - LangElems (overlap x x') (overlap y y') (M.union z z') -- XXX should we test for the same key? + mempty = LangElems emptySM M.empty+ mappend (LangElems x z) (LangElems x' z') = + LangElems (overlap x x') (M.union z z') overlap :: StreamableMaps s -> StreamableMaps s -> StreamableMaps s overlap x@(SM bm i8m i16m i32m i64m w8m w16m w32m w64m fm dm) y@(SM bm' i8m' i16m' i32m' i64m' w8m' w16m' w32m' w64m' fm' dm') = let multDefs = (getVars x `intersect` getVars y) in if null multDefs then union- else error $ "Copilot error: The variables " - ++ show multDefs ++ " have multiple definitions."+ else error $ "Copilot error: The variables " + ++ show multDefs ++ " have multiple definitions." where union = SM (M.union bm bm') (M.union i8m i8m') (M.union i16m i16m') (M.union i32m i32m') (M.union i64m i64m') (M.union w8m w8m') (M.union w16m w16m') (M.union w32m w32m') (M.union w64m w64m')
Language/Copilot/Examples/Examples.hs view
@@ -71,10 +71,20 @@ trigger z "z1_trigger" (y <> constW16 3 <> x) yy :: Streams-yy = - let a = varW64 "a"- in do a .= 4 +yy = do+ let a = varW32 "a"+-- ans2 = varW32 "ans2"+ a .= [3,5] ++ a + 1+-- ans2 .= a +maj1 :: Streams+maj1 = do+ let v0 = varW32 "v0"+ ans2 = varW32 "ans2"+ v0 .= [3,7] ++ v0 + 1+ ans2 .= v0++ zz :: Streams zz = do let a = varW32 "a"@@ -114,8 +124,8 @@ a .= [0,1] ++ a + 1 b .= mod a 2 == 0 -- sends- send "portA" (port 2) a - send "portB" (port 1) b + trigger true "portA" a + trigger true "portB" b monitor :: Streams monitor = do
Language/Copilot/Interface.hs view
@@ -27,7 +27,7 @@ optStreams :: Maybe (StreamableMaps Spec), -- ^ If there's no Streams, -- then generate random -- streams.- optSends :: StreamableMaps Send, -- ^ For distributed monitors.+-- optSends :: StreamableMaps Send, -- ^ For distributed monitors. optExts :: Maybe Vars, -- ^ Assign values to external variables. optCompile :: Maybe String, -- ^ Set gcc options. optPeriod :: Maybe Period, -- ^ Set the period. If none is given, then@@ -61,7 +61,7 @@ baseOpts :: Options baseOpts = Options { optStreams = Nothing,- optSends = emptySM,+-- optSends = emptySM, optExts = Nothing, optCompile = Nothing, optPeriod = Nothing,@@ -91,7 +91,7 @@ compile :: Streams -> Name -> Options -> IO () compile streams fileName opts = - interface $ setC "-Wall" $ setO fileName $ setS (getSends streams)+ interface $ setC "-Wall" $ setO fileName $ setTriggers (getTriggers streams) $ opts {optStreams = Just (getSpecs streams)} @@ -120,9 +120,9 @@ -- Small functions for easy modification of the Options record --- | Set the directives for sending stream values on ports.-setS :: StreamableMaps Send -> Options -> Options-setS sends opts = opts {optSends = sends}+-- -- | Set the directives for sending stream values on ports.+-- setS :: StreamableMaps Send -> Options -> Options+-- setS sends opts = opts {optSends = sends} -- -- | Set the directives for sending stream values on ports. setTriggers :: Triggers -> Options -> Options@@ -207,7 +207,7 @@ do seed <- createSeed opts let (streams, vars) = getStreamsVars opts seed- sends = optSends opts+-- sends = optSends opts triggers = optTriggers opts backEnd = getBackend opts seed iterations = optIterations opts@@ -216,7 +216,7 @@ putStrLn $ "Random seed :" ++ show seed -- dispatch is doing all the heavy plumbing between -- analyser, compiler, interpreter, gcc and the generated program- dispatch (LangElems streams sends triggers) vars backEnd iterations verbose + dispatch (LangElems streams triggers) vars backEnd iterations verbose createSeed :: Options -> IO Int createSeed opts =
Language/Copilot/Language.hs view
@@ -32,11 +32,8 @@ module Language.Copilot.Language.Sampling, -- * Constructs of the copilot language drop, (++), (.=), -- (..|), - -- * The next functions help typing the send operations- send, port, -- * Triggers module Language.Copilot.Language.FunctionCalls,--- trigger, (<>), void, -- * Safe casting module Language.Copilot.Language.Casting, notConstVarErr@@ -45,7 +42,7 @@ import qualified Language.Atom as A import Data.Int import Data.Word-import Prelude ( Bool(..), Num(..), Float, Double, String, ($), error+import Prelude ( Bool(..), Num(..), Float, Double, ($), error , Fractional(..), fromInteger, Show(..)) import qualified Prelude as P import Control.Monad.Writer (tell)@@ -147,28 +144,10 @@ v .= s = case v of (Var v') -> tell $ LangElems (updateSubMap (M.insert v' s) emptySM) - emptySM - M.empty+ M.empty _ -> error $ "Given spec " P.++ show v P.++ " but expected a variable in a Copilot definition (.=)." -port :: Int -> Port-port = Port---- | Takes a function @name@, a port @number@, and a Copilot variable @v@ and--- constructs a call to the C function @name(x,y)@ where @x@ is the value of the--- Copilot stream @v@ and @y@ is the port number.-send :: Streamable a => String -> Port -> Spec a -> Streams-send portName thePort s = - tell $ LangElems - emptySM - (updateSubMap (M.insert (show sending) sending) emptySM) - M.empty- where sending = case s of - v@(Var _) -> Send v thePort portName- _ -> error $ "Expected a Copilot variable but given " - P.++ show s P.++ " instead."- -- | Coerces a type that is 'Streamable' into a Copilot constant. const :: Streamable a => a -> Spec a const = Const@@ -193,7 +172,6 @@ constF = Const constD :: Double -> Spec Double constD = Const- true, false :: Spec Bool true = Const True
Language/Copilot/Language/FunctionCalls.hs view
@@ -38,7 +38,6 @@ trigger' v fnName args = tell $ LangElems emptySM - emptySM (M.insert (show trig) trig M.empty) where trig = Trigger v fnName args
Language/Copilot/PrettyPrinter.hs view
@@ -14,17 +14,17 @@ Show (a Word8), Show (a Word16), Show (a Word32), Show (a Word64), Show (a Float), Show (a Double)) => Show (StreamableMaps a) where show (SM bm i8m i16m i32m i64m w8m w16m w32m w64m fm dm) =- let acc0 = M.foldWithKey showVal "" bm- acc1 = M.foldWithKey showVal acc0 i8m - acc2 = M.foldWithKey showVal acc1 i16m- acc3 = M.foldWithKey showVal acc2 i32m- acc4 = M.foldWithKey showVal acc3 i64m- acc5 = M.foldWithKey showVal acc4 w8m- acc6 = M.foldWithKey showVal acc5 w16m- acc7 = M.foldWithKey showVal acc6 w32m- acc8 = M.foldWithKey showVal acc7 w64m- acc9 = M.foldWithKey showVal acc8 fm - acc10 = M.foldWithKey showVal acc9 dm+ let acc0 = M.foldrWithKey showVal "" bm+ acc1 = M.foldrWithKey showVal acc0 i8m + acc2 = M.foldrWithKey showVal acc1 i16m+ acc3 = M.foldrWithKey showVal acc2 i32m+ acc4 = M.foldrWithKey showVal acc3 i64m+ acc5 = M.foldrWithKey showVal acc4 w8m+ acc6 = M.foldrWithKey showVal acc5 w16m+ acc7 = M.foldrWithKey showVal acc6 w32m+ acc8 = M.foldrWithKey showVal acc7 w64m+ acc9 = M.foldrWithKey showVal acc8 fm + acc10 = M.foldrWithKey showVal acc9 dm in acc10 where showVal :: (Streamable a, Show (b a)) => Var -> b a -> String -> String
Language/Copilot/Tests/Random.hs view
@@ -75,17 +75,17 @@ (forall a. (Streamable a, Random a) => Var -> c a -> b -> b) -> StreamableMaps c -> b -> b foldRandomableMaps f (SM bm i8m i16m i32m i64m w8m w16m w32m w64m fm dm) acc =- let acc0 = M.foldWithKey f acc bm- acc1 = M.foldWithKey f acc0 i8m - acc2 = M.foldWithKey f acc1 i16m- acc3 = M.foldWithKey f acc2 i32m- acc4 = M.foldWithKey f acc3 i64m- acc5 = M.foldWithKey f acc4 w8m- acc6 = M.foldWithKey f acc5 w16m- acc7 = M.foldWithKey f acc6 w32m- acc8 = M.foldWithKey f acc7 w64m- acc9 = M.foldWithKey f acc8 fm - acc10 = M.foldWithKey f acc9 dm+ let acc0 = M.foldrWithKey f acc bm+ acc1 = M.foldrWithKey f acc0 i8m + acc2 = M.foldrWithKey f acc1 i16m+ acc3 = M.foldrWithKey f acc2 i32m+ acc4 = M.foldrWithKey f acc3 i64m+ acc5 = M.foldrWithKey f acc4 w8m+ acc6 = M.foldrWithKey f acc5 w16m+ acc7 = M.foldrWithKey f acc6 w32m+ acc8 = M.foldrWithKey f acc7 w64m+ acc9 = M.foldrWithKey f acc8 fm + acc10 = M.foldrWithKey f acc9 dm in acc10 randomWeighted :: (RandomGen g, Random a) => g -> [(a, Int)] -> (a, g)
README view
@@ -24,7 +24,14 @@ systems, but it can be used to develop a variety of functional-style embedded code. +The documentation for the language itself is mainly at + Copilot/doc/Language-Copilot-Language.html ++and there are numerous examples in++ Copilot/Language/Copilot/Examples + ******************************************************************************* Download *******************************************************************************@@ -43,6 +50,14 @@ ******************************************************************************* Release notes *******************************************************************************++* Copilot-1.0.2+ * Fixed a major compilation bug.+ * Upgraded to GHC 7.0.2 (Haskell Platform).++* Copilot-1.0.1+ * Removed send operators---use triggers instead (see the distributed voting+ * example in VoteExamples.hs. * Copilot-1.0 * Language frozen.
copilot.cabal view
@@ -1,6 +1,6 @@ name: copilot-version: 1.0.1-cabal-version: >= 1.2+version: 1.0.2+cabal-version: >= 1.6 license: BSD3 license-file: LICENSE author: Lee Pike, Robin Morisset, Alwyn Goodloe, Sebastian Niller@@ -30,6 +30,10 @@ code. extra-source-files: README++source-repository head+ type: git+ location: git://github.com/leepike/Copilot.git library ghc-options: -Wall