ForSyDe 3.1 → 3.1.1
raw patch · 21 files changed
+528/−65 lines, 21 filesdep −packedstringdep −sybdep ~parameterized-datasetup-changed
Dependencies removed: packedstring, syb
Dependency ranges changed: parameterized-data
Files
- ForSyDe.cabal +10/−8
- Setup.hs +1/−1
- examples/Equalizer_Shallow/ButtonControl.lhs +2/−3
- src/ForSyDe/AbsentExt.hs +1/−1
- src/ForSyDe/Backend/Simulate.hs +1/−2
- src/ForSyDe/Backend/VHDL/Quartus.hs +0/−1
- src/ForSyDe/Backend/VHDL/Translate.hs +1/−1
- src/ForSyDe/Backend/VHDL/Traverse/VHDLM.hs +1/−1
- src/ForSyDe/Bit.hs +1/−1
- src/ForSyDe/ForSyDeErr.hs +0/−1
- src/ForSyDe/Netlist/Traverse.hs +0/−1
- src/ForSyDe/Process/ProcType.hs +10/−10
- src/ForSyDe/Process/ProcType/Instances.hs +5/−5
- src/ForSyDe/Shallow/AdaptivityLib.hs +11/−3
- src/ForSyDe/Shallow/DataflowLib.hs +436/−0
- src/ForSyDe/Shallow/MoCLib.hs +2/−0
- src/ForSyDe/System/SysDef.hs +0/−1
- src/ForSyDe/System/SysFun.hs +1/−2
- src/Language/Haskell/TH/Lift.hs +17/−5
- src/Language/Haskell/TH/LiftInstances.hs +15/−4
- src/Language/Haskell/TH/TypeLib.hs +13/−14
ForSyDe.cabal view
@@ -1,5 +1,5 @@ name: ForSyDe-version: 3.1+version: 3.1.1 cabal-version: >= 1.2 build-type: Custom license: BSD3@@ -15,8 +15,10 @@ The ForSyDe (Formal System Design) methodology has been developed with the objective to move system design to a higher level of abstraction and to bridge the abstraction gap by transformational design refinement. This library provides ForSyDe's implementation as a Haskell-embedded Domain Specific Language (DSL). For more information, please see ForSyDe's website: <http://www.ict.kth.se/forsyde/>.-category: Language-tested-with: GHC==6.10.4++ This will be most probably the last update on this package. It will be splitted to ForSyDe-shallow and ForSyDe-deep in the next release.+category: Language, Hardware+tested-with: GHC==6.12.3 data-files: lib/forsyde.vhd -- In order to include all this files with sdist extra-source-files: LICENSE,@@ -85,9 +87,8 @@ Library build-depends: type-level,- parameterized-data,+ parameterized-data >= 0.1.5, containers,- packedstring, base>=4 && <6, regex-posix, mtl, @@ -98,9 +99,9 @@ filepath, old-time, random,- array,- syb+ array + hs-source-dirs: src exposed-modules: Language.Haskell.TH.Lift, Language.Haskell.TH.LiftInstances,@@ -139,7 +140,8 @@ ForSyDe.Shallow.UtilityLib, ForSyDe.Shallow.Gaussian, ForSyDe.Shallow.Vector,- ForSyDe.Shallow.Memory+ ForSyDe.Shallow.Memory,+ ForSyDe.Shallow.DataflowLib other-modules: Paths_ForSyDe,
Setup.hs view
@@ -53,7 +53,7 @@ forsyde_vhd_dir = (datadir $ absoluteInstallDirs pd lbi cd) </> "lib" modelsimError err = putStrLn $ - "Error: " ++ err ++ "\n" +++ "Warning: " ++ err ++ "\n" ++ " ForSyDe will work, but you will not be able to automatically\n" ++ " compile or simulate the ForSyDe-generated VHDL models with Modelsim\n\n" ++ " In order to fix this, make sure that the Modelsim executables\n" ++
examples/Equalizer_Shallow/ButtonControl.lhs view
@@ -27,9 +27,8 @@ buttonControl overrides bassDn bassUp trebleDn trebleUp = (bass, treble) where (bass, treble) = unzipSY levels- levels = ((holdSY (0.0, 0.0)) `funComb2` levelControl) - button overrides- button = buttonInterface bassDn bassUp trebleDn trebleUp+ levels = holdSY (0.0, 0.0) $ levelControl button overrides + button = buttonInterface bassDn bassUp trebleDn trebleUp \end{code} \subsection{The Process \process{Button Interface}}
src/ForSyDe/AbsentExt.hs view
@@ -20,7 +20,7 @@ isAbsent, isPresent, abstExtFunc) where -import Data.Generics+import Data.Data import Language.Haskell.TH.Lift
src/ForSyDe/Backend/Simulate.hs view
@@ -24,12 +24,11 @@ import ForSyDe.ForSyDeErr import ForSyDe.Process.ProcVal -import Control.Monad (liftM, mapM_, zipWithM_) import Data.Maybe (fromJust) import Control.Monad.ST import Data.STRef import qualified Data.Traversable as DT-import Data.List (lookup, transpose)+import Data.List (transpose) import Data.Dynamic -- | 'simulate' takes a system definition and generates a function
src/ForSyDe/Backend/VHDL/Quartus.hs view
@@ -24,7 +24,6 @@ import System.IO import System.Directory import System.Process-import System.FilePath import Control.Monad.State import System.Exit (ExitCode(..))
src/ForSyDe/Backend/VHDL/Translate.hs view
@@ -35,7 +35,7 @@ import Data.Typeable.TypeRepLib (unArrowT) import Language.Haskell.TH.TypeLib (type2TypeRep) -import Data.Generics (tyconUQname)+import Data.Data (tyconUQname) import Data.Int import Data.Char (digitToInt) import Data.List (intersperse)
src/ForSyDe/Backend/VHDL/Traverse/VHDLM.hs view
@@ -24,7 +24,7 @@ import ForSyDe.Netlist.Traverse (TravSEIO) import ForSyDe.Process.ProcType (EnumAlgTy(..)) -import Data.Generics (tyconModule)+import Data.Data (tyconModule) import Data.Maybe (fromJust) import qualified Data.Set as S (filter) import Data.Set (Set, union, empty, toList)
src/ForSyDe/Bit.hs view
@@ -29,7 +29,7 @@ import Language.Haskell.TH.Lift import Data.Int import Data.Bits-import Data.Generics (Data, Typeable)+import Data.Data (Data, Typeable) import Prelude hiding (not) import Data.Param.FSVec (FSVec, reallyUnsafeVector)
src/ForSyDe/ForSyDeErr.hs view
@@ -42,7 +42,6 @@ import Debug.Trace import Control.Monad.Error import Data.Dynamic-import Data.Typeable import Language.Haskell.TH.Syntax hiding (Loc) import Language.Haskell.TH.Ppr import Language.Haskell.TH.PprLib
src/ForSyDe/Netlist/Traverse.hs view
@@ -31,7 +31,6 @@ import qualified Data.Traversable as DT (Traversable(traverse,mapM)) import Control.Applicative (pure, (<$>)) import Control.Monad.State-import Data.List (lookup) import Control.Monad.ST (ST) -- Instances to traverse a netlist Node (and implicitly the whole netlist)
src/ForSyDe/Process/ProcType.hs view
@@ -20,7 +20,7 @@ import Control.Monad (replicateM) import Data.List (intersperse)-import Data.Generics+import Data.Data import Data.Set (Set, union) import Language.Haskell.TH import Language.Haskell.TH.Syntax (Lift(..))@@ -118,16 +118,16 @@ (map (\n -> varE 'getEnums `appE` undef n) names) getEnumsD = funD 'getEnums [clause [wildP] (normalB getEnumsExpr) []] readProcTypeExpr = doE $ - noBindS [| skipSpaces >> char '(' |] : - (intersperse (noBindS [| skipSpaces >> char ',' |]) + bindS wildP [| skipSpaces >> char '(' |] : + (intersperse (bindS wildP [| skipSpaces >> char ',' |]) (map (\n -> bindS (varP n) [| readProcType |]) names) ++- [noBindS [| skipSpaces >> char ')' |],+ [bindS wildP [| skipSpaces >> char ')' |], noBindS [| return $(tupE $ map varE names) |] ] ) readProcTypeD = funD 'readProcType [clause [] (normalB readProcTypeExpr) []]- procTypeCxt = map (\vName -> conT ''ProcType `appT` varT vName) names ++- map (\vName -> conT ''Data `appT` varT vName) names ++- map (\vName -> conT ''Lift `appT` varT vName) names+ procTypeCxt = map (\vName -> return $ ClassP ''ProcType [VarT vName]) names +++ map (\vName -> return $ ClassP ''Data [VarT vName]) names +++ map (\vName -> return $ ClassP ''Lift [VarT vName]) names instanceD (cxt procTypeCxt) (conT ''ProcType `appT` tupType) [getEnumsD, readProcTypeD]@@ -162,7 +162,7 @@ [toConstr $(varE a)] |] dataTypeOfD = funD 'dataTypeOf [clause [varP a] (normalB dataTypeOfExpr) []]- dataCxt = map (\vName -> conT ''Data `appT` varT vName) names + dataCxt = map (\vName -> return $ ClassP ''Data [VarT vName]) names instanceD (cxt dataCxt) (conT ''Data `appT` tupType) [gfoldlD, gunfoldD, toConstrD, dataTypeOfD]@@ -178,7 +178,7 @@ |] typeOfD = funD 'typeOf [clause [wildP] (normalB typeOfExpr) []]- typeableCxt = map (\vName -> conT ''Typeable `appT` varT vName) names+ typeableCxt = map (\vName -> return $ ClassP ''Typeable [VarT vName]) names instanceD (cxt typeableCxt) (conT ''Typeable `appT` tupType) [typeOfD]@@ -188,7 +188,7 @@ varE 'tupE `appE` listE (map (\n -> varE 'lift `appE` varE n) names) liftD = funD 'lift [clause [tupP (map varP names)] (normalB liftExpr) []]- liftCxt = map (\vName -> conT ''Lift `appT` varT vName) names+ liftCxt = map (\vName -> return $ ClassP ''Lift [VarT vName]) names instanceD (cxt liftCxt) (conT ''Lift `appT` tupType) [liftD]
src/ForSyDe/Process/ProcType/Instances.hs view
@@ -27,7 +27,7 @@ import Data.Param.FSVec (FSVec, reallyUnsafeVector) -import Data.Generics+import Data.Data import Control.Monad (liftM, liftM2, mzero) import Text.ParserCombinators.ReadP import Data.Set (empty, singleton)@@ -81,11 +81,11 @@ getEnums _ = getEnums (undefined :: a) readProcType = do skipSpaces - char '<'+ _ <- char '<' elems <- countSepBy (toInt (undefined :: s)) readProcType (skipSpaces >> char ',' >> skipSpaces)- char '>'+ _ <- char '>' return (reallyUnsafeVector elems) where countSepBy n p sep = if n == 0 @@ -96,9 +96,9 @@ instance ProcType a => ProcType (AbstExt a) where getEnums _ = getEnums (undefined :: a) readProcType = skipSpaces >> (absP <++ prstP)- where absP = do string "Abst" + where absP = do _ <- string "Abst" return Abst- prstP = do string "Prst"+ prstP = do _ <- string "Prst" skipSpaces v <- readProcType return $ Prst v
src/ForSyDe/Shallow/AdaptivityLib.hs view
@@ -11,15 +11,23 @@ -- Adaptivity Library, yet to be completed. -- ------------------------------------------------------------------------------module ForSyDe.Shallow.AdaptivityLib (applyfSY, applyfU) where+module ForSyDe.Shallow.AdaptivityLib (applyfSY, applyf2SY, applyf3SY, + applyfU) where import ForSyDe.Shallow.Signal import ForSyDe.Shallow.SynchronousLib import ForSyDe.Shallow.UntimedLib applyfSY :: Signal (a -> b) -> Signal a -> Signal b-applyfSY = zipWithSY apply- where apply f x = f x+applyfSY = zipWithSY ($)++applyf2SY :: Signal (a -> c -> d) + -> Signal a -> Signal c -> Signal d+applyf2SY = zipWith3SY ($)++applyf3SY :: Signal (a -> c -> d -> e) + -> Signal a -> Signal c -> Signal d -> Signal e+applyf3SY = zipWith4SY ($) applyfU :: Int -> Signal ([a] -> [b]) -> Signal a -> Signal b applyfU tokenNum = comb2UC tokenNum apply
+ src/ForSyDe/Shallow/DataflowLib.hs view
@@ -0,0 +1,436 @@+-----------------------------------------------------------------------------+-- |+-- Module : ForSyDe.Shallow.DataflowLib+-- Copyright : (c) SAM Group, KTH/ICT/ECS 2007-2008+-- License : BSD-style (see the file LICENSE)+-- +-- Maintainer : forsyde-dev@ict.kth.se+-- Stability : experimental+-- Portability : portable+--+-- The dataflow library defines data types, process constructors and+-- functions to model dataflow process networks, as described by Lee and+-- Parks in Dataflow process networks, IEEE Proceedings, 1995 ([LeeParks95]).+--+-- Each process is defined by a set of firing rules and corresponding+-- actions. A process fires, if the incoming signals match a firing+-- rule. Then the process consumes the matched tokens and executes the+-- action corresponding to the firing rule.+--+-----------------------------------------------------------------------------++module ForSyDe.Shallow.DataflowLib+ (+ -- * Data Types + -- | The data type @FiringToken@ defines the data type for tokens. The+ -- constructor @Wild@ constructs a token wildcard, the constructor+ -- @Value a@ constructs a token with value @a@.+ -- + -- A sequence (pattern) matches a signal, if the sequence is a prefix of+ -- the signal. The following list illustrates the firing rules:+ -- + -- * [⊥] matches always (/NullS/ in ForSyDe)+ --+ -- * [*] matches signal with at least one token (/[Wild]/ in ForSyDe)+ --+ -- * [v] matches signal with v as its first value (/[Value v]/ in ForSyDe)+ --+ -- * [*,*] matches signals with at least two tokens (/[Wild,Wild]/ in ForSyDe) + -- + FiringToken(Wild, Value),+ -- * Combinational Process Constructors + -- | Combinatorial processes+ -- do not have an internal state. This means, that the output+ -- signal only depends on the input signals.+ --+ -- To illustrate the concept of data flow processes, we create a process that selects tokens from two inputs according to a control signal. + --+ -- The process has the following firing rules [LeeParks95]:+ --+ -- + -- * R1 = {[*], ⊥, [T]}+ --+ -- * R2 = {⊥, [*], [F]}+ -- + --+ -- The corresponding ForSyDe formulation of the firing rules is:+ --+ -- @+ -- selectRules = [ ([Wild], [], [Value True]),+ -- ([], [Wild], [Value False]) ]+ -- @+ --+ -- For the output we formulate the following set of output functions:+ -- + -- @+ -- selectOutput xs ys _ = [ [headS xs], [headS ys] ]+ -- @+ -- + -- The select process /selectDF/ is then defined by:+ --+ -- @+ -- selectDF :: Eq a => Signal a -> Signal a + -- -> Signal Bool -> Signal a+ -- selectDF = zipWith3DF selectRules selectOutput+ -- @+ --+ -- Given the signals /s1/, /s2/ and /s3/+ --+ -- @+ -- s1 = signal [1,2,3,4,5,6]+ -- s2 = signal [7,8,9,10,11,12]+ -- s3 = signal [True, True, False, False, True, True]+ -- @+ --+ -- the executed process gives the following results:+ --+ -- @ + -- DataflowLib> selectDF s1 s2 s3+ -- {1,2,7,8,3,4} :: Signal Integer+ -- @+ --+ -- The library contains the following combinational process constructors:+ mapDF, zipWithDF, zipWith3DF, + -- * Sequential Process Constructors + -- | Sequential processes have+ -- an internal state. This means, that the output signal may+ -- depend internal state and on the input signal. + -- + -- As an example we can view a process calculating the running sum+ -- of the input tokens. It has only one firing rule, which is+ -- illustrated below.+ --+ -- @+ -- Firing Rule Next State Output+ -- ------------------------------------+ -- (*,[*]) state + x {state}+ -- @+ --+ -- A dataflow process using these firing rules and the initial state 0 can be formulated in ForSyDe as + --+ -- @+ -- rs xs = mealyDF firingRule nextState output initState xs+ -- where + -- firingRule = [(Wild, [Wild])]+ -- nextState state xs = [(state + headS xs)]+ -- output state _ = [[state]]+ -- initState = 0+ -- @+ --+ -- Execution of the process gives+ --+ -- @ + -- DataflowLib> rs (signal[1,2,3,4,5,6])+ -- {0,1,3,6,10,15} :: Signal Integer+ -- @+ -- + -- Another 'running sum' process /rs2/ takes two tokens, pushes+ -- them into a queue of five elements and calculates the sum as+ -- output.+ --+ -- @+ -- rs2 = mealyDF fs ns o init+ -- where + -- init = [0,0,0,0,0]+ -- fs = [(Wild, ([Wild, Wild]))]+ -- ns state xs = [drop 2 state ++ fromSignal (takeS 2 xs)]+ -- o state _ = [[(sum state)]]+ -- @+ -- + -- Execution of the process gives+ --+ -- @+ -- DataflowLib>rs2 (signal [1,2,3,4,5,6,7,8,9,10])+ -- {0,3,10,20,30} :: Signal Integer+ -- @+ scanlDF, mooreDF, mealyDF+ ) where++import ForSyDe.Shallow.CoreLib +++------------------------------------------------------------------------+--+-- DATA TYPES+--+------------------------------------------------------------------------++data FiringToken a = Wild+ | Value a deriving (Eq, Show)+++------------------------------------------------------------------------+--+-- COMBINATIONAL PROCESS CONSTRUCTORS+--+------------------------------------------------------------------------++-- |The process constructor @mapDF@ takes a list of firing rules, a list of corresponding output functions and generates a data flow process with one input and one output signal.+mapDF :: Eq a => [[FiringToken a]] + -> (Signal a -> [[b]]) -> Signal a -> Signal b++mapDF _ _ NullS = NullS +mapDF rs as xs = output +-+ mapDF rs as xs'+ where+ xs' = if matchedRule < 0 then+ NullS+ else+ consumeDF rule xs+ matchedRule = (matchDF rs xs)+ rule = rs !! matchedRule+ output = if matchedRule < 0 then+ NullS+ else+ signal ((as xs) !! matchedRule)+-- |The process constructors @zipWithDF@ takes a list of firing rules, a list of corresponding output functions to generate a data flow process with two input signals and one output signal.+zipWithDF :: (Eq a, Eq b) => + [([FiringToken b], [FiringToken a])] + -> (Signal b -> Signal a -> [[c]]) -> Signal b + -> Signal a -> Signal c++zipWithDF _ _ NullS NullS = NullS+zipWithDF rs as xs ys = output +-+ zipWithDF rs as xs' ys'+ where + (xs', ys') = if matchedRule < 0 then+ (NullS, NullS)+ else+ consume2DF rule xs ys+ matchedRule = (match2DF rs xs ys)+ rule = rs !! matchedRule+ output = if matchedRule < 0 then+ NullS+ else+ signal ((as xs ys) !! matchedRule)++-- |The process constructors @zipWith3DF@ takes a list of firing rules, a list of corresponding output functions to generate a data flow process with three input signals and one output signal.+zipWith3DF :: (Eq a, Eq b, Eq c) => + [([FiringToken a],[FiringToken b],[FiringToken c])] + -> (Signal a -> Signal b -> Signal c -> [[d]]) + -> Signal a -> Signal b -> Signal c -> Signal d+zipWith3DF _ _ NullS NullS NullS = NullS+zipWith3DF rs as xs ys zs = output +-+ zipWith3DF rs as xs' ys' zs'+ where + (xs', ys', zs') = if matchedRule < 0 then+ (NullS, NullS, NullS)+ else+ consume3DF rule xs ys zs+ matchedRule = (match3DF rs xs ys zs)+ rule = rs !! matchedRule+ output = if matchedRule < 0 then+ NullS+ else+ signal ((as xs ys zs) !! matchedRule)+++------------------------------------------------------------------------+--+-- SEQUENTIAL PROCESS CONSTRUCTORS+--+------------------------------------------------------------------------+-- | The process constructor @scanlDF@ implements a finite state machine without output decoder in the ForSyDe methodology. It takes a set of firing rules and a set of corresponding next state functions as arguments. A firing rule is a tuple. The first value is a pattern for the state, the second value corresponds to an input pattern. When a pattern matches, the process fires, the corresponding next state is executed, and the tokens matching the pattern are consumed.+scanlDF :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])] + -> (b -> Signal a -> [b]) + -> b -> Signal a -> Signal b+scanlDF _ _ _ NullS = NullS+scanlDF fs ns state xs = (unitS state) + +-+ scanlDF fs ns state' xs'+ where + xs' = if matchedRule < 0 then+ NullS+ else+ consumeDF rule xs+ matchedRule = matchStDF fs state xs+ rule = snd (fs !! matchedRule)+ state' = if matchedRule < 0 then+ error "No rule matches the pattern!"+ else+ (ns state xs) !! matchedRule++-- | The process constructor @mooreDF@ implements a Moore finite state machine in the ForSyDe methodology. It takes a set of firing rules, a set of corresponding next state functions and a set of output functions as argument. A firing rule is a tuple. The first value is a pattern for the state, the second value corresponds to an input pattern. When a pattern matches, the process fires, the corresponding next state and output functions are executed, and the tokens matching the pattern are consumed.+mooreDF :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])] + -> (b -> Signal a -> [b]) -> (b -> [c]) + -> b -> Signal a -> Signal c+mooreDF _ _ _ _ NullS = NullS+mooreDF fs ns o state xs = output +-+ mooreDF fs ns o state' xs'+ where + xs' = if matchedRule < 0 then+ NullS+ else+ consumeDF rule xs+ matchedRule = matchStDF fs state xs+ rule = snd (fs !! matchedRule)+ output = signal (o state)+ state' = if matchedRule < 0 then+ error "No rule matches the pattern!"+ else+ (ns state xs) !! matchedRule +++-- | The process constructor @mealyDF@ implements the most general state machine in the ForSyDe methodology. It takes a set of firing rules, a set of corresponding next state functions and a set of output functions as argument. A firing rule is a tuple. The first value is a pattern for the state, the second value corresponds to an input pattern. When a pattern matches, the process fires, the corresponding next state and output functions are executed, and the tokens matching the pattern are consumed.+mealyDF :: (Eq a, Eq b) => [(FiringToken b,[FiringToken a])] + -> (b -> Signal a -> [b]) -> (b -> Signal a -> [[c]]) + -> b -> Signal a -> Signal c+mealyDF _ _ _ _ NullS = NullS+mealyDF fs ns o state xs = output +-+ mealyDF fs ns o state' xs'+ where + xs' = if matchedRule < 0 then+ NullS+ else+ consumeDF rule xs+ matchedRule = matchStDF fs state xs+ rule = snd (fs !! matchedRule)+ output = signal ((o state xs) !! matchedRule)+ state' = if matchedRule < 0 then+ error "No rule matches the pattern!"+ else+ (ns state xs) !! matchedRule +++------------------------------------------------------------------------+--+-- SUPPORTING FUNCTIONS+--+------------------------------------------------------------------------++-- The function 'prefixDF' takes a pattern and a signal and returns+-- 'True', if the pattern is a prefix from the signal.+prefixDF :: Eq a => [FiringToken a] -> Signal a -> Bool+prefixDF [] _ = True+prefixDF _ NullS = False+prefixDF (Wild:ps) (_:-xs) = prefixDF ps xs+prefixDF ((Value p):ps) (x:-xs) = if p == x then+ prefixDF ps xs+ else+ False++-- The function 'consumeDF' takes a pattern and a signal and consumes+-- the pattern from the signal. The functions 'consume2DF' and+-- 'consume3DF' work in the same way as 'consumeDF', but with two and+-- three input signals.+consumeDF :: Eq a => [FiringToken a] + -> Signal a -> Signal a+consumeDF _ NullS = NullS +consumeDF [] xs = xs+consumeDF (Wild:ts) (_:-xs) = consumeDF ts xs +consumeDF (Value t:ts) (x:-xs) = if t == x then+ consumeDF ts xs+ else+ error "Tokens not correct"++consume2DF :: (Eq a, Eq b) => + ([FiringToken a], [FiringToken b]) + -> Signal a -> Signal b -> (Signal a, Signal b)+consume2DF (px, py) xs ys = (consumeDF px xs,+ consumeDF py ys)++consume3DF :: (Eq a, Eq b, Eq c) => + ([FiringToken a], [FiringToken b], [FiringToken c]) + -> Signal a -> Signal b -> Signal c + -> (Signal a,Signal b,Signal c)+consume3DF (px, py, pz) xs ys zs = (consumeDF px xs,+ consumeDF py ys,+ consumeDF pz zs)++-- The function 'matchDF' checks, which firing rule, starting from 0, is+-- matched by the input signal. If no firing rule matches, the output is+-- '-1'. The functions 'maptch2S' and 'match3DF' work in the same way+-- for two and three inputs.+matchDF :: (Num a, Eq b) => + [[FiringToken b]] -> Signal b -> a+matchDF rs xs = matchDF' 0 rs xs+ where matchDF' _ [] _ = -1+ matchDF' n (r:rs) xs = if prefixDF r xs then+ n+ else+ matchDF' (n+1) rs xs++match2DF :: (Num a, Eq b, Eq c) => + [([FiringToken b], [FiringToken c])]+ -> Signal b -> Signal c -> a+match2DF rs xs ys = match2DF' 0 rs xs ys+ where match2DF' _ [] _ _ = -1+ match2DF' n ((rx, ry):rs) xs ys+ = if prefixDF rx xs &&+ prefixDF ry ys + then+ n+ else+ match2DF' (n+1) rs xs ys++match3DF :: (Num a, Eq b, Eq c, Eq d) => + [([FiringToken b], [FiringToken d], [FiringToken c])]+ -> Signal b -> Signal d -> Signal c -> a+match3DF rs xs ys zs = match3DF' 0 rs xs ys zs+ where match3DF' _ [] _ _ _ = -1 + match3DF' n ((rx, ry, rz):rs) xs ys zs + = if prefixDF rx xs &&+ prefixDF ry ys &&+ prefixDF rz zs + then+ n+ else+ match3DF' (n+1) rs xs ys zs ++-- The function 'matchStDF' works in the same way as 'matchDF', but it looks on patterns that include the state.+matchStDF :: (Num a, Eq b, Eq c) => + [(FiringToken c,[FiringToken b])] + -> c -> Signal b -> a+matchStDF rs state xs = matchStDF' 0 rs state xs+ where matchStDF' _ [] _ _ = -1+ matchStDF' n (r:rs) state xs + = if prefixDF (snd r) xs && + matchState (fst r) state+ then+ n+ else+ matchStDF' (n+1) rs state xs + +matchState :: Eq a => FiringToken a -> a -> Bool+matchState Wild _ = True+matchState (Value v) x = x == v ++++------------------------------------------------------------------------+--+-- CODE FOR TESTING+--+------------------------------------------------------------------------+++selectRules = [ ([Wild], [], [Value True]),+ ([], [Wild], [Value False]) ]+++selectOutput xs ys _ = [ [headS xs], [headS ys] ]++selectDF :: Eq a => Signal a -> Signal a + -> Signal Bool -> Signal a+selectDF = zipWith3DF selectRules selectOutput++++s1 = signal [1,2,3,4,5,6]+s2 = signal [7,8,9,10,11,12]+s3 = signal [True, True, False, False, True, True]++rs xs = mealyDF firingRule nextState output initState xs+ where firingRule = [(Wild, [Wild])]+ nextState state xs = [(state + headS xs)]+ output state _ = [[state]]+ initState = 0++rs2 = mealyDF fs ns o init+ where init = [0,0,0,0,0]+ fs = [(Wild, ([Wild, Wild]))]+ ns state xs = [drop 2 state ++ fromSignal (takeS 2 xs)]+ o state _ = [[(sum state)]]+++++++++
src/ForSyDe/Shallow/MoCLib.hs view
@@ -27,6 +27,7 @@ module ForSyDe.Shallow.StochasticLib, module ForSyDe.Shallow.CTLib, module ForSyDe.Shallow.UntimedLib,+ module ForSyDe.Shallow.DataflowLib, module ForSyDe.Shallow.DomainInterfaces ) where @@ -36,3 +37,4 @@ import ForSyDe.Shallow.UntimedLib import ForSyDe.Shallow.DomainInterfaces import ForSyDe.Shallow.SynchronousProcessLib+import ForSyDe.Shallow.DataflowLib
src/ForSyDe/System/SysDef.hs view
@@ -31,7 +31,6 @@ import ForSyDe.System.SysFun (checkSysFType, SysFun(..)) import Data.Maybe (isJust, fromJust)-import Control.Monad.Error import Control.Monad.ST import Control.Monad.State import Data.Typeable
src/ForSyDe/System/SysFun.hs view
@@ -30,7 +30,6 @@ import Language.Haskell.TH.TypeLib import Data.Dynamic-import Control.Monad (when, liftM3) import Text.Regex.Posix ((=~)) import qualified Language.Haskell.TH as TH (Exp) import Language.Haskell.TH@@ -222,7 +221,7 @@ where accumApp accumT vName = accumT `appT` (conT ''Signal `appT` varT vName) -- Create the ProcType context- procTypeCxt = map (\vName -> conT ''ProcType `appT` varT vName) outNames+ procTypeCxt = map (\vName -> return $ ClassP ''ProcType [VarT vName]) outNames -- Finally return the instance declaration sysFunIns = instanceD (cxt procTypeCxt)
src/Language/Haskell/TH/Lift.hs view
@@ -19,9 +19,9 @@ module Language.Haskell.TH.Lift (deriveLift1, deriveLift) where import GHC.Exts-import Data.PackedString import Language.Haskell.TH import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Syntax.Internals import Control.Monad (liftM) modName :: String@@ -59,10 +59,13 @@ case i of TyConI (DataD dcxt _ vs cons _) -> let ctxt = liftM (++ dcxt) $ - cxt [conT ''Lift `appT` varT v | v <- vs] - typ = foldl appT (conT n) $ map varT vs+ cxt [return $ ClassP ''Lift [VarT v'] | v' <- vs']+ typ = foldl appT (conT n) $ map varT vs' fun = funD 'lift (map doCons cons)+ vs' = map (\(PlainTV v) -> v) vs in instanceD ctxt (conT ''Lift `appT` typ) [fun]+ --do sh<-instanceD ctxt (conT ''Lift `appT` typ) [fun]+ -- error (pprint sh) _ -> error (modName ++ ".deriveLift: unhandled: " ++ pprint i) doCons :: Con -> Q Clause@@ -81,8 +84,17 @@ instance Lift Name where lift (Name occName nameFlavour) = [| Name occName nameFlavour |] -instance Lift PackedString where- lift ps = [| packString $(lift $ unpackPS ps) |]+instance Lift OccName where+ lift (OccName str) = [| OccName str |]+ +instance Lift ModName where+ lift (ModName str) = [| ModName str |]+ +instance Lift PkgName where+ lift (PkgName str) = [| PkgName str |]++--instance Lift PackedString where+-- lift ps = [| packString $(lift $ unpackPS ps) |] instance Lift NameFlavour where lift NameS = [| NameS |]
src/Language/Haskell/TH/LiftInstances.hs view
@@ -43,9 +43,14 @@ Dec, Exp(LitE), Q,- Lift(..))+ Lift(..),+ Pred,+ TyVarBndr,+ Kind,+ FamFlavour,+ Pragma,+ InlineSpec) -import Control.Monad (mapM) import Data.Ratio (Ratio) import Data.Int (Int8, Int16, Int32, Int64) @@ -67,8 +72,14 @@ ''Clause, ''Type, ''Dec, - ''Exp])-+ ''Exp,+ ''Pred,+ ''TyVarBndr,+ ''Kind,+ ''FamFlavour,+ ''Pragma,+ ''InlineSpec])+ instance Lift Int64 where lift x = return (LitE (IntegerL (fromIntegral x)))
src/Language/Haskell/TH/TypeLib.hs view
@@ -33,15 +33,14 @@ where import Data.Dynamic-import Data.Typeable-import Language.Haskell.TH (Type(..), Cxt, Name, pprint, mkName)+import Language.Haskell.TH (Type(..), Cxt, TyVarBndr(..), pprint, mkName) import Text.Regex.Posix ((=~)) import Data.Maybe(isJust) -- Due to type translations import GHC.Exts (RealWorld) import Data.Word (Word, Word8, Word16, Word32, Word64)-import Data.Int (Int, Int8, Int16, Int32, Int64)+import Data.Int (Int8, Int16, Int32, Int64) import System.IO (Handle) import Data.IORef (IORef) import Foreign (Ptr, FunPtr, StablePtr, ForeignPtr)@@ -68,15 +67,15 @@ -- where @a@ and @b@ are the the context variables and -- @(Show a, Show b)@ are the context constraints data Context = Context - [Name] -- Variable names - Cxt -- Constraints (the context itself)+ [TyVarBndr] -- Variable names + Cxt -- Constraints (the context itself) instance Show Context where -- FIXME: this is really ugly, refactor and improve its look- showsPrec _ (Context n cxt) = - showVars n . showConstraints cxt - where showVars n = showForall (not (null n)) (showVars' n)- showVars' (n:ns) = shows n . showChar ' ' . showVars' ns+ showsPrec _ (Context tvb cxt) = + showVars tvb . showConstraints cxt + where showVars tvb = showForall (not (null tvb)) (showVars' tvb)+ showVars' ((PlainTV n):tvbs) = shows n . showChar ' ' . showVars' tvbs showVars' [] = id showConstraints c = (\s -> if not (null c) then ' ':s else s). showParen (length c > 1) (showConstraints' c) .@@ -89,8 +88,8 @@ else s -- | 'Context' constructor-mkContext :: [Name] -> Cxt -> Context-mkContext n c = Context n c+mkContext :: [TyVarBndr] -> Cxt -> Context+mkContext tvb c = Context tvb c -- | Empty context for monomorphic types monoContext :: Context@@ -102,8 +101,8 @@ isPoly _ = True -- | Returns the variable names related to a context-contextVarNames :: Context -> [Name]-contextVarNames (Context n _) = n+contextVarNames :: Context -> [TyVarBndr]+contextVarNames (Context tvb _) = tvb -- | Returns the context constraints contextConstraints :: Context -> Cxt@@ -111,7 +110,7 @@ -- | Builds a 'ForallT' type out of a context and a type mkForallT :: Context -> Type -> Type-mkForallT (Context n cxt) t = ForallT n cxt t+mkForallT (Context tvb cxt) t = ForallT tvb cxt t -------------------------------- -- Functions to observe a 'Type'