lambda-devs (empty) → 0.3.1
raw patch · 12 files changed
+827/−0 lines, 12 filesdep +basedep +binarydep +containerssetup-changed
Dependencies added: base, binary, containers, dimensional, distributed-process, lambda-devs, numtype
Files
- Data/DEVS.hs +35/−0
- Data/DEVS/Devs.hs +184/−0
- Data/DEVS/Simulation.hs +39/−0
- Data/DEVS/Simulation/Coordinator.hs +84/−0
- Data/DEVS/Simulation/Infinite.hs +38/−0
- Data/DEVS/Simulation/Processor.hs +101/−0
- Data/DEVS/Simulation/Simulator.hs +64/−0
- Example.hs +137/−0
- LICENSE +27/−0
- README.md +4/−0
- Setup.hs +2/−0
- lambda-devs.cabal +112/−0
+ Data/DEVS.hs view
@@ -0,0 +1,35 @@+{-+Copyright (c) 2013, Markus Barenhoff <alios@alios.org>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-}++module Data.DEVS + ( module Data.DEVS.Devs+ , module Data.DEVS.Simulation+ ) where++import Data.DEVS.Devs+import Data.DEVS.Simulation
+ Data/DEVS/Devs.hs view
@@ -0,0 +1,184 @@+{-+Copyright (c) 2013, Markus Barenhoff <alios@alios.org>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-}++{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ExistentialQuantification #-}+++-- | The /Discrete Event System Sepcification (DEVS)/ formalism defines+-- discrete event simulation models in a hierachical, modular manner.+module Data.DEVS.Devs + ( -- * Parallel DEVS+ PDEVS (..)+ -- * Time base + , T, t_infinity+ -- * AtomicModel + , AtomicModel (..)+ -- * CoupledModel+ , CoupledModel (..), ComponentRef, Z (..)+ -- * References+ -- $references+ ) where++import Data.Binary+import Data.Typeable (Typeable, cast)+import Data.Set (Set)+import Data.Map (Map)+import Data.Maybe (isJust)+import qualified Data.Map as Map+import qualified Data.Set as Set++import qualified Prelude as P+import Numeric.Units.Dimensional.Prelude+import Data.DEVS.Simulation.Infinite++-- | The 'Time' type 'T' used in "Data.DEVS"+type T = Time Double++-- | the inifinite time+t_infinity :: T+t_infinity = infinity *~ second++-- | The /Parallel DEVS (P-DEVS)/ Model [PDEVS94].+class (Typeable m, Ord m, Show m) => PDEVS m where+ type X m :: * + type Y m :: *+ data S m :: *++ -- | the models initial state+ s0 :: m -> S m++ -- | the internal transition function+ delta_int :: m -- ^ the model+ -> S m -- ^ the current state+ -> S m -- ^ the new state++ -- | the external transition function+ delta_ext :: m -- ^ the model + -> S m -- ^ the current state+ -> T -- ^ the current time+ -> Set (X m) -- ^ the set of input events at current time+ -> S m -- ^ the new state++ -- | the confluent transition function+ delta_con :: m -- ^ the model + -> S m -- ^ the current state+ -> Set (X m) -- ^ the set of input events at current time+ -> S m -- ^ the new state++ -- | the output function of the model.+ lambda :: m -- ^ the model + -> S m -- ^ the current state+ -> Y m -- ^ the output++ -- | the time advance function+ ta :: m -- ^ the model + -> S m -- ^ the current state+ -> T -- ^ the time of next internal event++ -- | a reference to the model it self as a component of a 'CoupledModel'.+ selfRef :: m -> ComponentRef+ selfRef m = MkComponentRef m++-- | A 'PDEVS' model which does not have furter 'ComponentRef's+class (PDEVS m) => AtomicModel m++-- | A 'PDEVS' model which is composed out of other 'AtomicModel' or 'CoupledModel'+class (PDEVS d) => CoupledModel d where+ -- | the set of 'CoupledModel's components+ componentRefs :: d -> Set ComponentRef++ -- | the map of influencers, for all components in 'componentRefs'+ compInfluencers :: d -> Map ComponentRef (Set ComponentRef)+ + -- | the influencers of the model it self+ selfInfluencers :: d -> Set ComponentRef+ + -- | the map of influencers, for all components in 'componentRefs' and self+ influencers :: d -> Map ComponentRef (Set ComponentRef)+ influencers d =+ let crefs' = compInfluencers d+ crefs_no_self = case (Map.lookup (selfRef d) crefs') of+ Nothing -> crefs'+ Just _ -> error $ "compInfluencers of " ++ show d ++ + " must not contain a reference to the model it self"+ x = Set.map f $ componentRefs d+ f r = isJust $ Map.lookup r $ crefs'+ y = Set.fold (&&) True x+ crefs = if (y) then crefs_no_self else + error $ "compInfluencers of " ++ show d ++ " must contain an entry " +++ "for every Component in componentRefs"+ allinfs = Map.insert (selfRef d) (selfInfluencers d) crefs+ in allinfs+ +-- | a Reference to a 'PDEVS' component hiding its model+data ComponentRef = forall m . (PDEVS m) => MkComponentRef m++-- | a @i@-to-@j@ output translation used for coupleing the components of a 'CoupledModel'.+--+-- [@ExtCoup@] external coupling (translate 'CoupledModel' @i@ input to component @j@ input)+--+-- [@IntCoup@] internal coupling (translate component @i@ output to component @j@ input)+--+-- [@OutCoup@] internal coupling (translate component @i@ output to 'CoupledModel' @j@ output)+data Z i j where+ ExtCoup :: ((X i) -> (X j)) + -> Z i j+ IntCoup :: ((Y i) -> (X j)) + -> Z i j+ OutCoup :: ((Y i) -> (Y j)) -> Z i j+++-- $references+-- * [PDEVS94] Chow, A.C.; Zeigler, B.P., /Parallel DEVS: a parallel, hierarchical, modular modeling formalism/, Simulation Conference Proceedings, 1994. Winter, pp.716,722, 11-14 Dec. 1994, URL: <http://www.bgc-jena.mpg.de/~twutz/devsbridge/pub/chow96_parallelDEVS.pdf>++++instance Eq (ComponentRef) where+ (MkComponentRef m1) == (MkComponentRef m2) =+ case (cast m2) of+ Nothing -> False+ Just m2' -> m1 == m2'++instance Ord (ComponentRef) where+ compare (MkComponentRef m1) (MkComponentRef m2) =+ case (cast m2) of + Nothing -> compare (show m1) (show m2)+ Just m2' -> compare m1 m2'++instance Show (ComponentRef) where+ show (MkComponentRef m) = "MkComponentRef (" ++ show m ++ ")"++instance Binary T where+ put = (put :: Time Double -> Put)+ get = (get :: Get (Time Double))+++
+ Data/DEVS/Simulation.hs view
@@ -0,0 +1,39 @@+{-+Copyright (c) 2013, Markus Barenhoff <alios@alios.org>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-}++module Data.DEVS.Simulation+ ( module Data.DEVS.Simulation.Processor+ , module Data.DEVS.Simulation.Simulator+ , module Data.DEVS.Simulation.Coordinator+ ) where+++import Data.DEVS.Simulation.Processor+import Data.DEVS.Simulation.Simulator+import Data.DEVS.Simulation.Coordinator+
+ Data/DEVS/Simulation/Coordinator.hs view
@@ -0,0 +1,84 @@+{-+Copyright (c) 2013, Markus Barenhoff <alios@alios.org>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-}++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Data.DEVS.Simulation.Coordinator ( Coordinator, Processor (..)) where++import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Typeable +import Data.DEVS.Devs+import Data.DEVS.Simulation.Processor+import Control.Distributed.Process++data Coordinator deriving (Typeable)+++instance ProcessorType Coordinator+++instance Processor Coordinator where+ data ProcessorConf Coordinator = + CoordinatorConf { coord_compConfs :: forall t . (ProcessorType t)+ => Map (ProcessorModelT t) (ProcessorConf t) + }+ defaultProcessorConf = + CoordinatorConf { coord_compConfs = Map.empty+ }+++ data ProcessorState Coordinator = + CoordinatorState { coord_model :: ProcessorModelT Coordinator + , coord_procs :: [ProcessorT]+ }+ ++++ mkProcessor conf' (PM m' mconf) =+ let conf = maybe conf' id mconf+ m = maybe (error $ "mkProcessor of Coordinator must be called with a CoupledModel") id+ (cast m') ++ in do + proc_say conf $ "creating Coordinator for model " ++ show m+ return . MkProcessorT $ CoordinatorState {+ coord_model = m,+ coord_procs = []+ }+ +
+ Data/DEVS/Simulation/Infinite.hs view
@@ -0,0 +1,38 @@+{-+Copyright (c) 2013, Markus Barenhoff <alios@alios.org>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-}++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.DEVS.Simulation.Infinite where++class HasInfinite s where+ infinity :: s ++instance (RealFloat f) => HasInfinite f where+ infinity = encodeFloat (floatRadix 0 - 1) (snd $ floatRange 0)
+ Data/DEVS/Simulation/Processor.hs view
@@ -0,0 +1,101 @@+{-+Copyright (c) 2013, Markus Barenhoff <alios@alios.org>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-}++{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Data.DEVS.Simulation.Processor + (ProcessorType (..), Processor (..), ProcessorT (..), ProcessorModelT (..), ProcessorModel (..)) where++import Data.Typeable (Typeable, cast)+import Control.Distributed.Process+import Control.Distributed.Process.Serializable++import Data.DEVS.Devs+++class ProcessorType p + +++-- | a processor runs a model during simulation+class Processor p where+ data ProcessorConf p :: *+ data ProcessorState p :: *++ -- | returns the processors default configuration+ defaultProcessorConf :: ProcessorConf p++ -- | start a new processor with given config.+ mkProcessor :: ProcessorConf p -> ProcessorModelT p -> Process ProcessorT++ -- | start a new processor with default config.+ mkDefaultProcessor :: ProcessorModelT p -> Process ProcessorT+ mkDefaultProcessor = mkProcessor defaultProcessorConf++ -- | let the processor say a message + proc_say :: ProcessorConf p -> String -> Process ()+ proc_say c msg = do say $ msg++ -- | error: will output error message and call 'fail'+ proc_fail :: ProcessorConf p -> String -> Process ()+ proc_fail c err = do proc_say c err ; fail err++-- | a 'Model' which is suitable to be used in a 'Processor'+class (PDEVS m, Serializable (X m), Serializable (Y m), ProcessorType p) => + ProcessorModel p m | m -> p where+ procModelWith :: Maybe (ProcessorConf p) -> m -> ProcessorModelT p+ procModelWith conf m = PM m conf+ procModel :: m -> ProcessorModelT p+ procModel = procModelWith Nothing+++data ProcessorT = forall p . MkProcessorT (ProcessorState p)++data ProcessorModelT p = forall m . (ProcessorModel p m ) => + PM { proc_model :: m+ , proc_conf :: Maybe (ProcessorConf p)+ }+ deriving (Typeable)++instance Show (ProcessorModelT p) where+ show (PM m _) = show m++instance Eq (ProcessorModelT p) where+ (PM a _) == (PM b _) = case (cast b) of+ Nothing -> False+ Just b' -> a == b'+ +instance Ord (ProcessorModelT p) where+ compare (PM a _) (PM b _) = case (cast b) of+ Nothing -> compare (show a) (show b)+ Just b' -> compare a b'
+ Data/DEVS/Simulation/Simulator.hs view
@@ -0,0 +1,64 @@+{-+Copyright (c) 2013, Markus Barenhoff <alios@alios.org>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-}++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}++module Data.DEVS.Simulation.Simulator+ ( Simulator, Processor (..)) where++import Data.Typeable (Typeable, cast)+import Control.Distributed.Process+import qualified Prelude as P+import Numeric.Units.Dimensional.Prelude+import Data.DEVS.Simulation.Processor+++data Simulator deriving (Typeable)++instance ProcessorType Simulator++instance Processor Simulator where+ data ProcessorConf Simulator = SimulatorConf {}+ data ProcessorState Simulator = + SimulatorState { sim_model :: ProcessorModelT Simulator }+ + defaultProcessorConf = SimulatorConf+ mkProcessor conf (PM m' mconf) = + let m = maybe + (error $ "mkProcessor of Simulator must be called with an AtomicModel.") id+ (cast m') + in do+ proc_say conf $ "creating Simulator for model " ++ show m+ return . MkProcessorT $ SimulatorState+ { sim_model = m }+ +
+ Example.hs view
@@ -0,0 +1,137 @@+module Main where++import Data.DEVS.Simulation+import Example.Ship++++{- ++--+-- SHIP +--+data Ship = Ship {+ ship_mass :: Mass Double,+ ship_init_x :: Length Double,+ ship_init_y :: Length Double,+ ship_engine :: Engine+} deriving (Typeable)++data ShipCmd = ShipSetSpeed (Velocity Double) | ShipSetHeading (PlaneAngle Double)+ deriving (Eq, Ord)+data ShipEvent = ShipEventEngines Bool++instance Model Ship where+ type X Ship = ShipCmd+ type Y Ship = ShipEvent+ data S Ship = + ShipState {+ ship_x :: Length Double,+ ship_y :: Length Double,+ ship_bearing :: PlaneAngle Double,+ ship_vx :: Velocity Double,+ ship_vy :: Velocity Double,+ ship_thrust :: Thrust Double,+ ship_set_hdg :: PlaneAngle Double,+ ship_set_v :: Velocity Double+ }+ s0 ship = ShipState + { ship_x = ship_init_x ship+ , ship_y = ship_init_y ship+ , ship_bearing = 0 *~ degree+ , ship_vx = 0 *~ (meter / second)+ , ship_vy = 0 *~ (meter / second)+ , ship_thrust = 0 *~ (newton)+ , ship_set_hdg = 0 *~ degree+ , ship_set_v = 0 *~ (meter / second)+ }++instance DEVS Ship where+ lambda m s = undefined --ShipEventEngines (ship_v s == ship_set_v s)+ ta m s = t_infinity+ delta_int m s = s+ delta_ext m s t xs =+ let a = ((ship_thrust s) / (ship_mass m))+ ax = a * cos (ship_bearing s) + ay = a * sin (ship_bearing s)+ s' = s { ship_vx = ship_vx s + (ax * t)+ , ship_vy = ship_vy s + (ay * t)+ , ship_x = ship_x s + (ship_vx s * t)+ , ship_y = ship_y s + (ship_vy s * t)+ } + in s+ delta_con m s xs = undefined++++--x = f / m++eng1 = Engine { engine_a = 1000 *~ newton, engine_rate = 13 *~ (liter / minute)}+eng1_sim = engineSim eng1+ +instance CoupledModel Ship++--+-- TANK+--++++instance DEVS Tank where+ +++++++instance ProcessorModel Tank where+--+-- ENGINE +--++data Engine = Engine {+ engine_a :: Thrust Double,+ engine_rate :: FlowRate Double+ } deriving (Typeable)++data EngineCmd = EngineEnable | EngineDisable+ deriving (Ord, Eq)++instance Binary EngineCmd where++data EngineEvent = EngineEventThrust (Thrust Double)+ deriving (Typeable)++instance Binary EngineEvent where++instance Model Engine where+ type X Engine = EngineCmd+ type Y Engine = EngineEvent+ data S Engine =+ EngineState {+ engine_enabled :: Bool+ }+ s0 _ = EngineState { engine_enabled = False }++instance DEVS Engine where+ lambda m s = EngineEventThrust $ + if (engine_enabled s) + then engine_a m+ else 0 *~ newton+ delta_int _ s = s+ delta_ext m s t xs = delta_con m s xs+ delta_con m s xs =+ let es = engine_enabled s+ sw = Set.member (if es then EngineDisable else EngineEnable) xs+ es' = if sw then not es else es+ in s { engine_enabled = es' }+ ta m _ = t_infinity++instance ProcessorModel Engine where+++engineSim :: Engine -> Simulator Engine+engineSim = mkSimulator++-}
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2013, Markus Barenhoff <alios@alios.org>+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice, this+ list of conditions and the following disclaimer in the documentation and/or+ other materials provided with the distribution.++* Neither the name of the {organization} nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,4 @@+lambda-devs+===========++a Paralell-DEVS implementaion based on distributed-process
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lambda-devs.cabal view
@@ -0,0 +1,112 @@+-- Initial lambda-devs.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: lambda-devs++-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.3.1+stability: alpha++-- A short (one-line) description of the package.+synopsis: a Paralell-DEVS implementaion based on distributed-process+description: The Discrete Event System Sepcification (DEVS) formalism+ defines discrete event simulation models in a hierachical, + modular manner.+-- A longer description of the package.+-- description: ++-- URL for the project homepage or repository.+homepage: http://github.com/alios/lambda-devs++-- The license under which the package is released.+license: BSD3++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: Markus Barenhoff++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer: alios@alios.org++-- A copyright notice.+-- copyright: ++category: Control, Simulation++build-type: Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+extra-source-files: README.md, LICENSE++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.10++tested-with: GHC == 7.6.3+++source-repository head+ type: git+ location: https://github.com/alios/lambda-devs.git+++library+ -- Modules exported by the library.+ exposed-modules: Data.DEVS, + Data.DEVS.Devs+ Data.DEVS.Simulation + Data.DEVS.Simulation.Processor+ Data.DEVS.Simulation.Simulator + Data.DEVS.Simulation.Coordinator+ + -- Modules included in this library but not exported.+ other-modules: Data.DEVS.Simulation.Infinite++ + -- LANGUAGE extensions used by modules in this package.+ other-extensions: MultiParamTypeClasses,+ DeriveDataTypeable,+ GADTs,+ TypeFamilies, + FlexibleInstances,+ FlexibleContexts,+ UndecidableInstances,+ ExistentialQuantification,+ FunctionalDependencies++ + -- Other library packages from which modules are imported.+ build-depends: base >=4.6 && <= 5, + binary >=0.5, + containers >=0.5, + distributed-process >=0.4,+ dimensional >= 0.12+ + -- Directories containing source files.+ -- hs-source-dirs: + + -- Base language which the package is written in.+ default-language: Haskell2010+ +executable lambda-devs-example+ main-is: Example.hs+ build-depends: base >= 4.6 && <= 5,+ binary >= 0.5,+ containers >= 0.5,+ distributed-process >= 0.4,+ lambda-devs >= 0.3,+ numtype >= 1.0,+ dimensional >= 0.12+++ default-language: Haskell2010+