packages feed

SNet (empty) → 0.1.0

raw patch · 17 files changed

+907/−0 lines, 17 filesdep +basedep +bindings-DSLdep +containersbuild-type:Customsetup-changed

Dependencies added: base, bindings-DSL, containers, data-default, lens, mtl, transformers

Files

+ LICENSE.LESSER view
@@ -0,0 +1,165 @@+                  GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++  This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++  0. Additional Definitions. ++  As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++  "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++  An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++  A "Combined Work" is a work produced by combining or linking an+Application with the Library.  The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++  The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++  The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++  1. Exception to Section 3 of the GNU GPL.++  You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++  2. Conveying Modified Versions.++  If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++   a) under this License, provided that you make a good faith effort to+   ensure that, in the event an Application does not supply the+   function or data, the facility still operates, and performs+   whatever part of its purpose remains meaningful, or++   b) under the GNU GPL, with none of the additional permissions of+   this License applicable to that copy.++  3. Object Code Incorporating Material from Library Header Files.++  The object code form of an Application may incorporate material from+a header file that is part of the Library.  You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++   a) Give prominent notice with each copy of the object code that the+   Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the object code with a copy of the GNU GPL and this license+   document.++  4. Combined Works.++  You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++   a) Give prominent notice with each copy of the Combined Work that+   the Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the Combined Work with a copy of the GNU GPL and this license+   document.++   c) For a Combined Work that displays copyright notices during+   execution, include the copyright notice for the Library among+   these notices, as well as a reference directing the user to the+   copies of the GNU GPL and this license document.++   d) Do one of the following:++       0) Convey the Minimal Corresponding Source under the terms of this+       License, and the Corresponding Application Code in a form+       suitable for, and under terms that permit, the user to+       recombine or relink the Application with a modified version of+       the Linked Version to produce a modified Combined Work, in the+       manner specified by section 6 of the GNU GPL for conveying+       Corresponding Source.++       1) Use a suitable shared library mechanism for linking with the+       Library.  A suitable mechanism is one that (a) uses at run time+       a copy of the Library already present on the user's computer+       system, and (b) will operate properly with a modified version+       of the Library that is interface-compatible with the Linked+       Version. ++   e) Provide Installation Information, but only if you would otherwise+   be required to provide such information under section 6 of the+   GNU GPL, and only to the extent that such information is+   necessary to install and execute a modified version of the+   Combined Work produced by recombining or relinking the+   Application with a modified version of the Linked Version. (If+   you use option 4d0, the Installation Information must accompany+   the Minimal Corresponding Source and Corresponding Application+   Code. If you use option 4d1, you must provide the Installation+   Information in the manner specified by section 6 of the GNU GPL+   for conveying Corresponding Source.)++  5. Combined Libraries.++  You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++   a) Accompany the combined library with a copy of the same work based+   on the Library, uncombined with any other library facilities,+   conveyed under the terms of this License.++   b) Give prominent notice with the combined library that part of it+   is a work based on the Library, and explaining where to find the+   accompanying uncombined form of the same work.++  6. Revised Versions of the GNU Lesser General Public License.++  The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++  Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++  If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ SNet.cabal view
@@ -0,0 +1,71 @@+Name:                SNet+Version:             0.1.0++Homepage:            http://www.snet-home.org/+Bug-Reports:         https://github.com/merijn/SNet2.0/issues++Author:              Merijn Verstraaten+Maintainer:          Merijn Verstraaten <m.e.verstraaten@uva.nl>+Copyright:           Copyright © 2012 Merijn Verstraaten++License:             LGPL-3+License-File:        LICENSE.LESSER++Category:            Language+Cabal-Version:       >= 1.10+Build-Type:          Custom+Tested-With:         GHC == 7.6.1++Extra-Source-Files:  SNet/Interfaces/CHandle.h+Extra-Tmp-Files:     SNet/Interfaces/CHandle.hsc++Synopsis:            Declarative coördination language for streaming networks.++Description:+    S-Net is a declarative coördination language for describing streaming+    networks of asynchronous components. Streaming networks are defined using+    an expression language of four network combinators: serial composition,+    parallel composition, serial replication and parallel replication. One-shot+    data synchronisation is provided by the built-in syncrocell component.+    .+    Streams are associated with record types; collections of data where each+    item is uniquely identified by its name. Structural subtyping on these+    record types directs the flow of data through the streaming network.+    .+    For more information see: <http://www.snet-home.org>++Library+  Default-Language:    Haskell2010+  Ghc-Options:         -Wall -fno-warn-unused-do-bind+  Exposed-Modules:     SNet+  Other-Modules:       SNet.Combinators+                       SNet.Interfaces+                       SNet.Interfaces.C+                       SNet.Interfaces.CHandle+                       SNet.Network+                       SNet.Pattern+                       SNet.Record+                       SNet.Stream+                       SNet.Task+                       SNet.Types+                       SNet.Variants++  Build-Tools:         c2hsc          >= 0.6.2+             ,         hsc2hs++  Build-Depends:       base           >= 4.5 && < 5.0+               ,       bindings-DSL   == 1.0.*+               ,       containers     >= 0.4.2+               ,       data-default   == 0.5.*+               ,       lens           == 2.9.*+               ,       mtl            == 2.1.*+               ,       transformers   == 0.3.*++  C-Sources:           SNet/Interfaces/C-out.c+  Cc-Options:          -std=c99+  Include-Dirs:        SNet/Interfaces/+  Install-Includes:    SNet/Interfaces/CHandle.h++Source-Repository head+  Type:     git+  Location: git://git@github.com:merijn/SNet2.0.git
+ SNet.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE DataKinds #-}+module SNet+  ( runSNet+  , module SNet.Interfaces+  , Variants (..)+  , VariantMap (..)+  , Pattern (..)+  , RecEntry (..)+  , CInt (..)+  , syncro+  , box+  , (-->)+  , (!!)+  , parallel+  , (*)+  ) where++import Prelude hiding ((!!), (*))++import Control.Concurrent+import Control.Exception+import Control.Monad+import Control.Monad.Trans+import Control.Monad.Trans.State++import Data.Default+import Foreign.C.Types+import System.IO.Error++import SNet.Interfaces++import SNet.Combinators+import SNet.Network+import SNet.Pattern+import SNet.Record+import SNet.Stream+import SNet.Task+import SNet.Variants++globOut :: MonadIO m => MVar () -> m Stream+globOut stop = task_ (liftIO . print) (liftIO $ putMVar stop ())++globIn :: MVar () -> Stream -> IO ()+globIn stop output = do+    forever $+      handle eof $ do+        rec <- readLn :: IO (Record Data)+        writeStream output rec+  where eof e = if isEOFError e+                   then takeMVar stop+                   else ioError e++runSNet :: SNet -> IO ()+runSNet net = do+    stopMVar <- newEmptyMVar+    input <- evalStateT (globOut stopMVar >>= net) def+    globIn stopMVar input
+ SNet/Combinators.hs view
@@ -0,0 +1,70 @@+module SNet.Combinators+  ( (-->)+  , (!!)+  , parallel+  , (*)+  ) where++import Prelude hiding (lookup, (!!), (*), mapM)++import Control.Applicative+import Control.Monad hiding (mapM)+import Control.Monad.Trans.State++import Data.Default+import Data.Traversable+import qualified Data.Map as Map++import Foreign.C.Types++import SNet.Record hiding (lookup, insert)+import SNet.Network+import SNet.Pattern+import SNet.Variants+import SNet.Stream+import SNet.Task++(-->) :: SNet -> SNet -> SNet+(-->) = (<=<)++(!!) :: SNet -> RecEntry CInt -> SNet+(!!) net tag output = do+    openStream output+    task Map.empty+         (\rec -> do+            let i = rec ! tag+            stream <- gets (Map.lookup i) `onNothing` spawnChild i+            writeStream stream rec)+         (do gets Map.elems >>= mapM_ closeStream+             closeStream output)+  where spawnChild i = do (stream, _) <- spawnSNet net def output+                          modify $ Map.insert i stream+                          return stream++parallel :: VariantMap ps SNet -> SNet+parallel branchList output = do+    outputs <- mapM spawnNet branchList+    task_ (\rec -> writeStream (getBestMatch outputs rec) rec)+          (void $ mapM closeStream outputs)+  where spawnNet net = fst <$> spawnSNet net def output++(*) :: SNet -> Pattern p -> SNet+(*) net pattern output = do+    openStream output+    task Nothing+        (\rec -> case match pattern rec of+            Just _ -> writeStream output rec+            Nothing -> do new <- get `onNothing` spawnChild+                          writeStream new rec)+        (do get >>= withJust closeStream+            closeStream output)+  where childNet = net --> (net * pattern)+        spawnChild = do (stream, _) <- spawnSNet childNet def output+                        put (Just stream)+                        return stream++onNothing :: Monad m => m (Maybe a) -> m a -> m a+onNothing a b = a >>= maybe b return++withJust :: Monad m => (a -> m ()) -> Maybe a -> m ()+withJust = maybe (return ())
+ SNet/Interfaces.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+module SNet.Interfaces+  ( Handle (..)+  , C.C'Handle+  , C.Ptr+  ) where++import Control.Monad.Trans++import SNet.Record+import SNet.Variants++import qualified SNet.Interfaces.C as C++infixl 1 `withHandle`++class Handle hnd where+  newHandle :: MonadIO m+            => Variants ps n+            -> (Record Data -> Record Data -> IO ())+            -> m hnd++  withHandle :: MonadIO m+             => (hnd -> Record Data -> IO ())+             -> hnd+             -> Record Data+             -> m ()++  destroyHandle :: MonadIO m => hnd -> m ()++instance Handle (C.Ptr C.C'Handle) where+  newHandle = C.newHandle+  withHandle = C.withHandle+  destroyHandle = C.destroyHandle
+ SNet/Interfaces/C-out.c view
@@ -0,0 +1,15 @@+#include <stdarg.h>++#include "CHandle.h"++void SNetOut(Handle *hnd, int variant, ...)+{+  va_list args;+  va_start(args, variant);++  for (int i = 0; i < hnd->lengths[variant]; i++) {+    hnd->values[i] = va_arg(args, intptr_t);+  }++  hnd->snetOut(hnd->record, variant, hnd->values);+}
+ SNet/Interfaces/C.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE Rank2Types #-}+module SNet.Interfaces.C+  ( C'Handle+  , Ptr+  , newHandle+  , withHandle+  , destroyHandle+  ) where++import Prelude hiding (length)+import Control.Monad.Trans+import Foreign+import Foreign.C.Types++import SNet.Record+import SNet.Pattern+import SNet.Variants+import SNet.Interfaces.CHandle++type OutFun = Ptr () -> CInt -> Ptr IntPtr -> IO ()+foreign import ccall "wrapper" mkOutFun :: OutFun -> IO (FunPtr OutFun)++convert :: RecEntry a -> IntPtr -> a+convert (Tag _) = fromIntegral+convert (BTag _) = fromIntegral+convert (Field _) = error "To be implemented"++addRecEntry :: RecEntry e -> IntPtr -> Record Data -> Record Data+addRecEntry e = insert e . convert e++outputRecord :: Variants ps n+             -> (Record Data -> Record Data -> IO ())+             -> Ptr ()+             -> CInt+             -> Ptr IntPtr+             -> IO ()+outputRecord variants snetOut recPtr i intPtrValues = do+    baseRec <- deRefStablePtr . castPtrToStablePtr $ recPtr+    values  <- peekArray (withPattern length) intPtrValues+    snetOut baseRec $ withPattern (constructRec values)+  where withPattern :: (forall p. Pattern p -> a) -> a+        withPattern = unsafeGetPattern variants i+        constructRec = foldWithPattern addRecEntry emptyRecord++newHandle :: MonadIO m+          => Variants ps n+          -> (Record Data -> Record Data -> IO ())+          -> m (Ptr C'Handle)+newHandle variants snetOut = liftIO $ do+    outFun  <- mkOutFun $ outputRecord variants snetOut+    lengths <- newArray patLengths+    values  <- mallocArray $ fromIntegral (maximum patLengths)+    new $ C'Handle+      { c'Handle'lengths = lengths+      , c'Handle'values  = values+      , c'Handle'record  = nullPtr+      , c'Handle'snetOut = outFun+      }+  where patLengths = variantsToList variants length++withHandle :: MonadIO m+           => (Ptr C'Handle -> Record Data -> IO ())+           -> Ptr C'Handle+           -> Record Data+           -> m ()+withHandle boxfun hndPtr record = liftIO $ do+    stableRec <- newStablePtr record+    poke recPtr $ castStablePtrToPtr stableRec++    boxfun hndPtr record++    poke recPtr nullPtr+    freeStablePtr stableRec+  where recPtr = p'Handle'record hndPtr++destroyHandle :: MonadIO m => Ptr C'Handle -> m ()+destroyHandle hndPtr = liftIO $ do+  hnd <- peek hndPtr+  free . c'Handle'lengths $ hnd+  free . c'Handle'values  $ hnd+  freeHaskellFunPtr . c'Handle'snetOut $ hnd+  free hndPtr
+ SNet/Interfaces/CHandle.h view
@@ -0,0 +1,13 @@+#ifndef __CHANDLE_H__+#define __CHANDLE_H__+#include <stdint.h>++typedef struct {+  int *lengths;+  intptr_t *values;+  void *record;+  void (*snetOut)(void *, int, intptr_t *);+} Handle;++void SNetOut(Handle *hnd, int variant, ...);+#endif
+ SNet/Interfaces/CHandle.hsc view
@@ -0,0 +1,20 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+#include <bindings.dsl.h>+#include "CHandle.h"+module SNet.Interfaces.CHandle where+import Foreign.Ptr+#strict_import++{- typedef struct {+            int * lengths;+            intptr_t * values;+            void * record;+            void (* snetOut)(void *, int, intptr_t *);+        } Handle; -}+#starttype Handle+#field lengths , Ptr CInt+#field values , Ptr IntPtr+#field record , Ptr ()+#field snetOut , FunPtr (Ptr () -> CInt -> Ptr IntPtr -> IO ())+#stoptype+#ccall SNetOut , Ptr <Handle> -> CInt -> IO ()
+ SNet/Network.hs view
@@ -0,0 +1,22 @@+module SNet.Network+  ( SNet+  , Info (..)+  , Location (..)+  , spawnSNet+  ) where++import Control.Monad.Trans+import Control.Monad.Trans.State+import Data.Default+import SNet.Stream++newtype Location = Loc Int+data Info = Info { location :: Location }++instance Default Info where+  def = Info { location = Loc 0 }++type SNet = Stream -> StateT Info IO Stream++spawnSNet :: MonadIO m => SNet -> Info -> Stream -> m (Stream, Info)+spawnSNet net info output = liftIO $ runStateT (net output) info
+ SNet/Pattern.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeOperators #-}+module SNet.Pattern+  ( Pattern (..)+  , length+  , foldPattern+  , foldWithPattern+  ) where++import Prelude hiding (length)+import SNet.Types (RecEntry)++data Pattern :: [*] -> * where+  Nil :: Pattern '[]+  Cons :: RecEntry h -> Pattern t -> Pattern (h ': t)++length :: Integral i => Pattern p -> i+length Nil = 0+length (Cons _ t) = 1 + length t++foldPattern :: Pattern p -> (forall e . RecEntry e -> a -> a) -> a -> a+foldPattern Nil        _ base = base+foldPattern (Cons h t) f base = foldPattern t f (f h base)++foldWithPattern :: (forall e . RecEntry e -> val -> a -> a)+                -> a+                -> [val]+                -> Pattern p+                -> a+foldWithPattern _ r []     Nil         = r+foldWithPattern f r (v:vs) (Cons p ps) = foldWithPattern f (f p v r) vs ps+foldWithPattern _ _ _ _ = error "foldWithPattern: Pattern/list length mismatch!"
+ SNet/Record.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+module SNet.Record+  ( RecEntry (..)+  , RecType (..)+  , Record (..)+  , recTags+  , recBTags+  , recFields+  , emptyRecord+  , isTerminate+  , insert+  , lookup+  , (!)+  , merge+  , delete+  , match+  , flowInherit+  ) where++import Prelude hiding (lookup)+import Data.IntMap hiding (insert, lookup, (!), delete)+import qualified Data.IntMap as IntMap++import Control.Lens++import SNet.Pattern+import SNet.Types++recTags :: Simple Lens (Record Data) (IntMap CInt)+recTags fun (Rec t b f) = fmap (\t' -> Rec t' b f) (fun t)++recBTags :: Simple Lens (Record Data) (IntMap CInt)+recBTags fun (Rec t b f) = fmap (\b' -> Rec t b' f) (fun b)++recFields :: Simple Lens (Record Data) (IntMap Ref)+recFields fun (Rec t b f) = fmap (\f' -> Rec t b f') (fun f)++emptyRecord :: Record Data+emptyRecord = Rec empty empty empty++isTerminate :: Record a -> Bool+isTerminate Terminate = True+isTerminate _ = False++insert :: RecEntry a -> a -> Record Data -> Record Data+insert (Tag i)   val = recTags   %~ IntMap.insert i val+insert (BTag i)  val = recBTags  %~ IntMap.insert i val+insert (Field i) val = recFields %~ IntMap.insert i val++lookup :: RecEntry a -> Record Data -> Maybe a+lookup (Tag i)   = recTags   `views` IntMap.lookup i+lookup (BTag i)  = recBTags  `views` IntMap.lookup i+lookup (Field i) = recFields `views` IntMap.lookup i++(!) :: Record Data -> RecEntry a -> a+rec ! Tag i   = rec ^. recTags   ^% (IntMap.! i)+rec ! BTag i  = rec ^. recBTags  ^% (IntMap.! i)+rec ! Field i = rec ^. recFields ^% (IntMap.! i)++delete :: RecEntry a -> Record Data -> Record Data+delete (Tag i)   = recTags   %~ IntMap.delete i+delete (BTag i)  = recBTags  %~ IntMap.delete i+delete (Field i) = recFields %~ IntMap.delete i++merge :: Record Data -> Record Data -> Record Data+merge (Rec t1 b1 f1) (Rec t2 b2 f2) =+    Rec (union t1 t2) (union b1 b2) (union f1 f2)++match :: Pattern p -> Record Data -> Maybe Int+match pat rec = foldPattern pat counter (Just 0)+  where counter :: RecEntry e -> Maybe Int -> Maybe Int+        counter e = (lookup e rec >>) . fmap (+1)++flowInherit :: Pattern p -> Record Data -> Record Data -> Record Data+flowInherit pat base new = merge new $ clean pat base+  where clean :: Pattern p -> Record Data -> Record Data+        clean p = foldPattern p delete
+ SNet/Stream.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE Rank2Types #-}+module SNet.Stream+  ( Stream+  , newStream+  , openStream+  , readStream+  , writeStream+  , closeStream+  ) where++import Control.Concurrent+import Control.Monad+import Control.Monad.Trans++import SNet.Types++newStream :: MonadIO m => m Stream+newStream = liftIO $ liftM2 (,) (newMVar 0) newEmptyMVar++openStream :: MonadIO m => Stream -> m ()+openStream (i, _) = liftIO . modifyMVar_ i $ return . (+1)++readStream :: MonadIO m => Stream -> (forall r . Record r -> m a) -> m a+readStream (_, stream) f = do+  rec <- liftIO $ takeMVar stream+  case rec of+      WrapData r -> f r+      WrapControl r -> f r++writeStream :: MonadIO m => Stream -> Record r -> m ()+writeStream (_, stream) = liftIO . putMVar stream . wrap+  where wrap :: Record r -> WrappedRecord+        wrap (Rec t b f) = WrapData    (Rec t b f)+        wrap (Sync s)    = WrapControl (Sync s)+        wrap Trigger     = WrapControl Trigger+        wrap Terminate   = WrapControl Terminate++closeStream :: MonadIO m => Stream -> m ()+closeStream (i, stream) = liftIO . modifyMVar_ i $ \x -> do+   when (x == 1) $ putMVar stream (WrapControl Terminate)+   return (x - 1)
+ SNet/Task.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module SNet.Task+  ( Task+  , task+  , task_+  , box+  , syncro+  ) where++import Control.Concurrent (forkIO)+import Control.Monad.Trans+import Control.Monad.Trans.State (evalStateT, StateT)++import SNet.Record+import SNet.Pattern+import SNet.Variants+import SNet.Stream+import SNet.Interfaces+import SNet.Network++type Task a = StateT a IO ()++task_ :: MonadIO m => (Record Data -> Task ()) -> Task () -> m Stream+task_ = task ()++task :: MonadIO m => a -> (Record Data -> Task a) -> Task a -> m Stream+task state taskFun stop = do+    input <- newStream+    liftIO . forkIO $ evalStateT (loop input) state+    return input+  where loop stream =+          readStream stream $ \case+               rec@Rec {..} -> taskFun rec >> loop stream+               Sync s       -> loop s+               Trigger      -> loop stream+               Terminate    -> stop++type family BoxFun (l :: [*])+type instance BoxFun '[] = IO ()+type instance BoxFun (h ': t) = h -> BoxFun t++apply :: Pattern p -> BoxFun p -> Record Data -> IO ()+apply Nil        boxfun _   = boxfun+apply (Cons h t) boxfun rec = apply t (boxfun (rec ! h)) rec++box :: Handle hnd+    => Pattern p+    -> Variants ps n+    -> (hnd -> BoxFun p)+    -> SNet+box pattern variants boxfun output = do+    openStream output+    hnd <- newHandle variants writeOut+    task_ (apply pattern . boxfun `withHandle` hnd)+          (destroyHandle hnd >> closeStream output)+    where writeOut :: Record Data -> Record Data -> IO ()+          writeOut old new = writeStream output $ flowInherit pattern old new++syncro :: Pattern p -> Stream -> SNet+syncro = undefined
+ SNet/Types.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+module SNet.Types+  ( Stream+  , Ref+  , CInt+  , RecEntry (..)+  , RecType (..)+  , Record (..)+  , WrappedRecord (..)+  ) where++import Control.Concurrent+import Data.IntMap+import Foreign.C.Types++import Text.Read (lift, readPrec)+import qualified Text.ParserCombinators.ReadP as ReadP++type Stream = (MVar Int, MVar WrappedRecord)+type Ref = () --Either (ForeignPtr ()) (Location, WordPtr)++data RecEntry a where+  Tag :: Int -> RecEntry CInt+  BTag :: Int -> RecEntry CInt+  Field :: Int -> RecEntry Ref++data RecType = Control | Data++data Record (t :: RecType) where+  Rec :: IntMap CInt -> IntMap CInt -> IntMap Ref -> Record Data+  Sync :: Stream -> Record Control+  Trigger :: Record Control+  Terminate :: Record Control++data WrappedRecord where+  WrapControl :: Record Control -> WrappedRecord+  WrapData :: Record Data -> WrappedRecord++instance Show (Record Data) where+    show (Rec t b _) = "Rec {(" ++ show t ++ ") (" ++ show b ++ ")}"++instance Read (Record Data) where+    readPrec = do+        string "Rec {("+        tags <- readPrec+        string ") ("+        btags <- readPrec+        string ")}"+        return $ Rec tags btags empty+      where string = lift . ReadP.string
+ SNet/Variants.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeOperators #-}+module SNet.Variants+  ( Variants (..)+  , unsafeGetPattern+  , variantsToList+  , VariantMap (..)+  , getBestMatch+  ) where++import Prelude hiding (foldr)+import Control.Applicative+import Data.Foldable+import Data.Traversable++import SNet.Pattern+import SNet.Record++data Nat = Succ Nat | Zero++data Variants :: [[*]] -> Nat -> * where+  Empty   :: Variants '[] Zero+  Variant :: Pattern p -> Variants ps n -> Variants (p ': ps) (Succ n)++unsafeGetPattern :: Integral i+                 => Variants ps n+                 -> i+                 -> (forall p . Pattern p -> r)+                 -> r+unsafeGetPattern Empty              _ _ = error "Bounds violation"+unsafeGetPattern (Variant p _)      0 f = f p+unsafeGetPattern (Variant _ s)      n f = unsafeGetPattern s (n-1) f++variantsToList :: Variants ps n -> (forall p . Pattern p -> r) -> [r]+variantsToList Empty          _ = []+variantsToList (Variant p ps) f = f p : variantsToList ps f++data VariantMap :: [[*]] -> * -> * where+  EmptyMap   :: VariantMap '[] v+  MapVariant :: Pattern p -> v -> VariantMap ps v -> VariantMap (p ': ps) v++instance Foldable (VariantMap ps) where+  foldr _ z EmptyMap = z+  foldr f z (MapVariant _ v ps) = f v (foldr f z ps)++instance Functor (VariantMap ps) where+  fmap _ EmptyMap = EmptyMap+  fmap f (MapVariant p v ps) = MapVariant p (f v) (fmap f ps)++instance Traversable (VariantMap ps) where+  traverse _ EmptyMap = pure EmptyMap+  traverse f (MapVariant p v ps) = MapVariant p <$> f v <*> traverse f ps++getBestMatch :: VariantMap ps v -> Record Data -> v+getBestMatch vmap rec = snd $ helper vmap+  where helper :: VariantMap ps v -> (Maybe Int, v)+        helper EmptyMap = (Nothing, error "No match found!")+        helper (MapVariant p v ps) = maxBy fst (match p rec, v) (helper ps)+        maxBy f x y = if f x >= f y then x else y
+ Setup.hs view
@@ -0,0 +1,19 @@+import Distribution.Simple+import Distribution.Simple.Program+import System.Process (system)++main :: IO ()+main = defaultMainWithHooks $ simpleUserHooks {+  hookedPrograms = [c2hsc],+  preBuild = \args buildFlags -> do+      system "cd SNet/Interfaces && c2hsc CHandle.h --prefix SNet.Interfaces"+      preBuild simpleUserHooks args buildFlags+}++c2hsc :: Program+c2hsc = (simpleProgram "c2hsc") {+    programFindVersion = findProgramVersion "--version" $ \str ->+      case words str of+        (_:('v':ver):_) -> takeWhile (/=',') ver+        _             -> ""+  }