packages feed

ArrowVHDL (empty) → 1.0

raw patch · 40 files changed

+4106/−0 lines, 40 filesdep +basedep +processsetup-changed

Dependencies added: base, process

Files

+ ArrowVHDL.cabal view
@@ -0,0 +1,82 @@+name:                ArrowVHDL+version:             1.0+synopsis:            A library to generate Netlist code from Arrow  descriptions.+description:         This software is intended to help a developer designing electronic+                     circuits by describing them with arrows. The arrow notation represents+                     the according. From the netlist the developer can generate various+                     other formats by "compiling" the arrow into them. With this software+                     three basic compilers are shipped. One generates a simple textual+                     representation that helps debugging the actual circuit. Another+                     generates VHDL representations of the circuit. The third one generates+                     DOT syntax for visualization of circuits.+homepage:            https://github.com/frosch03/arrowVHDL+license:             PublicDomain+license-file:        LICENSE+author:              Matthias Brettschneider+maintainer:          brettschneider@frosch03.de+category:            Testing+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  -- Modules exported by the library.+  exposed-modules: System.ArrowVHDL.Beispiel,+                   System.ArrowVHDL.Circuit,+                   System.ArrowVHDL.CRC,+                   System.ArrowVHDL.ALU,+                   System.ArrowVHDL.TEA,+                   System.ArrowVHDL.Test++  other-modules: System.ArrowVHDL.Circuit.Grid,+                 System.ArrowVHDL.Circuit.EdgeTransit,+                 System.ArrowVHDL.Circuit.IEEE_STD_LOGIC_1164,+                 System.ArrowVHDL.Circuit.Defaults,+                 System.ArrowVHDL.Circuit.Tools,+                 System.ArrowVHDL.Circuit.Show,+                 System.ArrowVHDL.Circuit.Workers,+                 System.ArrowVHDL.Circuit.Tests,+                 System.ArrowVHDL.Circuit.Graphs,+                 System.ArrowVHDL.Circuit.Descriptor,+                 System.ArrowVHDL.Circuit.Splice,+                 System.ArrowVHDL.Circuit.ShowType,+                 System.ArrowVHDL.Circuit.Sensors,+                 System.ArrowVHDL.Circuit.Auxillary,+                 System.ArrowVHDL.Circuit.PinTransit,+                 System.ArrowVHDL.Circuit.Arrow,+                 System.ArrowVHDL.Circuit.Stream,+                 System.ArrowVHDL.Circuit.Grid.Datatype,+                 System.ArrowVHDL.Circuit.Grid.Instance,+                 System.ArrowVHDL.Circuit.Stream.Datatype,+                 System.ArrowVHDL.Circuit.Stream.Instance,+                 System.ArrowVHDL.Circuit.Arrow.Helpers,+                 System.ArrowVHDL.Circuit.Arrow.Instance,+                 System.ArrowVHDL.Circuit.Arrow.Class,+                 System.ArrowVHDL.Circuit.Show.Tools,+                 System.ArrowVHDL.Circuit.Show.Simple,+                 System.ArrowVHDL.Circuit.Show.DOT,+                 System.ArrowVHDL.Circuit.Show.VHDL,+                 System.ArrowVHDL.Circuit.ShowType.Instance,+                 System.ArrowVHDL.Circuit.ShowType.Class+  +  other-extensions: Arrows+                  , NoMonomorphismRestriction+                  , RebindableSyntax+                  , RankNTypes+                  , OverlappingInstances+                  , UndecidableInstances+                  , IncoherentInstances+                  , MultiParamTypeClasses+                  , FlexibleInstances+  +  build-depends: base >=4.6 && <4.7+               , process >=1.1 && <1.2+  +  -- Directories containing source files.+  hs-source-dirs:      src+  +  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/frosch03/arrowVHDL.git
+ LICENSE view
@@ -0,0 +1,121 @@+Creative Commons Legal Code++CC0 1.0 Universal++    CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE+    LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN+    ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS+    INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES+    REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS+    PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM+    THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED+    HEREUNDER.++Statement of Purpose++The laws of most jurisdictions throughout the world automatically confer+exclusive Copyright and Related Rights (defined below) upon the creator+and subsequent owner(s) (each and all, an "owner") of an original work of+authorship and/or a database (each, a "Work").++Certain owners wish to permanently relinquish those rights to a Work for+the purpose of contributing to a commons of creative, cultural and+scientific works ("Commons") that the public can reliably and without fear+of later claims of infringement build upon, modify, incorporate in other+works, reuse and redistribute as freely as possible in any form whatsoever+and for any purposes, including without limitation commercial purposes.+These owners may contribute to the Commons to promote the ideal of a free+culture and the further production of creative, cultural and scientific+works, or to gain reputation or greater distribution for their Work in+part through the use and efforts of others.++For these and/or other purposes and motivations, and without any+expectation of additional consideration or compensation, the person+associating CC0 with a Work (the "Affirmer"), to the extent that he or she+is an owner of Copyright and Related Rights in the Work, voluntarily+elects to apply CC0 to the Work and publicly distribute the Work under its+terms, with knowledge of his or her Copyright and Related Rights in the+Work and the meaning and intended legal effect of CC0 on those rights.++1. Copyright and Related Rights. A Work made available under CC0 may be+protected by copyright and related or neighboring rights ("Copyright and+Related Rights"). Copyright and Related Rights include, but are not+limited to, the following:++  i. the right to reproduce, adapt, distribute, perform, display,+     communicate, and translate a Work;+ ii. moral rights retained by the original author(s) and/or performer(s);+iii. publicity and privacy rights pertaining to a person's image or+     likeness depicted in a Work;+ iv. rights protecting against unfair competition in regards to a Work,+     subject to the limitations in paragraph 4(a), below;+  v. rights protecting the extraction, dissemination, use and reuse of data+     in a Work;+ vi. database rights (such as those arising under Directive 96/9/EC of the+     European Parliament and of the Council of 11 March 1996 on the legal+     protection of databases, and under any national implementation+     thereof, including any amended or successor version of such+     directive); and+vii. other similar, equivalent or corresponding rights throughout the+     world based on applicable law or treaty, and any national+     implementations thereof.++2. Waiver. To the greatest extent permitted by, but not in contravention+of, applicable law, Affirmer hereby overtly, fully, permanently,+irrevocably and unconditionally waives, abandons, and surrenders all of+Affirmer's Copyright and Related Rights and associated claims and causes+of action, whether now known or unknown (including existing as well as+future claims and causes of action), in the Work (i) in all territories+worldwide, (ii) for the maximum duration provided by applicable law or+treaty (including future time extensions), (iii) in any current or future+medium and for any number of copies, and (iv) for any purpose whatsoever,+including without limitation commercial, advertising or promotional+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each+member of the public at large and to the detriment of Affirmer's heirs and+successors, fully intending that such Waiver shall not be subject to+revocation, rescission, cancellation, termination, or any other legal or+equitable action to disrupt the quiet enjoyment of the Work by the public+as contemplated by Affirmer's express Statement of Purpose.++3. Public License Fallback. Should any part of the Waiver for any reason+be judged legally invalid or ineffective under applicable law, then the+Waiver shall be preserved to the maximum extent permitted taking into+account Affirmer's express Statement of Purpose. In addition, to the+extent the Waiver is so judged Affirmer hereby grants to each affected+person a royalty-free, non transferable, non sublicensable, non exclusive,+irrevocable and unconditional license to exercise Affirmer's Copyright and+Related Rights in the Work (i) in all territories worldwide, (ii) for the+maximum duration provided by applicable law or treaty (including future+time extensions), (iii) in any current or future medium and for any number+of copies, and (iv) for any purpose whatsoever, including without+limitation commercial, advertising or promotional purposes (the+"License"). The License shall be deemed effective as of the date CC0 was+applied by Affirmer to the Work. Should any part of the License for any+reason be judged legally invalid or ineffective under applicable law, such+partial invalidity or ineffectiveness shall not invalidate the remainder+of the License, and in such case Affirmer hereby affirms that he or she+will not (i) exercise any of his or her remaining Copyright and Related+Rights in the Work or (ii) assert any associated claims and causes of+action with respect to the Work, in either case contrary to Affirmer's+express Statement of Purpose.++4. Limitations and Disclaimers.++ a. No trademark or patent rights held by Affirmer are waived, abandoned,+    surrendered, licensed or otherwise affected by this document.+ b. Affirmer offers the Work as-is and makes no representations or+    warranties of any kind concerning the Work, express, implied,+    statutory or otherwise, including without limitation warranties of+    title, merchantability, fitness for a particular purpose, non+    infringement, or the absence of latent or other defects, accuracy, or+    the present or absence of errors, whether or not discoverable, all to+    the greatest extent permissible under applicable law.+ c. Affirmer disclaims responsibility for clearing rights of other persons+    that may apply to the Work or any use thereof, including without+    limitation any person's Copyright and Related Rights in the Work.+    Further, Affirmer disclaims responsibility for obtaining any necessary+    consents, permissions or other rights required for any use of the+    Work.+ d. Affirmer understands and acknowledges that Creative Commons is not a+    party to this document and has no duty or obligation with respect to+    this CC0 or use of the Work.
+ README.md view
@@ -0,0 +1,3 @@+just some minor vhdl-hacking with the help of haskell ;)++questions: frosch03@gmail.com
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/System/ArrowVHDL/ALU.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE Arrows, NoMonomorphismRestriction, RebindableSyntax #-}+module System.ArrowVHDL.ALU +where++import Prelude hiding (id, (.))++import Control.Category -- here we get >>> ...++import System.ArrowVHDL.Circuit+import System.ArrowVHDL.Circuit.Arrow -- here we get first and second+import System.ArrowVHDL.Circuit.Defaults++type Input   = (Bool, Bool)+type Output  = Bool+type Cin     = Bool+type Cout    = Bool+type Opt1Bit = Bool+type Opt2Bit = (Opt1Bit, Opt1Bit)+type Opt3Bit = (Opt1Bit, Opt2Bit)+type Opt4Bit = (Opt1Bit, Opt3Bit)++type In2Bit  = (Input,  (Input))+type Out2Bit = (Output, (Output))++type In4Bit  = (Input,  (Input,  (Input,  (Input))))+type Out4Bit = (Output, (Output, (Output, (Output))))++type In8Bit  = (Input,  (Input,  (Input,  (Input,  (Input,  (Input,  (Input,  (Input))))))))+type Out8Bit = (Output, (Output, (Output, (Output, (Output, (Output, (Output, (Output)))))))) +++-- aFst+-- aSnd+-- aXor+-- aShiftL+-- aShiftR+-- aAdd+++aDdistr_new :: (Arrow a) => Grid a ((b, c), (b, e)) (b, (c, e))+aDdistr_new +    = proc ((x1, y), (x2, z)) -> do+        returnA -< (x1, (y, z))+++-- |With the 'noC' operator, one can shortwire the CarryIn bit direct to the CarryOut bit+noC :: (Arrow a) => (Grid a Input Output) -> Grid a (Cin, Input) (Output, Cout)+noC arrow +    =   second arrow+    >>> aFlip+    ++-- |'aFullAdd' is the full adder implementation+aFullAdd :: (Arrow a) => Grid a (Cin, Input) (Output, Cout)+aFullAdd+    =   second (aXor &&& aAnd)+    >>> a_aBC2ABc+    >>> first  (aXor &&& aAnd)+    >>> a_ABc2aBC+    >>> second (aOr)++-- Multiplexer --++-- | With 'aMux' a 1 Bit multiplexer is defined+aMux :: (Arrow a) => Grid a (Opt1Bit, (Output, Output))  Output+aMux +    =   aDistr+    >>> first (first aNot)+    >>> aAnd *** aAnd+    >>> aOr++aMux2Bit :: (Arrow a) --        00      01        10      11+         => Grid a (Opt2Bit, ((Output, Output), (Output, Output)))  Output+aMux2Bit+    =   a_ABc2aBC+    >>> second aDistr+    >>> second (aMux *** aMux)+    >>> aMux++aMux3Bit :: (Arrow a) --         000     001       010     011         100     101       110     111+         => Grid a (Opt3Bit, (((Output, Output), (Output, Output)), ((Output, Output), (Output, Output))))  Output+aMux3Bit+    =   a_ABc2aBC+    >>> second aDistr+    >>> second (aMux2Bit *** aMux2Bit)+    >>> aMux++aMux4Bit :: (Arrow a) +         => Grid a (Opt4Bit, ( (((Output, Output), (Output, Output)), ((Output, Output), (Output, Output)))+                             , (((Output, Output), (Output, Output)), ((Output, Output), (Output, Output)))))  Output+aMux4Bit +    =   a_ABc2aBC+    >>> second aDistr+    >>> second (aMux3Bit *** aMux3Bit)+    >>> aMux++-- |'anXum' is the Multiplexer where the last input-pin is the s-line+-- |it is generated out of one of the mux'es+anXum mux =   aFlip +          >>> mux++aXum  = anXum aMux+a2Xum = anXum aMux2Bit+a3Xum = anXum aMux3Bit+a4Xum = anXum aMux4Bit++--_____________--++--eval :: (Arrow a) => Grid a (Cin, (Opt1Bit, Input)) (Output, Cout) -> Grid a (Cin, (Opt1Bit, (Input, rest))) (Output, (Cout, (Opt1Bit, rest)))+-- |The 'eval' function takes a single bit ALU and evaluates the first bit of a multiBit input+-- so with 'eval' one can define the steps of n-Bit ALU+eval aALU +    =   second aDistr+    >>> a_aBC2ABc+    >>> first aALU+    >>> a_ABc2aBC++-- n-Bit ALU's --++--a1BitALU :: (Arrow a) => Grid a (Cin, (Opt1Bit, Input))   (Output, Cout) +--                      -> Grid a (Cin, (Opt1Bit, (Input))) (Output, (Cout))+mk1BitALU = id+++--a2BitALU :: (Arrow a) => Grid a (Cin, (Opt1Bit, Input)) (Output, Cout) +--                   -> Grid a (Cin, (Opt1Bit, (Input,  (Input)))) +--                                             (Output, (Output, (Cout)))+mk2BitALU aALU +    = eval aALU >>> next aALU+    where next = second+++--a4BitALU :: (Arrow a) => Grid a (Cin, (Opt1Bit, Input)) (Output, Cout) +--                      -> Grid a (Cin, (Opt1Bit, (Input,  (Input,  (Input,  (Input)))))) +--                                                (Output, (Output, (Output, (Output, (Cout)))))+mk4BitALU aALU+    = eval aALU >>> next +    ( eval aALU >>> next +    ( eval aALU >>> next aALU))+    where next = second+++--a8BitALU :: Arrow a => Grid a (Cin, (Opt1Bit, Input)) (Output, Cout) +--                    -> Grid a (Cin, (Opt1Bit, (Input,  (Input,  (Input,  (Input,  (Input,  (Input,  (Input,  Input))))))))) +--                                              (Output, (Output, (Output, (Output, (Output, (Output, (Output, (Output, Cout))))))))+mk8BitALU aALU+    = eval aALU >>> next +    ( eval aALU >>> next +    ( eval aALU >>> next +    ( eval aALU >>> next +    ( eval aALU >>> next +    ( eval aALU >>> next +    ( eval aALU >>> next aALU))))))+    where next = second+++-- n-Bit ALU's --+--_____________--++-- n-Bit Operators --++aOpt1Bit :: (Arrow a)+         => Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, (Opt1Bit, Input)) (Output, Cout)+aOpt1Bit aOp0 aOp1+    =   a_aBC2ABc+    >>> first aFlip+    >>> a_ABc2aBC+    >>> second +        (   aOp0 &&& aOp1+        >>> aDdistr+        )+    >>> aDistr+    >>> aMux *** aMux+++aOpt2Bit :: (Arrow a)+         => Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, (Opt2Bit, Input)) (Output, Cout)+aOpt2Bit aOp00 aOp01 aOp10 aOp11+    =   a_aBC2ABc+    >>> first aFlip+    >>> a_ABc2aBC+    >>> second +        (   (aOp00 &&& aOp01) &&& (aOp10 &&& aOp11)+        >>> aDdistr *** aDdistr+        >>> aDdistr+        )+    >>> aDistr+    >>> aMux2Bit *** aMux2Bit+++aOpt3Bit :: (Arrow a)+         => Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, (Opt3Bit, Input)) (Output, Cout)+aOpt3Bit aOp000 aOp001 aOp010 aOp011 aOp100 aOp101 aOp110 aOp111+    =   a_aBC2ABc+    >>> first aFlip+    >>> a_ABc2aBC+    >>> second+        (   ((aOp000 &&& aOp001) &&& (aOp010 &&& aOp011)) &&& ((aOp100 &&& aOp101) &&& (aOp110 &&& aOp111))+        >>> (aDdistr *** aDdistr) *** (aDdistr *** aDdistr)+        >>> aDdistr *** aDdistr+        >>> aDdistr+        )+    >>> aDistr+    >>> aMux3Bit *** aMux3Bit++++aOpt4Bit :: (Arrow a)+         => Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, Input) (Cout, Output)+         -> Grid a (Cin, (Opt4Bit, Input)) (Output, Cout)+aOpt4Bit aOp0000 aOp0001 aOp0010 aOp0011 aOp0100 aOp0101 aOp0110 aOp0111  aOp1000 aOp1001 aOp1010 aOp1011 aOp1100 aOp1101 aOp1110 aOp1111+    =   a_aBC2ABc+    >>> first aFlip+    >>> a_ABc2aBC+    >>> second+        (       (((aOp0000 &&& aOp0001) &&& (aOp0010 &&& aOp0011)) &&& ((aOp0100 &&& aOp0101) &&& (aOp0110 &&& aOp0111))) +            &&& (((aOp1000 &&& aOp1001) &&& (aOp1010 &&& aOp1011)) &&& ((aOp1100 &&& aOp1101) &&& (aOp1110 &&& aOp1111)))+        >>> ((aDdistr *** aDdistr) *** (aDdistr *** aDdistr)) *** ((aDdistr *** aDdistr) *** (aDdistr *** aDdistr))+        >>> (aDdistr *** aDdistr) *** (aDdistr *** aDdistr)+        >>> aDdistr *** aDdistr+        >>> aDdistr+        )+    >>> aDistr+    >>> aMux4Bit *** aMux4Bit+++-- n-Bit Operators --+--_________________--++aFAD_XOR_AND_OR = aOpt2Bit aFullAdd (noC aXor) (noC aAnd) (noC aOr)++-- Auxillary --++t8b :: Int -> (Bool,  (Bool,  (Bool,  (Bool, (Bool,  (Bool,  (Bool,  (Bool))))))))+t8b x +    = (bit7, (bit6, (bit5, (bit4, (bit3, (bit2, (bit1, (bit0))))))))+    where (bit7: bit6: bit5: bit4: bit3: bit2: bit1: bit0: []) = i2t8b [] x++i2t8b :: [Bool] -> Int -> [Bool]+i2t8b list x +    | x == 0+    = list ++ (replicate (8 - (length list)) False)++    | x == 1+    = (list ++ [True]) ++ (replicate (8 - (length list) - 1) False)++    | x `mod` 2  == 0  +    = i2t8b (list ++ [False]) (x `div` 2)++    | x `mod` 2 == 1+    = i2t8b (list ++ [True]) ( (x-1) `div` 2)++inp8b :: Int -> Int -> In8Bit+inp8b x1 x2+    = ((bit07, bit17), ((bit06, bit16), ((bit05, bit15), ((bit04, bit14), ((bit03, bit13), ((bit02, bit12), ((bit01, bit11), ((bit00, bit10)))))))))+    where (bit07: bit06: bit05: bit04: bit03: bit02: bit01: bit00: []) = i2t8b [] x1+          (bit17: bit16: bit15: bit14: bit13: bit12: bit11: bit10: []) = i2t8b [] x2++-- Auxillary --+--___________--
+ src/System/ArrowVHDL/Beispiel.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE Arrows, NoMonomorphismRestriction, RebindableSyntax #-}+module System.ArrowVHDL.Beispiel where++import Control.Category +import Prelude hiding (id, (.))++import System.ArrowVHDL.Circuit.Arrow+import System.ArrowVHDL.Circuit.Auxillary+import System.ArrowVHDL.Circuit.Descriptor++-- Dissertation TODO+import System.ArrowVHDL.TEA+import System.ArrowVHDL.Circuit.Workers++import System.ArrowVHDL.Circuit+import System.ArrowVHDL.Circuit.Defaults +        ( aId+        , aConst+        , aDup+        , aFlip+        , aAdd+        , aXor+        , aShiftL, aShiftL4+        , aShiftR, aShiftR5+        , aXorMagic+        , aFst, aSnd+        )++aAdd1 :: (Arrow a) => a Int Int+aAdd1 = arr (\x -> x +1)++aSub1 :: (Arrow a) => a Int Int+aSub1 = arr (\x -> x -1)++aSub2 = aSub1 >>> aSub1++++-- Beispiel 0+-------------+aTest0 +    =   aDup +    >>> aAdd++netlist_Test0 :: CircuitDescriptor+netlist_Test0 +    = synthesize aTest0+++-- Beispiel 1+-------------+aTest1 +    = proc (x) -> do+        tmp <- aAdd -< (x, x)+        returnA      -< tmp++_netlist_Test1 +    = synthesize aTest1 +++-- Beispiel 2+-------------+aTest2 +    = proc (x1, x2) -> do+        tmp1 <- aDup -< x1+        tmp2 <- aDup -< x2+        tmp3 <- aAdd -< tmp1+        tmp4 <- aAdd -< tmp2+        tmp5 <- aAdd -< (tmp3, tmp4)+        returnA      -< tmp5++_netlist_Test2 +    = synthesize aTest2+++-- Beispiel 3+-------------+aTest2' +    = ((first aDup >>> arr (\ (tmp1, x2)   -> (x2,   tmp1))) >>> +       (first aDup >>> arr (\ (tmp2, tmp1) -> (tmp1, tmp2))) >>> +       (first aAdd >>> arr (\ (tmp3, tmp2) -> (tmp2, tmp3))) >>> +       (first aAdd >>> arr (\ (tmp4, tmp3) -> (tmp3, tmp4))) >>> aAdd)++netlist_Test2' +    = synthesize aTest2'+++-- Beispiel 4+-------------+aShiftL4_XorKey+    =   first (   aDup+              >>> second (aConst 4)+              >>> aShiftL+              )+    >>> aXor++-- netlist_ShiftL4_XorKey +--     = synthesize aShiftL4_XorKey+++-- Beispiel 5+-------------+-- delta = 2654435769+-- aXorDelta+--     =   second (aConst delta)+--     >>> aXor++-- netlist_XorDelta +--     = synthesize aXorDelta+++-- Beispiel 6+-------------+aShiftR5_XorKey+    =   first (   aDup+              >>> second (aConst 5)+              >>> aShiftR+              )+    >>> aXor++-- netlist_ShiftR5_XorKey +--     = synthesize aShiftR5_XorKey+++counter :: (ArrowCircuit a) => a Int Int+counter = proc reset -> do +            rec output <- (arr (+1)) -< reset+                next   <- delay 0    -< output+            returnA -< output+++aLoopBsp :: (ArrowLoop a) => Grid a Int Int+aLoopBsp+    = loop (aAdd >>> (aId &&& (aConst 4)))+
+ src/System/ArrowVHDL/CRC.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE Arrows, +             NoMonomorphismRestriction,+             RebindableSyntax #-}+module System.ArrowVHDL.CRC +where++import Prelude++import Control.Category ((>>>))++import System.ArrowVHDL.Circuit+import System.ArrowVHDL.Circuit.Arrow+import System.ArrowVHDL.Circuit.Auxillary+import System.ArrowVHDL.Circuit.Defaults++import Data.Bits++infixr 0 >:>++(>:>) aA aB = aA >>> (second aB)++mvRight :: (Arrow a) => Grid a (my, (b, rst)) (b, (my, rst))+mvRight+    =   aDistr+    >>> first aSnd++++-- crc_polynom_ccitt ::  (Arrow a, Bits b) => Grid a (b, (b, (b, (b, b))))  (b, (b, (b, b)))+crc_polynom_ccitt ::  (Arrow a) => Grid a (Bool, (Bool, (Bool, (Bool, Bool))))  (Bool, (Bool, (Bool, Bool)))+crc_polynom_ccitt +    =   mvRight >:> mvRight >:>+        (   aDistr +        >>> (aXor *** aXor)+        )++-- crc_polynom_ccitt +--  = proc (x4, (x3, (x2, (x1, x0)))) -> do+--      o1 <- aXor -< (x4, x0)+--      o2 <- aXor -< (x4, x1)+--      o3 <- aId  -< (x2)+--      o4 <- aId  -< (x3)+--      returnA    -< (o4, (o3, (o2, o1)))++-- crc_polynom_usb ::   (Arrow a, Bits b) => Grid a (b, (b, (b, (b, (b, b)))))  (b, (b, (b, (b, b))))+crc_polynom_usb ::   (Arrow a) => Grid a (Bool, (Bool, (Bool, (Bool, (Bool, Bool)))))  (Bool, (Bool, (Bool, (Bool, Bool))))+crc_polynom_usb+    =   mvRight >:> mvRight >:>+        (   aDistr+        >>> aXor *** (mvRight >:> aXor)+        )++-- crc_polynom_usb+--  = proc (x5, (x4, (x3, (x2, (x1, x0))))) -> do+--      o1 <- aXor -< (x5, x0)+--      o2 <- aId  -< (x1)+--      o3 <- aXor -< (x5, x2)+--      o4 <- aId  -< (x3)+--      o5 <- aId  -< (x4)+--      returnA    -< (o5, (o4, (o3, (o2, o1))))++-- crc_polynom_sdmmc :: (Arrow a, Bits b) => Grid a (b, (b, (b, (b, (b, (b, (b, b)))))))  (b, (b, (b, (b, (b, (b, b))))))+crc_polynom_sdmmc :: (Arrow a) => Grid a (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool)))))))  (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool))))))+crc_polynom_sdmmc+    =   mvRight >:> mvRight >:> mvRight >:>+        (   aDistr+        >>> aXor *** (mvRight >:> mvRight >:> aXor)+        )++-- crc_polynom_sdmmc+--  = proc (x7, (x6, (x5, (x4, (x3, (x2, (x1, x0))))))) -> do+--      o1 <- aXor -< (x7, x0)+--      o2 <- aId  -< (x1)+--      o3 <- aId  -< (x2)+--      o4 <- aXor -< (x7, x3)+--      o5 <- aId  -< (x4)+--      o6 <- aId  -< (x5)+--      o7 <- aId  -< (x6)+--      returnA    -< (o7, (o6, (o5, (o4, (o3, (o2, o1))))++    ++--                                    3      2      1     0         2      1     0+-- inner_crc_3ord :: (Arrow a, Bits b) => Grid a (b, (b, (b, b)))  (b, (b, b))+inner_crc_3ord +    =   aDistr+    >>> aSnd *** aDistr+    >>> second (aXor *** aXor)+++toInner3+    =   mvRight +    >:> mvRight +    >:> aFlip++toInner4+    =   mvRight+    >:> mvRight +    >:> mvRight +    >:> aFlip++toInner5+    =   mvRight+    >:> mvRight+    >:> mvRight+    >:> mvRight+    >:> aFlip++toInner7+    =   mvRight+    >:> mvRight+    >:> mvRight+    >:> mvRight+    >:> mvRight+    >:> mvRight+    >:> aFlip++toInner8+    =   mvRight+    >:> mvRight+    >:> mvRight+    >:> mvRight+    >:> mvRight+    >:> mvRight+    >:> mvRight+    >:> aFlip+++-- crc_checksum_8 crc_polynom polySkip start rest padding+crc_checksum_8 crc_polynom polySkip start rest padding+    =   (padding &&& aId)+    >>> toInner8++    >>> (start &&& rest)+    >>> first (crc_polynom)++    >>> step+    >>> step+    >>> step+    >>> step+    >>> step+    >>> step++    >>> aFlip+    >>> polySkip+    >>> crc_polynom++    where step =   a_aBC2ABc+               >>> first +                   (   aFlip+                   >>> polySkip+                   >>> crc_polynom+                   )+++-- crc_test+--     = crc_checksum_8 +--         inner_crc_3ord+--         toInner3+--         (second (second (second aFst)))+--         (aSnd >>> aSnd >>> aSnd >>> aSnd)+--         (aConst (False, (False, False)))+++-- crc_checksum_ccitt_8 ::  (Arrow a, Bits b) => Grid a (b, (b, (b, (b, (b, (b, (b, b))))))) (b, (b, (b, b)))+crc_checksum_ccitt_8 ::  (Arrow a) => Grid a (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool))))))) (Bool, (Bool, (Bool, Bool)))+crc_checksum_ccitt_8+    = crc_checksum_8   +        crc_polynom_ccitt+        toInner4+        (second.second.second.second $ aFst)+        (aSnd >>> aSnd >>> aSnd >>> aSnd >>> aSnd)+        (aConst (False, (False, (False, False))))++-- crc_checksum_usb_8 ::   (Arrow a, Bits b) => Grid a (b, (b, (b, (b, (b, (b, (b, b))))))) (b, (b, (b, (b, b))))+-- crc_checksum_usb_8 +--     = crc_checksum_8 +--         crc_polynom_usb +--         toInner5 +--         (second.second.second.second.second $ aFst)+--         (aSnd >>> aSnd >>> aSnd >>> aSnd >>> aSnd >>> aSnd)+--         (aConst (False, (False, (False, (False, False)))))++-- crc_checksum_sdmmc_8 :: (Arrow a, Bits b) => Grid a (b, (b, (b, (b, (b, (b, (b, b))))))) (b, (b, (b, (b, (b, (b, b))))))+-- crc_checksum_sdmmc_8+--     = crc_checksum_8 +--         crc_polynom_sdmmc+--         toInner7+--         (second.second.second.second.second.second.second $ aFst)+--         (aSnd >>> aSnd >>> aSnd >>> aSnd >>> aSnd >>> aSnd >>> aSnd >>> aSnd)+--         (aConst (False, (False, (False, (False, (False, (False, False)))))))+
+ src/System/ArrowVHDL/Circuit.hs view
@@ -0,0 +1,16 @@+module System.ArrowVHDL.Circuit+  ( Grid(..)+  , runGrid++  , Stream(..)++  , Show(..)+  )+where++-- Modul: System.ArrowVHDL.Circuit+-- stellt ein Wrapper-Modul nach dem Fassaden Entwurfsmuster dar.++import System.ArrowVHDL.Circuit.Grid+import System.ArrowVHDL.Circuit.Stream+import System.ArrowVHDL.Circuit.Show
+ src/System/ArrowVHDL/Circuit/Arrow.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE Arrows,+             OverlappingInstances, +             UndecidableInstances,+             IncoherentInstances,+             NoMonomorphismRestriction,+             MultiParamTypeClasses,+             FlexibleInstances,+             RebindableSyntax #-}++module System.ArrowVHDL.Circuit.Arrow +  ( Arrow(..)+  , ArrowLoop(..)+  , ArrowCircuit(..)+  , ArrowChoice(..)+  , returnA+  , movebrc+  , backbrc+  , swapsnd+  ) +where+++import Prelude (id)++import System.ArrowVHDL.Circuit.Arrow.Class+import System.ArrowVHDL.Circuit.Arrow.Instance++++-- | 'returnA' is a standard arrow-function that is similar to return in the monad context+returnA :: (Arrow a) => a b b+returnA = arr id+++++-- | 'movebrc', 'backbrc' and 'swapsnd' are functions that change the order of tuples+movebrc :: ((a, b), c) -> (a, (b, c))+movebrc ~(~(x, y), sg) = (x, (y, sg))++backbrc :: (a, (b, c)) -> ((a, b), c)+backbrc ~(x, ~(y, sg)) = ((x, y), sg)++swapsnd :: ((a, b), c) -> ((a, c), b)+swapsnd ~(~(x, y), sg) = ((x, sg), y)
+ src/System/ArrowVHDL/Circuit/Arrow/Class.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE Arrows,+             OverlappingInstances, +             UndecidableInstances,+             IncoherentInstances,+             NoMonomorphismRestriction,+             MultiParamTypeClasses,+             FlexibleInstances,+             RebindableSyntax #-}+++-- Das Modul \hsSource{Circuit.Arrowdefinition} beschreibt, wie die Arrow-Klasse zu implementieren sind um damit später Schaltkreise beschreiben,+-- bearbeiten oder benutzen zu können.++module System.ArrowVHDL.Circuit.Arrow.Class +    ( Arrow(..)+    , ArrowLoop(..)+    , ArrowCircuit(..)+    , ArrowChoice(..)+    )+where++++-- Folgenden Module werden benötigt, um die Arrows definieren zu können:+import Prelude hiding (id, (.))+import qualified Prelude as Pr++import Control.Category ++import System.ArrowVHDL.Circuit.ShowType++++-- Durch die Angabe von Präzedenzen lassen sich Operatoren ohne Klammer schreiben. Dies hilft bei der Leserlichkeit von Quellcode. Folgende+-- Präzedenzen werden festgelegt:+++infixr 3 ***+infixr 3 &&&+++-- Zunächst einmal müssen die Klassen definiert werden. Diese Vorgaben müssen von allen Instanzdefinitionen befolgt werden.+++-- Hier folgt die Klassendefinition eines Arrows. Anzumerken ist, dass diese Klassendefinition geringfügig von der Standard-Definition+-- abweicht. Die Arrow-Klasse wird hier in der \hsSource{arr} Funktion soweit eingeschränkt, dass nur Funktionen (\hsSource{(b -> c)}) von+-- \hsSource{arr} akzeptiert werden, die Mitglied der Typklasse \hsSource{ShowType b c} sind. +++class (Category a) => Arrow a where+    arr    :: (ShowType b c) => (b -> c) -> a b c+    first  :: a b c -> a (b, d) (c, d)+    second :: a b c -> a (d, b) (d, c)+    second f = arr swap >>> first f >>> arr swap+             where swap :: (b, c) -> (c, b)+                   swap   ~(x, y)  = (y, x)+    (***)  :: a b c -> a b' c' -> a (b, b') (c, c')+    f *** g = first f >>> second g+    (&&&)  :: a b c -> a b c'  -> a b (c, c')+    f &&& g = arr (\b -> (b, b)) >>> f *** g++++-- Weitere Arrow Instanzen sind \hsSource{ArrowLoop}. Hierbei handelt es sich um Arrow, die sich selbst wieder aufrufen können, und somit einen+-- Fixpunkt in der Arrow-Funktion versuchen zu finden. +++class (Arrow a) => ArrowLoop a where+    loop :: a (b,d) (c,d) -> a b c++++-- Mit \hsSource{ArrowCircuit} sind die Arrows gemeint, die sich als getaktete Schaltung darstellen lassen. Definiert werden muss hier+-- lediglich, was ein Takt ist.+++class (ArrowLoop a) => ArrowCircuit a where+    delay :: b -> a b b++++-- Eine weitere Typklasse ist \hsSource{ArrowChoice}. Mit Arrow-Choice ist es Möglich, Varianten der selben Lösung parallel nebeneinander+-- erzeugen zu lassen. +++class (Arrow a) => ArrowChoice a where+    left  :: a b c -> a (Either b d) (Either c d) +    right :: a b c -> a (Either d b) (Either d c) +    (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')+    (|||) :: a b d -> a c  d  -> a (Either b c ) d++    right f = arr mirror >>> left f >>> arr mirror+        where mirror :: Either x y -> Either y x+              mirror (Left x)  = (Right x)+              mirror (Right x) = (Left x)++    f +++ g = left f  >>> right g++    f ||| g = f +++ g >>> arr untag+        where untag (Left x)  = x+              untag (Right x) = x+
+ src/System/ArrowVHDL/Circuit/Arrow/Helpers.hs view
@@ -0,0 +1,48 @@+-- Das Modul \hsSource{Circuit.Arrow.Helpers} beschreibt Hilfsfunktionen, zur Arrow-Gestaltung.+++module System.ArrowVHDL.Circuit.Arrow.Helpers+where++++-- Folgenden Module werden benötigt, um die Arrows definieren zu können:+++import Control.Category++import System.ArrowVHDL.Circuit.Arrow+import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Grid+import System.ArrowVHDL.Circuit.Stream+import System.ArrowVHDL.Circuit.Graphs +++++-- Weitere Hilfsfunktionen werden notwendig, um schon bestehende \hsSource{Grid}-Arrows mit Schaltkreis Beschreibungen anzureichern. +++insert :: b -> (a, b) -> (a, b)+insert sg ~(x, _) = (x, sg)++insEmpty = insert emptyCircuit { nodeDesc = nodedesc }+    where nodedesc = MkNode { label = "eeeempty", nodeId = 0, sinks = mkPins 1, sources = mkPins 3 }++augment :: (Arrow a) => CircuitDescriptor -> a b c -> Grid a b c+augment sg f = GR (f, sg)+++++-- Zu guter letzt werden noch Funktionen benötigt, die bei der Umstrukturierung von Daten gebraucht werden.+++movebrc :: ((a, b), c) -> (a, (b, c))+movebrc ~(~(x, y), sg) = (x, (y, sg))++backbrc :: (a, (b, c)) -> ((a, b), c)+backbrc ~(x, ~(y, sg)) = ((x, y), sg)++swapsnd :: ((a, b), c) -> ((a, c), b)+swapsnd ~(~(x, y), sg) = ((x, sg), y)
+ src/System/ArrowVHDL/Circuit/Arrow/Instance.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE Arrows,+             OverlappingInstances, +             UndecidableInstances,+             IncoherentInstances,+             NoMonomorphismRestriction,+             MultiParamTypeClasses,+             FlexibleInstances,+             RebindableSyntax #-}+++-- Das Modul \hsSource{Circuit.Arrowdefinition} beschreibt, wie die+-- Arrow-Klasse zu implementieren sind um damit später Schaltkreise+-- beschreiben, bearbeiten oder benutzen zu können.+++module System.ArrowVHDL.Circuit.Arrow.Instance+where++++-- Folgenden Module werden benötigt, um die Arrows definieren zu+-- können:+import System.ArrowVHDL.Circuit.Arrow.Class++++-- Da die folgende Arrow-Instanz nicht zur Ausführung benötigt wird,+-- sondern damit das Typsystem an anderer Stelle den richtigen Typ+-- ableiten kann, ist es möglich diese Instanz als \begriff{dummy+-- Instance} zu definieren. Dies bedeutet, dass die Instanz keine+-- definierten Methoden besitzt. Der Kompiler warnt die nicht+-- vorhandenen Methoden zwar an, es bleibt allerdings bei der Warnung.+++instance Arrow (->) where+    arr   f = f+    first f = (\(x, y) -> (f x, y))++-- Im folgenden wird eine Instanz der \hsSource{ArrowLoop}-Klasse für+-- einfache Funktionsauswertung definiert. Auch hier reicht eine+-- \begriff{dummy}-Definition für das Typsystem.++instance ArrowLoop (->) where+--    loop f b = let (c, d) = f (b, d) in c+ +
+ src/System/ArrowVHDL/Circuit/Auxillary.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE Arrows,+             RankNTypes #-}+module System.ArrowVHDL.Circuit.Auxillary +where++import Data.List (union, groupBy, isInfixOf)+import Data.Maybe+import Data.Either+import Control.Monad (msum)++import GHC.Exts (sortWith)++import System.ArrowVHDL.Circuit.Grid+import System.ArrowVHDL.Circuit.Stream++import Control.Category+import System.ArrowVHDL.Circuit.Arrow++import System.ArrowVHDL.Circuit.Grid+import System.ArrowVHDL.Circuit.Stream++import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Show+import System.ArrowVHDL.Circuit.Tests+import System.ArrowVHDL.Circuit.Splice+import System.ArrowVHDL.Circuit.Sensors+import System.ArrowVHDL.Circuit.Workers++import System.ArrowVHDL.Circuit.Graphs (emptyCircuit)++++-- 'nextID' is function that gets a list of component numbers and generates the next valid one+nextID :: [CompID] -> CompID+nextID []    = 0+nextID [cid] = cid + 1+nextID cids  = nextID [foldl max 0 cids]++++--  %%% Unter Ferner liefen XXX +-- Die Funktion \hsSource{onlyInnerEdges}+-- filtert aus einer Liste von Kanten genau diese Kanten heraus, die+-- die internen Kanten im Schaltkreis darstellen. Die Ergebnismenge+-- enthält keine Ein- und Ausgehenden Kanten.+onlyInnerEdges :: [Edge] -> [Edge]+onlyInnerEdges es = es'+    where es' = filter notIO $ es+          notIO :: Edge -> Bool+          notIO (MkEdge (Nothing, _) _) = False+          notIO (MkEdge _ (Nothing, _)) = False+          notIO _                       = True++++-- Typischerweise verwendet man den Begriff \begriff{Synthese} in der+-- Hardware-Community für den Prozess, aus einer Modellhaften+-- Hardwarebeschreibung heraus tatsächlichen Hardwarecode+-- (beispielsweise VHDL) zu erzeugen. Daneben ist auch die+-- \begriff{Simulation} von Hardwaremodellen notwendig, um die+-- entworfenen Modelle vor der Realisierung überprüfen zu können.+-- +-- +-- Die beiden Prozesse lassen sich auch auf das \hsSource{Grid}-Arrow+-- Modell übertragen. So stellt \hsSource{synthesize} eine Funktion+-- dar, die aus einem gegebenen \hsSource{Grid} die fertige+-- Hardwarebeschreibung \footnote{in diesem Fall ausgeliefert in VHDL}+-- ausliest. Die Simulation wird mittels der Funktion+-- \hsSource{simulate} abgebildet. Diese Funktion liest nun aus einem+-- \hsSource{Grid} den Arrow heraus und überführt diesen in einen+-- \hsSource{Stream}-Arrow, der dann mit einem kontinuierlichem+-- Datenstrom simuliert werden kann.++++testPreSynth :: (Arrow a) => Grid a b c -> (a b c, CircuitDescriptor)+testPreSynth (GR tuple) = tuple++test2PreSynt = snd++--synthesize :: (Arrow a) => Grid a b c -> CircuitDescriptor+--synthesize (GR (_, cd)) = flatten cd   +-- %%% TODO : Flatten won't work with Looping-Stuff ...+synthesize :: Grid (->) b c -> CircuitDescriptor+-- synthesize :: Grid (->) b c -> CircuitDescriptor+synthesize (GR (_, cd)) = cd+--synthesize (GR x) = snd x+    ++simulate :: Grid (->) b c -> Stream b c +simulate f = arr (toFunctionModel f)++++-- Um einen \hsSource{Grid}-Arrow kombinatorisch auszuwerten,+-- existiert die Hilfsfunktion \hsSource{toFunctionModel}, die ein+-- Synonym für \hsSource{runGrid} ist.+  ++toFunctionModel :: Grid (->) b c -> (b -> c)+toFunctionModel = runGrid++  ++-- %%% TODO : Ist synthesize mit unit () möglich? +-- %%% TODO : Keine zufälligen daten ... +-- %%% TODO : Frage nach simulate / synthesize => right ... +-- %%% TODO : _kritische_pfad_analyse_ / ... ++++ +-- Weitere Hilfsfunktionen werden notwendig, um schon bestehende \hsSource{Grid}-Arrows mit Schaltkreis Beschreibungen anzureichern. +++insert :: b -> (a, b) -> (a, b)+insert sg ~(x, _) = (x, sg)++insEmpty = insert emptyCircuit { nodeDesc = MkNode { label = "eeeempty", nodeId = 0, sinks = mkPins 1, sources = mkPins 3 } }++augment :: (Arrow a) => CircuitDescriptor -> a b c -> Grid a b c+-- augment = ( flip Prelude.. curry ) GR+augment cd_f f = GR (f, cd_f)+
+ src/System/ArrowVHDL/Circuit/Defaults.hs view
@@ -0,0 +1,454 @@+{-# LANGUAGE Arrows, NoMonomorphismRestriction, RebindableSyntax #-}+module System.ArrowVHDL.Circuit.Defaults where++import Control.Category +import Prelude hiding (id, (.))+import qualified Data.Bits as B -- (shiftL, shiftR, xor, (.&.))++import System.ArrowVHDL.Circuit++import System.ArrowVHDL.Circuit.Grid++import System.ArrowVHDL.Circuit.Arrow ++import System.ArrowVHDL.Circuit.Auxillary+import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Graphs+import System.ArrowVHDL.Circuit.Show+++type KeyChunk = Int+type ValChunk = Int+type Key   = (KeyChunk, KeyChunk, KeyChunk, KeyChunk)+type KeyHalf = (KeyChunk, KeyChunk)+type Value = (ValChunk, ValChunk)++-- xor :: Bool -> Bool -> Bool+-- xor x y | x == True && y == False = True+--         | x == False && y == True = True+--         | otherwise = False++oneNodeCircuit :: String -> CircuitDescriptor+oneNodeCircuit s = emptyCircuit { nodeDesc = emptyNodeDesc { label = s } }++aId :: (Arrow a) => Grid a b b+aId +    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "ID"+            , sinks   = mkPins 1+            , sources = mkPins 1 +            }+          , cycles  = 1+          , space   = 1+          }+    $ arr id+++aConst :: (Arrow a, Show b) => b -> Grid a c b+aConst x +    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc+            { label = "CONST_" ++ (show x)+            , sinks   = mkPins 1 -- a sink is needed for the rewire-function to work properly (TODO: is this ok?)+            , sources = mkPins 1+            }+          , cycles  = 0+          , space   = 1+          }+    $ arr (const x)+++(.&.) :: Bool -> Bool -> Bool+True .&. True = True+_    .&. _    = False++(.|.) :: Bool -> Bool -> Bool+False .|. False = False+_     .|. _     = True++xor :: Bool -> Bool -> Bool+xor True False = True+xor False True = True+xor _     _    = False++-- shiftL8 :: (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool)))))))) +--         -> Int +--         -> (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool))))))))+-- shiftL8 (x1, (x2, (x3, (x4, (x5, (x6, (x7, (x8)))))))) i +--   | i == 0 +--   = (x1, (x2, (x3, (x4, (x5, (x6, (x7, (x8))))))))+--   | i == 1+--   = (x2, (x3, (x4, (x5, (x6, (x7, (x8, (False))))))))+--   | i == 2 +--   = (x3, (x4, (x5, (x6, (x7, (x8, (False, (False))))))))+--   | i == 3 +--   = (x4, (x5, (x6, (x7, (x8, (False, (False, (False))))))))+--   | i == 4 +--   = (x5, (x6, (x7, (x8, (False, (False, (False, (False))))))))+--   | i == 5 +--   = (x6, (x7, (x8, (False, (False, (False, (False, (False))))))))+--   | i == 6 +--   = (x7, (x8, (False, (False, (False, (False, (False, (False))))))))+--   | i == 7 +--   = (x8, (False, (False, (False, (False, (False, (False, (False))))))))+--   | i == 8 +--   = (False, (False, (False, (False, (False, (False, (False, (False))))))))+-- shiftL = shiftL8++-- shiftR8 :: (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool)))))))) +--         -> Int +--         -> (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool))))))))+-- shiftR8 (x1, (x2, (x3, (x4, (x5, (x6, (x7, (x8)))))))) i +--   | i == 0 +--   = (x1, (x2, (x3, (x4, (x5, (x6, (x7, (x8))))))))+--   | i == 1+--   = (False, (x1, (x2, (x3, (x4, (x5, (x6, (x7))))))))+--   | i == 2 +--   = (False, (False, (x1, (x2, (x3, (x4, (x5, (x6))))))))+--   | i == 3 +--   = (False, (False, (False, (x1, (x2, (x3, (x4, (x5))))))))+--   | i == 4 +--   = (False, (False, (False, (False, (x1, (x2, (x3, (x4))))))))+--   | i == 5 +--   = (False, (False, (False, (False, (False, (x1, (x2, (x3))))))))+--   | i == 6 +--   = (False, (False, (False, (False, (False, (False, (x1, (x2))))))))+--   | i == 7 +--   = (False, (False, (False, (False, (False, (False, (False, (x1))))))))+--   | i == 8 +--   = (False, (False, (False, (False, (False, (False, (False, (False))))))))+-- shiftR = shiftR8++-- aAnd :: (Arrow a, Bits b) => Grid a (b, b) (b)+aAnd :: (Arrow a) => Grid a (Bool, Bool) (Bool)+aAnd +    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "AND"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (uncurry (.&.)) +++-- aOr :: (Arrow a, Bits b) => Grid a (b, b) (b) -- :: (Arrow a) => Grid a (Bool, Bool) (Bool)+aOr :: (Arrow a) => Grid a (Bool, Bool) (Bool)+aOr+    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "OR"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (uncurry (.|.)) +++aNot :: (Arrow a) => Grid a (Bool) (Bool)+aNot+    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "NOT"+            , sinks   = mkPins 1+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 2+          }+    $ arr (not) +++aBXor :: (Arrow a, B.Bits b) => Grid a (b, b) (b)    -- :: (Arrow a) => Grid a (Bool, Bool) (Bool)+aBXor +    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "XOR"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (uncurry B.xor)++aXor :: (Arrow a) => Grid a (Bool, Bool) (Bool)+aXor +    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "XOR"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (uncurry xor)+++-- aFst :: (Arrow a, Bits b) => Grid a (b, c) (b)+aFst :: (Arrow a) => Grid a (b, c) (b)+aFst +    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "FST"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (fst) +++-- aSnd :: (Arrow a, Bits c) => Grid a (b, c) (c)+aSnd :: (Arrow a) => Grid a (b, c) (c)+aSnd +    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc+            { label   = "SND"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (snd) +++aShiftL :: (Arrow a, B.Bits b) => Grid a (b, Int) (b)+-- aShiftL :: (Arrow a) => Grid a ((Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool))))))), Int) (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool)))))))+aShiftL +    = augment+        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "SHIFTL"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 6+          }+    $ arr (uncurry B.shiftL) ++aShiftR :: (Arrow a, B.Bits b) => Grid a (b, Int) (b)+-- aShiftR :: (Arrow a) => Grid a ((Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool))))))), Int) (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool)))))))+aShiftR +    = augment+        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "SHIFTR"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 6+          }+    $ arr (uncurry B.shiftR) ++aAdd :: (Arrow a, Num b) => Grid a  (b, b) (b)+aAdd +    = augment+        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "ADD"+            , sinks   = mkPins 2+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (uncurry (+))++aFlip :: (Arrow a) => Grid a (b, c) (c, b)+aFlip +    = augment+         emptyCircuit+           { nodeDesc = emptyNodeDesc +             { label   = "FLIP"+             , sinks   = mkPins 2+             , sources = mkPins 2+             }+           , cycles  = 1+           , space   = 4+           }+    $ arr (\(x, y) -> (y, x))++aSwapSnd :: (Arrow a) => Grid a ((b, c), d) ((b, d), c)+aSwapSnd+    = augment+         emptyCircuit+           { nodeDesc = emptyNodeDesc +             { label   = "SWPSND"+             , sinks   = mkPins 2+             , sources = mkPins 2+             }+           , cycles  = 1+           , space   = 6+           }+    $ arr (\((x, y), z) -> ((x, z), y))++aAssocRight = a_ABc2aBC+aAssocLeft  = a_aBC2ABc++a_ABc2aBC :: (Arrow a) => Grid a ((b, c), d) (b, (c, d))+a_ABc2aBC    +    = augment+         emptyCircuit+           { nodeDesc = emptyNodeDesc +             { label   = "ABc2aBC"+             , sinks   = mkPins 2+             , sources = mkPins 2+             }+           , cycles  = 1+           , space   = 6+           }+    $ arr (\((x, y), z) -> (x, (y, z)))++a_aBC2ABc :: (Arrow a) => Grid a (b, (c, d)) ((b, c), d)+a_aBC2ABc    +    = augment+         emptyCircuit+           { nodeDesc = emptyNodeDesc +             { label   = "aBC2ABc"+             , sinks   = mkPins 2+             , sources = mkPins 2+             }+           , cycles  = 1+           , space   = 6+           }+    $ arr (\(x, (y, z)) -> ((x, y), z))+++-- |'aDistr' defines an distributivity of an expression ... +-- (x,(a,b))  ->  ((x,a), (x,b))++-- aDistr :: (Arrow a, Bits b, Bits c, Bits d) => Grid a (b, (c, d)) ((b, c), (b, d))+aDistr :: (Arrow a) => Grid a (b, (c, d)) ((b, c), (b, d))+aDistr +    =   aDup+    >>> second aFst *** second aSnd++-- |'aDdistr' is the reverse operation to the Distr operation++-- aDdistr :: (Arrow a, Bits b, Bits c, Bits d, Bits e) => Grid a ((b, c), (d, e)) ((b, d), (c, e))+aDdistr :: (Arrow a) => Grid a ((b, c), (d, e)) ((b, d), (c, e))+aDdistr +    =   aSwapSnd+    >>> a_aBC2ABc *** aId+    >>> a_ABc2aBC+    >>> aId *** aFlip++aShiftL4 :: (Arrow a, B.Bits b) => Grid a b b +-- aShiftL4 :: (Arrow a) => Grid a (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool))))))) (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool)))))))+aShiftL4 +    = augment+        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "SHIFTL4"+            , sinks   = mkPins 1+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 6+          }+    $ arr (flip B.shiftL 4)++aShiftR5 :: (Arrow a, B.Bits b) => Grid a b b+-- aShiftR5 :: (Arrow a) => Grid a (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool))))))) (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, Bool)))))))+aShiftR5 +    = augment+        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "SHIFTR5"+            , sinks   = mkPins 1+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 6+          }+    $ arr (flip B.shiftR 5)++-- aShiftL4addKey :: (Arrow a) => Grid a (ValChunk, KeyChunk) Int+-- aShiftL4addKey +--     =   first aShiftL4+--     >>> aAdd++-- aShiftR5addKey :: (Arrow a) => Grid a (ValChunk, KeyChunk) Int+-- aShiftR5addKey +--     =   first aShiftR5+--     >>> aAdd+++--- NOTE: Hier ist ein schönes Problem aufgetreten:+-- da weiter unten arr ... >>> aAdd verwendet wird, und arr ... vom Typ Arrow a ist+-- aber aAdd vom Typ Grid a ist, gibt's nen type-mismatch... entweder aAdd muss auf Arrow a+-- runtergebrochen werden, oder arr ... muss vorher schon in einen Grid gehoben werden :) +-- +-- So oder so, schön ;) +--aAddMagic :: (Arrow a) => Grid a ValChunk Int+aXorMagic+    = augment +        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "ADDMAGIC"+            , sinks   = mkPins 1+            , sources = mkPins 1+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (\x -> (x, 2654435769)) >>> aBXor++--aDup :: (Arrow a) => Grid a b (b, b)+aDup+    = augment+        emptyCircuit +          { nodeDesc = emptyNodeDesc +            { label   = "DUP"+            , sinks   = mkPins 1+            , sources = mkPins 2+            }+          , cycles  = 1+          , space   = 4+          }+    $ arr (\(x) -> (x, x)) ++aRegister :: (Arrow a) => Grid a b b +aRegister +    = augment +        ( mkRegister $ emptyNodeDesc+                       { sinks   = mkPins 1+                       , sources = mkPins 1+                       }+        )+    $ arr id+        ++-- aL_headtail :: (Arrow a) => Grid a ([b]) (b, [b])+-- aL_headtail +--     = augment +--         emptyCircuit +--             { nodeDesc = emptyNodeDesc+--                 { label   = "listHEADTAIL"+--                 , sinks   = mkPins 1+--                 , sources = mkPins 2+--                 }+--             , cycles = 2+--             , space  = 16+--             }+--     $ arr (\(x:xs) -> (x, xs))
+ src/System/ArrowVHDL/Circuit/Descriptor.hs view
@@ -0,0 +1,236 @@+-- Im folgenden wird der das Modul \hsSource{Circuit.Descriptor} beschrieben++module System.ArrowVHDL.Circuit.Descriptor+where+++-- \subsection{Typen mit neuen Namen} +-- Zunächst werden grundlegende Typaliasse vergeben, die im gesamten+-- Quelltext Anwendung finden.+++-- Jede Hardware Komponente besitzt Pins verschiedener Art, darunter+-- ein- und ausgehende. Diese sind durchnummeriert und werden über+-- ihre Nummer, die als Integer abgebildet wird, identifiziert. Für+-- die Komponenten ID gilt dies ebenfalls.+-- +--  +-- Daneben wird der Typ für einen \begriff{Clock-Cycle} definiert. In+-- diesem Fall wird ein Integer dafür verwendet. Auch die Fläche wird+-- mit einem Integer beschrieben. Für die Fläche besagt der Wert,+-- wieviele \begriff{Zellen} der Baustein belegt. %%% TODO : Was ist+-- eine Zelle?++type PinID = Int+type Pins  = [PinID]++type ID     = Int+type CompID = ID++type Tick   = Int+type Area   = Int++++-- Eine Kante ist eine Verbindung zwischen zwei \hsSource{Pins}, dabei+-- müssen die beiden \hsSource{Pins} nicht unbedingt zu+-- unterschiedlichen Komponenten gehören \footnote{Beispielsweise bei+-- zyklischen Schaltungen}. Das Tupel aus \hsSource{PinID} und+-- \hsSource{CompID} identifiziert einen Pin. Da auch Kanten+-- abgebildet werden sollen, die nach außerhalb der aktuellen+-- Komponente gehen sollen, ist es notwendig, die \hsSource{CompID}+-- als \hsSource{Maybe} Typ zu beschreiben. Das Tupel wird im+-- folgenden mit \hsSource{Anchor} bezeichnet.++type Anchor       = (Maybe CompID, PinID)+type SinkAnchor   = Anchor+type SourceAnchor = Anchor+++-- Außerdem wurden noch zwei weitere Aliasse vergeben, die Eingehende+-- (\hsSource{SinkAnchor}) und Ausgehende (\hsSource{SourceAnchor})+-- Pins voneinander unterscheiden.+-- +-- \subsection{Benannte Typen} Um die Graph-Struktur später in+-- Sourcecode überführen zu können, benötigt man Namen für+-- \hsSource{Anchor} und \hsSource{Edges} sowie Lookup-Tabellen, in+-- denen dann die Namen abgelegt werden. Die Typaliasse hierfür werden+-- hier direkt definiert.++type NamedPins = [(String, Anchor)]+type NamedSigs = [(String, Edge)]+type NamedSnks = NamedPins+type NamedSrcs = NamedPins+type NamedIOs  = (NamedSnks, NamedSrcs)++nameSig = "i"+nameExI = "inc"+nameExO = "out"+nameInI = "e"+nameInO = "a"++++-- \subsection{Schaltungsbeschreibung} Jede Komponente die durch einen+-- Arrow repräsentiert wird, hat zusätzliche Attribute, die nicht in+-- dem Arrow selber stehen. Diese Attribute werden auch nicht für alle+-- Arrow-Klassen Instanzen benötigt. Daher sind diese lose an den+-- Arrow gekoppelt. \footnote{Arrow und Attribute werden in einem+-- Tupel zusammengefasst}+-- +-- %%% TODO : is Circuit the right name? Component is better or: Chip / Device / Module / what ever+-- %%% TODO : MkSG und NoSG sind die falschen Konstruktoren++++-- \subsection{Pins} Zunächst werden grundlegende Typaliasse vergeben,+-- die im gesamten Quelltext Anwendung finden.+++-- Jede Hardware Komponente besitzt Pins verschiedener Art, darunter+-- Eingabe- und Ausgabepins.++-- \subsection{Schaltungsbeschreibung} Jede Komponente die durch einen+-- Arrow repräsentiert wird, hat zusätzliche Attribute, die nicht in+-- dem Arrow selber stehen. Diese Attribute werden auch nicht für alle+-- Arrow-Klassen Instanzen benötigt. Daher sind diese lose an den+-- Arrow gekoppelt. \footnote{Arrow und Attribute werden in einem+-- Tupel zusammengefasst} +++-- Hier wird unterschieden zwischen Kombinatorischen Schaltungen+-- \hsSource{MkCombinatorial}, Registern \hsSource{MkRegister} und+-- nicht vorhandenen Schaltungen \hsSource{NoDescriptor}. %%% TODO :+-- Wie fließt hier MkComposite rein?+++-- Ein Register unterscheidet sich von einer kombinatorischen+-- Schaltung, teilweise gibt es Gemeinsamkeiten. Diese Gemeinsamkeiten+-- werden über den Datentyp \hsSource{NodeDescriptor} verkörpert.++++data NodeDescriptor+    = MkNode+      { label   :: String +      , nodeId  :: ID+      , sinks   :: Pins+      , sources :: Pins+      }+    deriving (Eq)+ ++++-- Der \hsSource{NodeDescriptor} taucht in der Definition eines+-- Schaltkreises, aber auch in der Definition eines Registers, auf.+++data CircuitDescriptor+    = MkCombinatorial+      { nodeDesc  :: NodeDescriptor+      , nodes     :: [CircuitDescriptor]+      , edges     :: [Edge]+      , cycles    :: Tick+      , space     :: Area+      }++    | MkRegister+      { nodeDesc  :: NodeDescriptor+      , bits      :: Int+      }++    | MkLoop+      { nodeDesc  :: NodeDescriptor+      , nodes     :: [CircuitDescriptor]+      , edges     :: [Edge]+      , space     :: Area+      }++    | MkComposite+      { composite :: [CircuitDescriptor]+      }++    | NoDescriptor+    deriving (Eq)++type Netlist = CircuitDescriptor+++-- In Haskell lassen sich die Komponenten Attribute über einen+-- Summentyp abgebildet. Dieser Datentyp ist ein fundamentaler+-- Datentyp, da er gleichberechtigt neben der eigentlichen+-- Funktionalität steht. Er besitzt einen Bezeichner \hsSource{label},+-- sowie eine eindeutige ID \hsSource{nodeId}. Zusätzlicher sind die+-- Ein- sowie die Ausgehenden Pins aufgeführt und auch die+-- verbindenden Kanten (\hsSource{edges}).+-- +--  +-- Jede Komponente kann durch untergeordnete Komponenten beschrieben+-- werden. Dies wird im Datentyp über die \hsSource{nodes} Liste+-- abgebildet.  Ist die Komponenten atomar, so enthält dieses Datum+-- die leere Liste. Der Konstruktor \hsSource{NoSG} ist analog zu+-- $\varnothing$.  %%% TODO : Mathematisch erklären warum {} benötigt+-- wird+-- +-- +-- Um zu verhindern, dass ungültige Schaltungsbeschreibungen erzeugt+-- werden, können \begriff{smart constructor}s eingesetzt+-- werden. Hierbei handelt es sich um Funktionen, die analog zu den+-- Konstruktoren arbeiten. Diese unterscheiden sich darin, dass die+-- Konstruktoren jedes Datum erzeugen. Allerdings ist es häufig nicht+-- gewünscht, jedes Datum erzeugen zu können oder es ist gewünscht,+-- dass der Benutzer beim Versuch ein falsches Datum zu erzeugen, mit+-- einer Fehlermeldung konfrontiert wird.+-- +-- +-- Es folgt der Quellcode des \begriff{smart constructor}s für ein+-- Register. Hierbei ist nur darauf zu achten, dass dieses Register+-- keine ID bekommt, die schon einmal vergeben wurde.+-- +-- %%% TODO : error checking muss hier noch rein+++mkRegister :: NodeDescriptor -> CircuitDescriptor+mkRegister nd +    = MkRegister  +      { nodeDesc = nd { label = "REG" ++ (show $ nodeId nd) } +      , bits     = length $ sinks nd+      }+ +++-- Zuletzt fehlt jetzt lediglich die Definition einer Kante. Eine+-- Kante kennt einen Quell-Pin sowie einen Ziel-Pin.++data Edge+    = MkEdge { sourceInfo :: SourceAnchor+             , sinkInfo   :: SinkAnchor+             }+    deriving (Eq)++++-- \subsection{Smarte Konstruktoren} In Haskell lassen sich Typen sehr+-- fein granular definieren. Für die Liste der Pins einer Schaltung+-- passt eine Liste von Integer-Werten sehr gut aber nicht perfekt. So+-- gibt es auch Integer-Listen mit keinem Inhalt. Wollte man das auf+-- der Typebene verhindern, so würde dies einen Overhead erfordern,+-- der nicht im Verhältnis zu dem Nutzen stehen würde. Eine einfache+-- aber nützliche Alternative sind \begriff{smart+-- constructor}. Hierbei handelt es sich um einen Funktion, die als+-- Parameter alle Werte bekommt, die benötigt werden, um ein Datum des+-- gewünschten Types zu erzeugen. Die Funktion erzeugt dann ein+-- solches Datum und kann sich daneben auch noch um+-- Fehler-Behandlungen kümmern.  %%% TODO : Boxed Types reference+-- +-- +-- Bei \hsSource{mkPins} handelt es sich um so einen \begriff{smart+-- Constructor}. Dieser erhält die Anzahl der benötigten Pins als+-- Parameter und erzeugt dann eine entsprechende Liste.+++mkPins :: Int -> Pins+mkPins 0 = error $ show "It is not possible to generate a component with 0 pins"+mkPins n = [0..n-1]+
+ src/System/ArrowVHDL/Circuit/EdgeTransit.hs view
@@ -0,0 +1,79 @@+-- In diesem Modul wird ein Algebraischer Datentyp aufgebaut. Dieses Datum wird im Codegenerator zur Generierung des Zielcodes benötigt. Der % TODO : Referenz+-- Algebraische Datentyp besteht aus einem Tupel, dass aus einer Liste von Ankerpunkten sowie den dazugehörigen Namen, besteht. +++module System.ArrowVHDL.Circuit.EdgeTransit+where++++-- Im späteren wird die Funktionen aus dem \ref{mod:Circuit.Descriptor} Modul benötigt, sowie die Funktion \hsSource{isJust} aus \hsSource{Data.Maybe}.++import Data.Maybe (isJust)+import System.ArrowVHDL.Circuit.Descriptor+++-- \subsection{Datenstruktur}+-- Die Zwischenstruktur \hsSource{NamedEdge} wird über ein Typalias definiert. Hierbei wird einem Namen eine Liste von Ankerpunkten zugeordnet.++type NamedEdge = ([Anchor], String)++++-- \subsection{Funktionen}+-- Zu der Datenstruktur gehören folgende Funktionen:+-- \begin{itemize}+--   \item \hsSource{generateNamedEdges} \\+--         Eine Funktion die aus einem Graphen eine Liste benannter Kanten erstellt+--   \item \hsSource{getAllEdgeNames} \\+--         Eine Funktion welche eine Liste benannter Kanten nutzt, um eine Liste von Namen zu erstellen+--   \item \hsSource{getEdgeName} +--         Eine Funktion die einen Namen aus der Liste benannter Kanten und einem Ankerpunkt erzeugt+-- \end{itemize}+++++-- Die Funktion \hsSource{generateNamedEdges} filtert aus dem übergebenen \hsSource{CircuitDescriptor} die Kanten heraus. Von allen Kanten+-- werden die Kanten heraus gefiltert, die nach \begriff{außen} verbinden. Diese Kanten haben als Quell- oder Zielkomponente \hsSource{Nothing}+-- gesetzt. Die relevanten Kanten werden durchnumeriert und in der Form einer \hsSource{NamedEdge} zurückgeliefert. ++pre :: String+pre = nameSig++generateNamedEdges :: CircuitDescriptor -> [NamedEdge]+generateNamedEdges g+    = map (\(i, e) -> (sourceInfo e : sinkInfo e : [], pre ++ show i))+        $ zip [0..] relevantEdges+        where relevantEdges = filter (\  (MkEdge (ci,_) (co,_))+                                      -> isJust ci && isJust co)+                            $ edges g++++-- \hsSource{getAllEdgeNames} filtert lediglich das zweite Datum aus dem Tupel heraus. ++getAllEdgeNames :: [NamedEdge] -> [String]+getAllEdgeNames = map snd++++-- Zum ermitteln des Namens einer Kante, die an einem bestimmten Ankerpunkt beginnt oder endet, wird ein Funktion \hsSource{getNamedEdge}+-- definiert. Hierzu wird überprüft, ob der übergebene Ankerpunkt in einer der benannten Kanten vorkommt. Ist dies der Fall, wird das erste+-- Element der Ergebnisliste zurückgeliefert. %%% TODO : ist der Anker nicht vorhanden, erzeugt das eine ``empty List'' exception++getNamedEdge :: [NamedEdge] -> Anchor -> NamedEdge+getNamedEdge nedgs ap+      = head+      $ filter (\(aps, _) -> ap `elem` aps)+      $ nedgs++++-- Um nur den Namen einer Kante zu ermitteln, die einen bestimmten Ankerpunkt verbindet, wir die Funktion \hsSource{getEdgeName} definiert.+-- Diese filtert den zweiten Wert des Ergebnisstupels von \hsSource{getNamedEdge} heraus und liefert ihn als Rückgabe.++getEdgeName :: [NamedEdge] -> Anchor -> String+getEdgeName nedgs ap+      = snd $ getNamedEdge nedgs ap+
+ src/System/ArrowVHDL/Circuit/Graphs.hs view
@@ -0,0 +1,90 @@+-- Dieser Abschnitt stellt einige Standard-Schaltkreise vor. Diese können als Grundlage für komplexere Schaltkreise herangezogen werden. +++module System.ArrowVHDL.Circuit.Graphs+where+ ++ +-- Verwendet wird ausschließlich das Modul \ref{mod:Circuit.Graphs} (\hsSource{Circuit.Descriptor}).++++import System.ArrowVHDL.Circuit.Descriptor+ ++-- \subsection{Leerer Schaltkreis}+-- Zunächst wird ein leerer Schaltkreis definiert, also ein Datum des Types \hsSource{CircuitDescriptor}. Dieses Datum enthält zwar die+-- korrekte Struktur, aber keine Nutzdaten. \hsSource{String}s sind leer \footnote{der \hsSource{String} ``...'' ist für das Debugging bewusst+-- nicht leer}, \hsSource{Integer} werden auf $0$ gesetzt und Listen sind jeweils leere Listen.+-- +--  +-- Da ein \hsSource{CircuitDescriptor} auch aus einem \hsSource{NodeDescriptor} aufgebaut ist, liegt es auf der Hand, auch einen leeren+-- \hsSource{NodeDescriptor} zu definieren. ++++emptyNodeDesc :: NodeDescriptor+emptyNodeDesc +    = MkNode { label   = "..."+             , nodeId  = 0+             , sinks   = []+             , sources = []+             }+ ++++-- Der leere Schaltkreis lässt sich jetzt über den leeren \hsSource{NodeDescriptor} beschreiben.+++emptyCircuit :: CircuitDescriptor+emptyCircuit +    = MkCombinatorial+      { nodeDesc = emptyNodeDesc+      , nodes   = []+      , edges   = []+      , cycles  = 0+      , space   = 0+      }+ ++-- \subsection{Schaltkreis Modifikatoren}+-- Neben der leeren Schaltung werden weitere Schaltungen benötigt, die größtenteils Unterschiede im Namen und in der Anzahl der Ein- und+-- Ausgängen haben. Diese könnte man definieren, indem die Beschreibung der leeren Schaltung an den entsprechenden Stellen überschrieben wird.+-- Schöner ist es allerdings, wenn man hier auf Modifikatoren zurückgreifen kann, welche die Aufgabe übernehmen. Bei Änderungen an der+-- \hsSource{CircuitDescriptor} Struktur müssen dann nur die Modifikatoren verändert werden, nicht aber sämtliche Schaltungsdefinitionen. ++++withLabel :: String -> CircuitDescriptor -> CircuitDescriptor+withLabel l cd   = cd { nodeDesc = nd { label = l } }+    where nd = nodeDesc cd++sinkCount :: Int -> CircuitDescriptor -> CircuitDescriptor+sinkCount i cd   = cd { nodeDesc = nd { sinks = [0..(i-1)] } }+    where nd = nodeDesc cd++sourceCount :: Int -> CircuitDescriptor -> CircuitDescriptor+sourceCount i cd = cd { nodeDesc = nd { sources = [0..(i-1)] } }+    where nd = nodeDesc cd+ +++-- Mithilfe der Modifikatoren lassen sich nun die weiteren Schaltkreise definieren: +++arrCircuit +    = withLabel "-ARR-" . sinkCount 1 . sourceCount 1 $ emptyCircuit++throughCircuit +    = withLabel "(-)"   . sinkCount 1 . sourceCount 1 $ emptyCircuit++idCircuit +    = withLabel "-ID-"  . sinkCount 1 . sourceCount 1 $ emptyCircuit++leftCircuit+    = withLabel "(L)"   $ emptyCircuit++rightCircuit+    = withLabel "(R)"   $ emptyCircuit
+ src/System/ArrowVHDL/Circuit/Grid.hs view
@@ -0,0 +1,13 @@+-- Das Modul \hsSource{Circuit.Grid} stellt ein Wrapper-Modul nach dem Fassaden Entwurfsmuster dar.++module System.ArrowVHDL.Circuit.Grid +    ( Grid(..)+    , runGrid+    )+where+++-- Folgenden Module werden benötigt, um die Arrows definieren zu können:++import System.ArrowVHDL.Circuit.Grid.Datatype+import System.ArrowVHDL.Circuit.Grid.Instance
+ src/System/ArrowVHDL/Circuit/Grid/Datatype.hs view
@@ -0,0 +1,28 @@+-- Das Modul \hsSource{Circuit.Arrowdefinition} beschreibt, wie die+-- Arrow-Klasse zu implementieren sind um damit später Schaltkreise+-- beschreiben, bearbeiten oder benutzen zu können.++module System.ArrowVHDL.Circuit.Grid.Datatype+where++-- Folgenden Module werden benötigt, um den Datentyp definieren zu können:++import Control.Arrow++import System.ArrowVHDL.Circuit.Descriptor+++-- Ein \hsSource{Grid} ist ein Datentyp, für den die Arrow-Klassen+-- implementiert werden. Man spricht dann von einem+-- \hsSource{Grid}-Arrow. Der Name \hsSource{Grid} soll dabei an ein+-- Steckbrett erinnern, auf denen man Bauteile anbringen und+-- miteinander verbinden kann. \hsSource{Grid} besitzt 3 Typvariablen+-- (\hsSource{a}, \hsSource{b}, \hsSource{c}), wobei \hsSource{a} die+-- jeweilige Arrow-Instanz repräsentiert (z.B.  \hsSource{(->)}),+-- \hsSource{b} und \hsSource{c} stellen den Typ des Arrows dar. Die+-- Funktion \hsSource{(+1)} hat den Typ \hsSource{Int -> Int}. Dies+-- lässt sich auch in präfix-Notation schreiben \hsSource{(->) Int+-- Int} und ist damit analog zu den Typvariablen des \hsSource{Grid}+-- Types.++newtype Grid a b c = GR (a b c, CircuitDescriptor)
+ src/System/ArrowVHDL/Circuit/Grid/Instance.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE Arrows,+             OverlappingInstances, +             UndecidableInstances,+             IncoherentInstances,+             NoMonomorphismRestriction,+             MultiParamTypeClasses,+             FlexibleInstances,+             RebindableSyntax #-}++-- Das Modul \hsSource{Circuit.Grid.Instance} beschreibt, wie die+-- Arrow-Instanzen des Grid-Datentypes implementiert werden.++module System.ArrowVHDL.Circuit.Grid.Instance+where+++-- Folgenden Module werden benötigt, um die Arrows definieren zu+-- können:++import System.ArrowVHDL.Circuit.Grid.Datatype++import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Graphs+import System.ArrowVHDL.Circuit.Workers (flatten)+import System.ArrowVHDL.Circuit.ShowType++import Prelude hiding (id, (.))+import qualified Prelude as Pr++import Control.Category ++import System.ArrowVHDL.Circuit.Arrow++import System.ArrowVHDL.Circuit.Splice+++-- Bevor für den Typ \hsSource{Grid} eine Arrow-Instanz implementiert+-- werden kann, muss \hsSource{Grid} Mitglied der Typklasse+-- \hsSource{Category} sein.++instance (Category a) => Category (Grid a) where+    id              +      = id++    GR (f, cd_f) . GR (g, cd_g) +      = GR $ (f . g, cd_g `connect` cd_f)+++-- Im nächsten Schritt wird dann die Arrow-Instanz von \hsSource{Grid}+-- implementiert. Laut Definition ist ein Arrow vollständig definiert+-- durch die Funktionen \hsSource{arr} und \hsSource{first}. Alle+-- weiteren Funktion lassen sich aus diesen beiden ableiten. Da hier+-- aber die Kontrolle über die Implementierung jeder Funktion behalten+-- werden soll, ist hier eine Implementation für alle+-- einzel-Funktionen gegeben.++instance (Arrow a) => Arrow (Grid a) where+    arr   f       +      = error $ "Can't construct arbitarly Hardware-Components" -- GR $ (arr f, showType f)+  +    first (GR (f, cd_f))+      = GR ( first f+           , cd_f `combine` idCircuit+           )+  +    second (GR (g, cd_g))+      = GR ( second g+           , idCircuit `combine` cd_g+           )+  +    GR (f, cd_f) &&& GR (g, cd_g) +      = GR ( f &&& g+           , cd_f `combine` cd_g+           )+  +    GR (f, cd_f) *** GR (g, cd_g) +      = GR ( f *** g+           , cd_f `combine` cd_g+           )+++-- Die Definition von \hsSource{ArrowLoop} ist dann notwendig, wenn+-- Schleifen abgebildet werden sollen. Hierzu ist die Implementation+-- einer einzigen Funktion notwendig, nämlich der \hsSource{loop :: a+-- (b, d) (c, d) -> a b c} notwendig.+-- +-- %%% TODO : Ersetzte diese Hardcoding version in eine, die+-- vielleicht ein wenig vergebender ist ;)++instance (ArrowLoop a) => ArrowLoop (Grid a) where+    loop (GR (f, cd_f)) = GR (loop f, loopWithRegister cd_f)++++instance (ArrowCircuit a) => ArrowCircuit (Grid a) where+    delay x = GR (delay x, mkRegister $ MkNode "" 0 (mkPins 1) (mkPins 1))++++-- Um den \hsSource{Grid}-Arrow zu \hsSource{ArrowChoice} hinzufüge,+-- so ist die Implementierung von \hsSource{ArrowChoice} für+-- \hsSource{Grid} notwendig.+-- +--   instance (Arrow a) => ArrowChoice (Grid a) where+--       left  f = f      +++ arr id+--       right g = arr id +++ g +--       f +++ g = (Left . f) ||| (Right . g)+--       f ||| g = either+++-- Zu dem \hsSource{Grid}-Arrow gehört außerdem noch eine Funktion,+-- die den \hsSource{Grid}-Typ auspacken kann und dann ``ausführen''+-- kann.++runGrid :: (Arrow a) => Grid a b c -> a b c+runGrid (GR (f, _)) = f
+ src/System/ArrowVHDL/Circuit/IEEE_STD_LOGIC_1164.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE Arrows, NoMonomorphismRestriction, RebindableSyntax #-}+module System.ArrowVHDL.Circuit.IEEE_STD_LOGIC_1164  +       ( aAnd+       , aOr+       , aXor+       , aNot+       ) where++import System.ArrowVHDL.Circuit.Defaults (aAnd, aOr, aXor, aNot)++
+ src/System/ArrowVHDL/Circuit/PinTransit.hs view
@@ -0,0 +1,145 @@+-- Dieses Modul definiert einen Algebraischen Datentyp der im Codegenerator zur Generierung des Zielcodes benötigt. Er enthält die % TODO : Referenz+-- Komponenten ID, sowie benannte Ein- und Ausgangspins.+++module System.ArrowVHDL.Circuit.PinTransit+where+++++-- Benötigt werden Modul-Definitionen aus \hsSource{Circuit}.+++import System.ArrowVHDL.Circuit.Descriptor+++-- \subsection{Datenstruktur}+-- Zunächst werden Typaliasse angelegt, welche die verwendeten Datentypen nach ihrer Aufgabe benennen. +++type NamedPin  = (PinID, String)+type InNames   = [NamedPin]+type OutNames  = [NamedPin]++type NamedComp = (CompID, (InNames, OutNames))+ +++-- \subsection{Funktionen}+-- Um die interne Datenstruktur des Algebraischen Datentypes bedienen zu können, werden folgende Funktionen definiert++--   generateNamedComps % \\ Eine Funktion die aus einem CircuitDescriptor die Benamte Komponentenliste erstellt+--   getInPinNames      % \\ Eine Funktion die eine In-PinID / Namen's Liste aus der NamedComp Liste erzeugt+--   getOutPinNames     % \\ Eine Funktion die eine Out-PinID / Namen's Liste aus der NamedComp Liste erzeugt+--   getInPinName       % \\ Eien weitere Funktion die ein InPinID/Namens Paar aus der NamedComp Liste und aus einer PinID erstellt+--   getOutPinName      % \\ Eien weitere Funktion die ein OutPinID/Namens Paar aus der NamedComp Liste und aus einer PinID erstellt++ +-- Die Funktion \hsSource{generateNamedComps} erzeugt die benannten Komponenten Liste. Hier werden nur die Pins benannt. Ein Pin kann immer von+-- zwei Seiten aus gesehen werden. Es gibt \begriff{externe} Pins, also Pins, die an die von außen ein Draht angeschlossen werden kann. Diese+-- werden unter dem namen \hsSource{generateSuperNames} zusammengefasst. Daneben existieren auch \begriff{interne} Pins, die man hinter dem+-- Namen \hsSource{generateSubNames} findet. Diese Unterscheidung muss getroffen werden, da externe Pins mit den Präfixen \hsSource{nameExI}+-- und \hsSource{nameExO} versehen werden. Interne Pins werden mit \hsSource{nameInI} sowie \hsSource{NameInO} benamt.+-- \hsSource{generateSuperNames} wird auf den übergebenen \hsSource{CircuitDescriptor} angewandt, die Funktion \hsSource{generateSubNames}+-- hingegen auf alle dem \hsSource{CircuitDescriptor} untergeordneten \hsSource{CircuitDescriptor}en. +++generateNamedComps :: CircuitDescriptor -> [NamedComp]+generateNamedComps g = generateSuperNames g : (map generateSubNames $ nodes g)+      where generateSuperNames g = ( (nodeId.nodeDesc) g+                                   , ( namePins (sinks.nodeDesc)   nameExI g+                                     , namePins (sources.nodeDesc) nameExO g+                                     )+                                   )+            generateSubNames g   = ( (nodeId.nodeDesc) g+                                   , ( namePins (sinks.nodeDesc)   nameInI g+                                     , namePins (sources.nodeDesc) nameInO g+                                     )+                                   )+++++-- Die beiden Funktionen \hsSource{getNamedInPins} sowie \hsSource{getInPinNames} holen jeweils aus einer Liste von \hsSource{NamedComp} und+-- einer \hsSource{CompID} den passenden Datensatz heraus. Hierbei unterscheiden sie sich lediglich im Rückgabetyp voneinander. So liefert+-- \hsSource{getNamedInPins} die \hsSource{InNames}, also eine Liste benannter Pins, zurück. \hsSource{getInPinNames} liefert nur eine Liste+-- der Namen.+++    -- TODO: is fst the right function to get the in-names ???++getNamedInPins :: [NamedComp] -> CompID -> InNames+getNamedInPins = getPinNames fst++getInPinNames :: [NamedComp] -> CompID -> [String]+getInPinNames cname cid = map snd $ getNamedInPins cname cid++++ +-- Die beiden nächsten Funktionen, \hsSource{getNamedOutPins} sowie \hsSource{getOutPinNames} verhalten sich analog zu den beiden+-- \begriff{InPin} varianten, mit dem Unterschied, dass diese beiden Funktionen sich auf die Ausgabepins beziehen.+++    -- TODO: is snd the right function to get the out-names ???++getNamedOutPins :: [NamedComp] -> CompID -> OutNames+getNamedOutPins = getPinNames snd++getOutPinNames :: [NamedComp] -> CompID -> [String]+getOutPinNames cname cid = map snd $ getNamedOutPins cname cid++++ +-- Mit der Funktion \hsSource{getPinNames} wird die eigentliche Logik beschrieben, die für das herausfiltern der Pin-Namen notwendig ist. Aus+-- der übergebenen Liste der benannten Komponenten werden all die Komponenten heraus gefiltert, die der ebenfalls übergebenen Komponenten ID+-- entsprechen. Im nächsten Schritt (\hsSource{map snd}) wird die Komponenten ID verworfen. Die übergeben Funktion \hsSource{f} definiert nun,+-- ob das Ergebnis eingehende oder ausgehende Pins sind. Der letzte Schritt entfernt überflüssige Listen-Verschachtelungen.+++getPinNames :: (([NamedPin], [NamedPin]) -> [NamedPin]) -> [NamedComp] -> CompID -> [(PinID, String)]+getPinNames f cname cid+    = concat+    $ map f+    $ map snd+    $ filter (\(x, _) -> x == cid)+    $ cname+++++-- Die folgenden fünf Funktionen arbeiten analog zu den vorhergehenden fünf. Sie unterscheiden sich darin, dass sie einen weiteren Parameter+-- erwarten, ein \hsSource{PinID}. Dieser Parameter schränkt die Ergebnismenge auf exakt ein Ergebnis ein, sie liefern also einen benannten+-- Pin.++getNamedInPin :: [NamedComp] -> CompID -> PinID -> NamedPin+getNamedInPin = getPinName getNamedInPins++getNamedOutPin :: [NamedComp] -> CompID -> PinID -> NamedPin+getNamedOutPin = getPinName getNamedOutPins++getInPinName :: [NamedComp] -> CompID -> PinID -> String+getInPinName cname cid pid = snd $ getNamedInPin cname cid pid++getOutPinName :: [NamedComp] -> CompID -> PinID -> String+getOutPinName cname cid pid = snd $ getNamedOutPin cname cid pid++getPinName :: ([NamedComp] -> CompID -> [NamedPin]) -> [NamedComp] -> CompID -> PinID -> NamedPin+getPinName f cname cid pid+    = head+    $ filter (\(x, _) -> x == pid)+    $ f cname cid+++++-- Die letzte Funktion in diesem Modul erzeugt aus einem \hsSource{CircuitDescriptor} und einem Präfix eine Liste benannter Pins. Diese+-- Funktion wird in \hsSource{generateNamedComps} verwendet, um interne und externe Pins mit Namen zu versehen. Je nach übergebenen+-- \hsSource{f} produziert \hsSource{namePins} benannte interne oder benannte externe Pinlisten.++namePins :: (CircuitDescriptor -> Pins) -> String -> CircuitDescriptor -> [NamedPin]+namePins f pre g+    = map (\x -> (x, pre ++ (show x))) $ f g+
+ src/System/ArrowVHDL/Circuit/Sensors.hs view
@@ -0,0 +1,149 @@+-- Das Modul \hsSource{Circuit.Sensors} enthält eine Reihe von Funktionen, die bestimmte Werte aus übergebenen Daten herauslesen. +++module System.ArrowVHDL.Circuit.Sensors+where+ +++-- Es werden lediglich die Standard Definitionen, sowie die Tests benötigt.+++import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Tests+ +++-- \subsection{Schaltungssensoren}+-- Die Funktion \hsSource{allCircuits} holt aus einer Schaltung all die Bausteine heraus, aus denen diese Schaltung aufgebaut ist. Das+-- Ergebnis wird dann als Liste von Bausteinen zurückgegeben. +++allCircuits :: CircuitDescriptor -> [CircuitDescriptor]+allCircuits sg +    = if (length next_sg == 0) then sg : []+                               else sg : (concat $ map allCircuits next_sg)+    where next_sg = nodes sg+          cid     = nodeId.nodeDesc $ sg +++++-- Mithilfe der Funktion \hsSource{maxCompID} lässt sich die maximale Komponentennummer einer Schaltung anzeigen.+++maxCompID :: CircuitDescriptor -> CompID+maxCompID sg = (nodeId.nodeDesc $ sg) `max` (foldl max 0 $ map maxCompID (nodes sg))+++++-- Mit der Funktion \hsSource{getComp} lässt sich ein definierter Baustein aus einer Schaltung auslesen. Identifiziert wird der auszulesende+-- Bausteine über seine Komponentennummer. \hsSource{getComp} ist hier die Funktion mit Fehlerbehandlung, die Logik selber steckt in+-- \hsSource{getComp'}.+++getComp :: CircuitDescriptor -> CompID -> CircuitDescriptor+getComp g cid = if length output == 1 +                then head output+                else error "getComp: there is no such circuit"+    where output = getComp' g cid++getComp' :: CircuitDescriptor -> CompID -> [CircuitDescriptor]+getComp' g cid +    | (nodeId.nodeDesc $ g) == cid +    = [g]+    | otherwise       +    = concat $ map (flip getComp' cid) (nodes g)+++++-- Um den übergeordneten Schaltkreis eines Bausteins zu erhalten, kann man sich der Funktion \hsSource{superNode} bedienen. Diese Funktion+-- erwartet eine Schaltung sowie eine Komponentennummer. Im Falle das es eine SuperNode \footnote{also eine Schaltung, die mindestens aus der+-- Komponente mit der übergebenen Nummer besteht} gibt, wird diese Zurückgeliefert. Andernfalls wird eine Fehlermeldung ausgegeben.+++superNode :: CircuitDescriptor -> CompID -> CircuitDescriptor+superNode g cid +    = if length output == 1+        then head output+        else error "superNode: there is no such supernode"+    where output = superNode' g cid++superNode' :: CircuitDescriptor -> CompID -> [CircuitDescriptor]+superNode' g cid +    | g `isSuperNodeOf` cid+    = [g]+    | otherwise+    = concat $ map (flip superNode' cid) $ nodes g+++++-- Als atomar werden Schaltungen bezeichnet, die selbst aus keinen weiteren Schaltungen aufgebaut sind. Diese Schaltungen können auch+-- \begriff{Bausteine} genannt werden. Die Funktion \hsSource{nextAtomic} ermöglicht es, aus einer gegebenen Schaltung und einer Kante die+-- nächste Komponente zu ermitteln, die atomar ist. Außerdem wird auch noch der Pin mit angegeben, über welchen diese Komponente angeschlossen+-- ist.+++nextAtomic :: CircuitDescriptor -> Edge -> (CompID, PinID)+nextAtomic g e+    | isToOuter e && (nodeId.nodeDesc $ super) == mainID+    = (mainID, snkPin e)+     +    | isToOuter e+    = nextAtomic g $ head $ filter (\x -> sourceInfo x == (Just $ nodeId.nodeDesc $ super, snkPin e)) $ edges supersuper++    | not.isAtomic $ sub +    = nextAtomic g $ head $ filter (\x -> (isFromOuter x) && (snkPin e == srcPin x)) $ edges sub++    | isAtomic sub+    = (snkComp e, snkPin e)+    where mainID     = nodeId.nodeDesc $ g+          sub        = getComp   g (snkComp e)+          super      = superNode g (srcComp e)+          supersuper = superNode g (nodeId.nodeDesc $ super)++++-- \subsection{Kantensesoren}+-- +-- Mit der Funktion \hsSource{fromCompEdges} können alle Kanten ausgelesen werden, die von einer bestimmten Komponente her kommen. +++fromCompEdges :: CircuitDescriptor -> CompID -> [Edge]+fromCompEdges g cid+    = filter (\x -> (not.isFromOuter $ x) +                 && (cid == (srcComp x) ) ) $ edges $ superNode g cid+++++-- Hilfreich ist auch die Funktion \hsSource{allEdges}, die wie der Name schon vermuten lässt, alle Kanten die innerhalb einer Schaltung+-- verbaut werden, sammelt und als Ergebnisliste zurückgibt. +++allEdges :: CircuitDescriptor -> [Edge]+allEdges g = edges g ++ (concat $ map allEdges (nodes g))+++++-- \begriff{snk} und \begriff{src} sind Kurzschreibweisen für \begriff{Sink} und \begriff{Source}. Mit den Funktionen \hsSource{snkPin} und+-- \hsSource{srcPin} lassen sich aus einer Kante entweder der Quell- oder der Zielpin auslesen. \hsSource{snkComp} und \hsSource{srcComp} sind+-- dann für die Quell- sowie für die Zielkomponente verantwortlich.+++snkPin :: Edge -> PinID+snkPin (MkEdge (_, _) (_, pid)) = pid++srcPin :: Edge -> PinID+srcPin (MkEdge (_, pid) (_, _)) = pid++snkComp :: Edge -> CompID+snkComp (MkEdge (_, _) (Just cid, _)) = cid++srcComp :: Edge -> CompID+srcComp (MkEdge (Just cid, _) (_, _)) = cid+
+ src/System/ArrowVHDL/Circuit/Show.hs view
@@ -0,0 +1,41 @@+-- Dieses Modul stellt die Schnittstelle für die Show-Funktionalität dar. Wird \hsSource{Circuit.Show} in einem anderen Modul eingebunden, so+-- können \hsSource{CircuitDescriptor}en mittels \hsSource{show} angezeigt werden. ++module System.ArrowVHDL.Circuit.Show+where++-- %% TODO? Btw, for what ever reason, one can't just reload, because this leads to a +-- %% missing object-file error. Exit the ghci and restart it, will do the job.++import System.ArrowVHDL.Circuit.Descriptor+-- import System.ArrowVHDL.Circuit.Show.Simple+-- import System.ArrowVHDL.Circuit.Show.VHDL+import System.ArrowVHDL.Circuit.Show.DOT+import qualified System.ArrowVHDL.Circuit.Show.Simple as Simple+import qualified System.ArrowVHDL.Circuit.Show.DOT as DOT+import qualified System.ArrowVHDL.Circuit.Show.VHDL as VHDL++-- An externen Modulen wird hier lediglich die Kerndefinition \hsSource{Circuit.Descriptor} verwendet. Darüber hinaus werden die jeweiligen+-- Anzeigemodule eingebunden. Folgende Formate können als Ausgabeformat gewählt werden:+-- \begin{itemize}+--   \item Mit \begriff{Simple} ist ein Ausgabeformat gemeint, welches sehr kurz und prägnant alle verfügbaren Informationen anzeigt. Dieses+--     Format eignet sich besonders gut, um damit debug-Informationen auszugeben. +--   \item Die \begriff{DOT}-Sprache ist eine Beschreibungssprache, die verwendet wird, um Graphen abzubilden. Es gibt eine ganze Reihe von+--     Werkzeugen \footnote{Für Linux sei hier \begriff{graphviz} genannt}, die dann aus einer \texttt{.dot}-Datei eine Grafik erzeugen können,+--     die den Graphen abbildet.+--   \item Auch das erzeugen von \begriff{VHDL} ist eine Ausgabeform, die über Haskells \hsSource{Show}-Methoden abgebildet wird. +-- \end{itemize}+-- +-- %% To draw a StructGraph it is necessary to make StructGraph an instance of Show and +-- %% therefore the Edge datatypes also needs to be an instance of Show. +-- +-- Um Haskells \hsSource{Show}-Klasse verwenden zu können, muss der Typ \hsSource{CircuitDescriptor} Mitglied der Klasse \hsSource{Show} sein.+-- Da die eigentliche Definition der \hsSource{Show}-Methode in einem Untermodul stattfindet, ist die Instanzdefinition einfach. Es wird+-- lediglich der \hsSource{show}-Methode eine der vorhandenen Methoden zugeordnet. +-- ++instance Show (Edge) where+    show = showEdge++instance Show (CircuitDescriptor) where+    show = showCircuit
+ src/System/ArrowVHDL/Circuit/Show/DOT.hs view
@@ -0,0 +1,113 @@+module System.ArrowVHDL.Circuit.Show.DOT+( showCircuit+, showEdge+)+where++import Data.Maybe ( isJust )+import Data.List ( nub+                 , (\\)+                 )++import Prelude hiding ( break ) ++import System.ArrowVHDL.Circuit.Descriptor++import System.ArrowVHDL.Circuit.PinTransit+import System.ArrowVHDL.Circuit.EdgeTransit++import System.ArrowVHDL.Circuit.Show.Tools+++-- This function produces the edge-description as it is required by the +-- dot language... something like this:+--     nodeId3:op0 -nodeId6:ip0++showEdge :: Edge -> String+showEdge (MkEdge (Nothing, pid) (Just snk_cid, snk_pid))+    =  "xSTART" ++ ':':"op" ++ show pid+    ++ " -> "+    ++ "nodeId" ++ show snk_cid ++ ':': "ip" ++ show snk_pid+showEdge (MkEdge (Just src_cid, src_pid) (Nothing, pid)) +    =  "nodeId" ++ show src_cid ++ ':': "op" ++ show src_pid+    ++ " -> "+    ++ "xEND" ++ ':':"ip" ++ show pid+showEdge e+    =  "nodeId" ++ show src_cid ++ ':': "op" ++ show src_pid+    ++ " -> "+    ++ "nodeId" ++ show snk_cid ++ ':': "ip" ++ show snk_pid+    where (Just src_cid, src_pid) = sourceInfo e+          (Just snk_cid, snk_pid) = sinkInfo e +++showCircuit :: CircuitDescriptor -> String+showCircuit g +     = concat $ map break+     [ ""+     , "digraph G {"+     , dot_config+     , dot_outer_nodes g+     , dot_components  g+     , dot_connections g +     , "}"+     ]+     where namedEdges = generateNamedEdges g+           namedComps = generateNamedComps g++dot_config :: String+dot_config+     = concat $ map break+     [ ""+     , "graph ["+     , "    rankdir = \"LR\""+     , "]"+     ] ++dot_outer_nodes :: CircuitDescriptor -> String+dot_outer_nodes g+     = concat $ map break+     [ ""+     , "xSTART ["+     , "    " ++ dot_outer_label "op" (sinks.nodeDesc $ g)+     , "    " ++ "shape = \"record\""+     , "]"+     , ""+     , "xEND ["+     , "    " ++ dot_outer_label "ip" (sources.nodeDesc $ g)+     , "    " ++ "shape = \"record\""+     , "]"+     ]++dot_components :: CircuitDescriptor -> String+dot_components  g+     = concat $ nub $ map f (nodes g)+     where f g' = concat $ map break+                [ ""+                , "nodeId" ++ show (nodeId.nodeDesc $ g') ++ " ["+                , "    " ++ dot_label (sinks.nodeDesc $ g') (map (\x -> if x == '>' then '-' else x) $ label.nodeDesc $ g') (nodeId.nodeDesc $ g') (sources.nodeDesc $ g')+                , "    " ++ "shape = \"record\""+                , "]"+                ] ++dot_outer_label :: String -> Pins -> String+dot_outer_label s ps+     =  "label = \" {{ | " +     ++ (concat $ map (f s) ps)+     ++ "}}\""+     where f :: String -> Int -> String+           f s x = "<" ++ s ++ show x ++ "> (" ++ show x ++ ") | "++dot_label :: Pins -> String -> CompID -> Pins -> String+dot_label ips nme cid ops+     =  "label = \" {{ | " +     ++ (concat $ map (f "ip") ips)+     ++ "} | { Name: " ++ nme ++ " | (" ++ show cid ++ ")} | { | "+     ++ (concat $ map (f "op") ops)+     ++ "}}\""+     where f :: String -> Int -> String+           f s x = "<" ++ s ++ show x ++ "> (" ++ show x ++ ") | "+++dot_connections :: CircuitDescriptor -> String+dot_connections g +     = concat $ map (\x -> showEdge x ++ "\n") (edges g)
+ src/System/ArrowVHDL/Circuit/Show/Simple.hs view
@@ -0,0 +1,36 @@+module System.ArrowVHDL.Circuit.Show.Simple+( showCircuit+, showEdge+)+where++import System.ArrowVHDL.Circuit.Descriptor++showCircuit :: CircuitDescriptor -> String+showCircuit g =  showCircuit' g+              ++ "\n" ++ "Area: " ++ (show $ space g)+              ++ "\n" ++ "Time: " ++ (show $ cycles g)++showCircuit' :: CircuitDescriptor -> String+showCircuit' g =  "\n"+            ++ (show.nodeId.nodeDesc) g+            ++ "(" ++ (show.label.nodeDesc) g ++ "): "+            ++ (prtInOuts.sinks.nodeDesc) g ++ "] "+            ++ (showEdges.edges) g+            ++ " [" ++ (prtInOuts.sources.nodeDesc) g+            ++ (showNode.nodes) g+         where showNode [] = ""+               showNode n  = concat $ map showCircuit' n+               prtInOuts [] = "_"+               prtInOuts x  = foldl1 (\x y -> x ++ ',':y) $ map show x+++showEdge :: Edge -> String+showEdge ed = (prtConnection.sourceInfo) ed ++ "->" ++ (prtConnection.sinkInfo) ed+      where prtConnection (Just cid, pid) = show (cid, pid)+            prtConnection (Nothing,  pid) = "(_," ++ show pid ++ ")"+++showEdges :: [Edge] -> String+showEdges = concat . (map showEdge)+
+ src/System/ArrowVHDL/Circuit/Show/Tools.hs view
@@ -0,0 +1,9 @@+module System.ArrowVHDL.Circuit.Show.Tools+where+++-- break is a function, that appends a newline character to the +-- end of a string. ++break :: String -> String+break = flip (++) "\n"
+ src/System/ArrowVHDL/Circuit/Show/VHDL.hs view
@@ -0,0 +1,249 @@+module System.ArrowVHDL.Circuit.Show.VHDL+( showCircuit+, showEdge+)+where++import Data.Maybe ( isJust )+import Data.List ( nub+                 , (\\)+                 )++import Prelude hiding ( break ) ++import System.ArrowVHDL.Circuit.Descriptor++import System.ArrowVHDL.Circuit.PinTransit+import System.ArrowVHDL.Circuit.EdgeTransit+import System.ArrowVHDL.Circuit.Tests++import System.ArrowVHDL.Circuit.Show.Tools+++-- The showEdge function is only needed for the Show class. +-- While VHDL-Code is generated, of this function is made no use ... ++showEdge :: Edge -> String+showEdge ed = (prtConnection.sourceInfo) ed ++ "->" ++ (prtConnection.sinkInfo) ed+      where prtConnection (Just cid, pid) = show (cid, pid)+            prtConnection (Nothing,  pid) = "(_," ++ show pid ++ ")"+++-- In a VHDL-Sorce file, there are two main sections, that we need to specify +-- in order to get working VHDL-Source.+-- +-- The function that starts the show-process is the toVHDL-function. Here we +-- define the basic structure of a VHDL-SourceCode with an header, the +-- entity-definition as well as the component-definition. +-- TODO: Add the signal-definition and the port-map-definitions++showCircuit :: CircuitDescriptor -> String+showCircuit g +     = concat $ map break+     [ ""+     , vhdl_header+     , vhdl_entity       g namedComps+     , vhdl_architecture g +     , vhdl_components   g namedComps+     , vhdl_signals      g namedEdges+     , vhdl_portmaps     g namedComps namedEdges+     ]+     where namedEdges = generateNamedEdges g+           namedComps = generateNamedComps g++nameEdges :: String -> CircuitDescriptor -> [([Anchor], String)]+nameEdges pre g +    = map (\(i, e) -> (sourceInfo e : sinkInfo e : [], pre ++ show i)) $ zip [0..] relevantEdges+    where relevantEdges = filter (\(MkEdge (ci,_) (co,_)) -> isJust ci && isJust co) $ edges g ++nameGraphPins :: CircuitDescriptor -> [(CompID, ([(PinID, String)], [(PinID, String)]))]+nameGraphPins g = nameSuperPins g : (map nameSubPins $ nodes g)++nameSuperPins :: CircuitDescriptor -> (CompID, ([(PinID, String)], [(PinID, String)]))+nameSuperPins g = (nodeId.nodeDesc $ g, (namedSinks, namedSources))+    where namedSinks   = namePins' (sinks.nodeDesc)   nameExI g +          namedSources = namePins' (sources.nodeDesc) nameExO g++nameSubPins :: CircuitDescriptor -> (CompID, ([(PinID, String)], [(PinID, String)]))+nameSubPins g = (nodeId.nodeDesc $ g, (namedSinks, namedSources))+    where namedSinks   = namePins' (sinks.nodeDesc)   nameInI g +          namedSources = namePins' (sources.nodeDesc) nameInO g++namePins' :: (CircuitDescriptor -> Pins) -> String -> CircuitDescriptor -> [(PinID, String)]+namePins' f pre g = map (\x -> (x, pre ++ show x)) $ f g ++-- The VHDL-Header is just some boilerplate-code where library's are imported++vhdl_header :: String+vhdl_header +     = concat $ map break+     [ "LIBRARY ieee;"+     , "USE ieee.std_logic_1164.all;"+     ]++-- A VHDL-Entity defines an "interface" to a hardware component. It consists of+-- a name and of some port-definitions (like what wires go inside and come back out)++vhdl_entity :: CircuitDescriptor -> [NamedComp] -> String+vhdl_entity g namedComps+     = concat $ map break+     [ "ENTITY " ++ (label.nodeDesc) g ++ " IS"+     , "PORT (" +     , (sepBy "\n" $ map (\x -> x ++ " : IN  std_logic;") $ snks)+     , (sepBy "\n" $ map (\x -> x ++ " : OUT std_logic ") $ srcs)+     , ");"+     , "END " ++ (label.nodeDesc) g ++ ";"+     ]+     where snks = getInPinNames  namedComps (nodeId.nodeDesc $ g)+           srcs = getOutPinNames namedComps (nodeId.nodeDesc $ g)++vhdl_architecture :: CircuitDescriptor -> String+vhdl_architecture g +    = "ARCHITECTURE " ++ (label.nodeDesc $ g) ++ "Struct OF " ++ (label.nodeDesc $ g) ++ " IS"+++-- The VHDL-Component definitions describe the basic interface to the components+-- that are used inside this new definition. We therefore pick the components +-- of which these new component consists. We call this components the level 1 +-- components, because we descent only one step down in the graph. ++vhdl_components :: CircuitDescriptor -> [NamedComp] -> String+vhdl_components g namedComps+     = concat $ nub $ map f (nodes g)+    where f g' = concat $ map break+               [ ""+               , "COMPONENT " ++ (label.nodeDesc $ g') ++ "Comp"+               , "PORT ("+               , (sepBy "\n" $ map (\x -> x ++ " : IN  std_logic;") $ snks)+               , (sepBy "\n" $ map (\x -> x ++ " : OUT std_logic ") $ srcs)+               , ");"+               , "END COMPONENT " ++ (label.nodeDesc $ g') ++ "Comp;"+               ] +               where snks = getInPinNames  namedComps (nodeId.nodeDesc $ g')+                     srcs = getOutPinNames namedComps (nodeId.nodeDesc $ g')+++-- The VHDL-Signals is the list of inner wires, that are used inside the new component.++vhdl_signals :: CircuitDescriptor -> [([Anchor], String)] -> String+vhdl_signals _ [] = ""+vhdl_signals g namedEdges+     = "SIGNAL " ++ sepBy ", " signals ++ ": std_logic;" +     where signals = map snd namedEdges+++vhdl_portmaps :: CircuitDescriptor -> [NamedComp] -> [([Anchor], String)] -> String+vhdl_portmaps g namedComps namedEdges+     = concat $ map break+     [ "BEGIN"+     , concat $ map (vhdl_portmap g namedComps namedEdges) $ nodes g+     , "END;"+     ]++vhdl_portmap :: CircuitDescriptor -> [NamedComp] -> [([Anchor], String)] -> CircuitDescriptor -> String+vhdl_portmap superG namedComps namedEdges' g+     = concat $ map break+     [ (label.nodeDesc $ g) ++ "Inst" ++ (show.nodeId.nodeDesc $ g) ++ ": " ++ (label.nodeDesc $ g) ++ "Comp"+     , "PORT MAP ("+     ++ (sepBy ", " $ filter ((>0).length) [incoming, signaling, outgoing])+     ++ ");"+     ]+     where relevantEdges = filter (isFromOrToComp $ nodeId.nodeDesc $ g) $ edges superG+           edge2inside   = filter (isFromOuter)   $ relevantEdges+           edge2outside  = filter (isToOuter)     $ relevantEdges+           pin2signal    = relevantEdges \\ (edge2outside ++ edge2inside)+           incoming      = sepBy ", " $ map (genPortMap namedComps namedEdges' (nodeId.nodeDesc $ g)) $ edge2inside+           outgoing      = sepBy ", " $ map (genPortMap namedComps namedEdges' (nodeId.nodeDesc $ g)) $ edge2outside+           signaling     = sepBy ", " $ map (genPortMap namedComps namedEdges' (nodeId.nodeDesc $ g)) $ pin2signal+++genPortMap :: [NamedComp] -> [NamedEdge] -> CompID -> Edge -> String++-- From the inner component to the outside+--  : PORT MAP (a0 =out0, a1 => out1);+--               +--------++--               |  pi = [0] -+--               |ci = 0  | +--               |  pi = [1] -+--               +--------+++genPortMap namedComps _ _ (MkEdge (Just ci, pi) (Nothing, po))+    = pinName ++ " => " ++ outName+    where pinName  = getOutPinName namedComps ci       pi+          outName  = getOutPinName namedComps superCid po+          superCid = fst . head $ namedComps+++-- From the outside to the inner component+--  : PORT MAP (e0 =in0, e1 => in1);+--                 +--------++--             -[0] = po  |+--                 |co = 0  |+--             -[1] = po  |+--                 +--------+++genPortMap namedComps _ _ (MkEdge (Nothing, pi) (Just co, po))+    = pinName ++ " => " ++ incName+    where pinName  = getInPinName namedComps co       po+          incName  = getInPinName namedComps superCid pi+          superCid = fst . head $ namedComps+++-- From the inner component to an inner signal +--  : PORT MAP (a0 =i0, a0 => i1);+--   +--------+                        +--------++--   |  pi = [0] - -----i0------ -> [0] = po  |+--   |ci = 0  |                        |co = 1  |  +--   |  pi = [1] - ------i1----- -> [1] = po  |+--   +--------+                        +--------+++genPortMap namedComps namedEdges ownID (MkEdge ie@(Just ci, pi) oe@(Just co, po))+ | ownID == ci = iPinName ++ " => " ++ iSigName+ | ownID == co = oPinName ++ " => " ++ oSigName+     where iPinName = getOutPinName  namedComps ci pi+           oPinName = getInPinName namedComps co po+           iSigName = getEdgeName namedEdges ie +           oSigName = getEdgeName namedEdges oe+++++-- In the last genPortMap function there are some irregularities+-- +-- TODO TODO TODO / why is it called iPin when the out-pin is gathered with the (map snd) bevore the concat???      +--       where iPinNames = concat $ map snd $ map snd $ filter (\(cid, _) -cid == ci) $ namedGraphPins+-- +-- TODO TODO TODO / why is it called oPin when the in-pin is gathered with the (map fst) bevore the concat???      +--             oPinNames = concat $ map fst $ map snd $ filter (\(cid, _) -cid == co) $ namedGraphPins+-- +--             iPinName  = head $ map snd $ filter (\(pid, _) -pid == pi) $ iPinNames+--             oPinName  = head $ map snd $ filter (\(pid, _) -pid == po) $ oPinNames+++-- The namePins function takes a function that extracts a list of PinIDs out of an StructGraph.+-- (This could be the sinks or the sources functions) +-- It also takes a StructGraph (suprise :)) and a String, that is prepended to the actual PinName.+-- This functions returns a list, where every element is a tuple of the actual named pin (a string)+-- and a part, that identifies the name.++namePins :: (CircuitDescriptor -> Pins) -> String -> CircuitDescriptor -> [(String, Anchor)]+namePins f pre g+    = map (\x -> (pre ++ (show x), (Nothing, x))) $ f g+--  = map (\x -> (pre ++ (show x), (nodeId g, x))) $ f g+++-- The nameEdges function is pretty similar to the namePins function with some minor differences. +-- First of all, you don't need a function that extracts the edges of a StructGraph. There is +-- only one field in the StructGraph that holds the edges. +-- And also the return-type is a bit simpler, becaus an edge identifies itself, so there is no need+-- to do this once more.++-- nameEdges :: String -> CircuitDescriptor -> [(String, Edge)]+-- nameEdges pre g+--     = map (\(num, edge) -> (pre ++ (show num), edge)) $ zip [0..] (edges g)+++sepBy :: String -> [String] -> String+sepBy sep []     = ""+sepBy sep (x:[]) = x+sepBy sep xs     = foldl1 (\x y -> x ++ sep ++ y) xs
+ src/System/ArrowVHDL/Circuit/ShowType.hs view
@@ -0,0 +1,10 @@+-- Das Modul \hsSource{Circuit.ShowType} ist ein strukturelles Modul nach dem Fassaden-Entwurfsmuster. ++module System.ArrowVHDL.Circuit.ShowType (ShowType(..))+where+++-- Folgenden Module werden benötigt, um die Instanzen definieren zu können:++import System.ArrowVHDL.Circuit.ShowType.Class (ShowType(..))+import System.ArrowVHDL.Circuit.ShowType.Instance
+ src/System/ArrowVHDL/Circuit/ShowType/Class.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE Arrows,+             OverlappingInstances, +             UndecidableInstances,+             IncoherentInstances,+             NoMonomorphismRestriction,+             MultiParamTypeClasses,+             FlexibleInstances,+             RebindableSyntax #-}++-- Das Modul \hsSource{Circuit.ShowType.Class} beschreibt, wie die Arrow-Klasse zu implementieren sind um damit später Schaltkreise+-- beschreiben, bearbeiten oder benutzen zu können.++module System.ArrowVHDL.Circuit.ShowType.Class+where+++-- Folgenden Module werden benötigt, um die Arrows definieren zu können:++import Prelude hiding (id, (.))+import qualified Prelude as Pr++import Control.Category ++import System.ArrowVHDL.Circuit.Descriptor+++-- Zunächst einmal müssen die Klassen definiert werden. Diese Vorgaben müssen von allen Instanzdefinitionen befolgt werden.++-- Die \hsSource{ShowType}-Klasse wird benötigt, um zur Laufzeit Typinformationen in den \hsSource{Arrow} zu bekommen. Dies wird immer dann+-- ausgenutzt, wenn mittels \hsSource{arr} eine Funktion in einen Arrow geliftet wird. Wie man später in der \hsSource{Arrow}-Klassen+-- Definition erkennen kann, ist \hsSource{arr} nur für Funktionen definiert, die auch in \hsSource{ShowType} sind.++class ShowType b c where+    showType :: (b -> c) -> CircuitDescriptor
+ src/System/ArrowVHDL/Circuit/ShowType/Instance.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE Arrows,+             OverlappingInstances, +             UndecidableInstances,+             IncoherentInstances,+             NoMonomorphismRestriction,+             MultiParamTypeClasses,+             FlexibleInstances,+             RebindableSyntax #-}+++-- Das Modul \hsSource{Circuit.ShowType.Instance} beschreibt, wie die Arrow-Klasse zu implementieren sind um damit später Schaltkreise+-- beschreiben, bearbeiten oder benutzen zu können.++module System.ArrowVHDL.Circuit.ShowType.Instance+where+++-- Folgenden Module werden benötigt, um die Instanzen definieren zu können:++import System.ArrowVHDL.Circuit.ShowType.Class++import Prelude hiding (id, (.))+import qualified Prelude as Pr++import Control.Category ++import System.ArrowVHDL.Circuit.Graphs+import System.ArrowVHDL.Circuit.Descriptor++-- Showtype wird hier für bestimmte Tupel-Typen beschrieben. Einzig die Tupel-Information ist das, was mittels Showtype in Pin-Informationen+-- übersetzt wird. +++-- Die \hsSource{ShowType}-Instanz definiert die verschiedenen Typenvarianten, welche abbildbar sind.++-- Mit dem Typ \hsSource{(b, c) -> (c, b)} stellt die folgende Variante eine dar, in der die Ein- und Ausgänge miteinander vertauscht werden.++instance ShowType (b, c) (c, b) where+    showType _ +        = emptyCircuit { nodeDesc = MkNode+                           { label   = "|b,c>c,b|" +                           , nodeId  = 0+                           , sinks   = mkPins 2+                           , sources = mkPins 2+                           }+                     }+        where nd = nodeDesc emptyCircuit+++-- Diese Variante mit dem Typ \hsSource{b -> (b, b)} beschreibt den Fall, in dem ein Eingang verdoppelt wird.+  +instance ShowType b (b, b) where+    showType _ +        = emptyCircuit { nodeDesc = MkNode+                           { label   = "|b>b,b|" +                           , nodeId  = 0+                           , sinks   = mkPins 1+                           , sources = mkPins 2+                           }+                     }+        where nd = nodeDesc emptyCircuit+  ++-- Mit dem Typ \hsSource{(b, b) -> b} wir dann der Fall abgebildet, der zwei Eingänge auf einen zusammenfasst. ++instance ShowType (b, b) b where+    showType _ +        = emptyCircuit { nodeDesc = MkNode+                           { label   = "|b,b>b|"+                           , nodeId  = 0+                           , sinks   = mkPins 2+                           , sources = mkPins 1+                           }+                     }+        where nd = nodeDesc emptyCircuit+  +-- instance ShowType (b, c) (b', c') where+--   showType _ = emptyCircuit { label = "b,c>b',c'"+--                           , sinks = mkPins 1+--                           , sources = mkPins 1+--                           }+--   +-- instance ShowType b b where+--  showType _ = emptyCircuit { label = "|b>b|"+--                          , sinks = mkPins 1+--                          , sources = mkPins 1+--                          }+--   +-- instance ShowType (b -> (c, d)) where+--   showType _ = emptyCircuit { label = "b>c,d"+--                           , sinks = mkPins 1+--                           , sources = mkPins 1+--                           }+-- +-- instance ShowType ((b, c) -> d) where+--   showType _ = emptyCircuit { label = "b,c>d"+--                           , sinks = mkPins 1+--                           , sources = mkPins 1+--                           }+  +-- Letztlich bleibt noch der allgemeinste Fall der Möglich ist. Diese Varianten ist somit auch eine \begriff{CatchAll} Variante.++instance ShowType b c where+    showType _ +        = emptyCircuit { nodeDesc = MkNode+                           { label   = "|b>c|"+                           , nodeId  = 0+                           , sinks   = mkPins 1+                           , sources = mkPins 1+                           }+                     }+        where nd = nodeDesc emptyCircuit
+ src/System/ArrowVHDL/Circuit/Splice.hs view
@@ -0,0 +1,226 @@+-- Das Module \hsSource{Circuit.Splice} bietet nach außen hin nur eine+-- Funktion an, nämlich \hsSource{splice}. Diese Funktion führt zwei+-- Schaltungen zu einer neuen zusammen. Dabei ist noch nicht+-- festgelegt, wie dieses Zusammenführen tatsächlich aussieht.++module System.ArrowVHDL.Circuit.Splice+where++-- Verwendet werden die Standard-Definitionen, sowie eine Sensor und+-- einer Worker Funktion.+++import Data.List (nub)++import System.ArrowVHDL.Circuit.Graphs++import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Workers (alterCompIDs)+import System.ArrowVHDL.Circuit.Sensors (maxCompID)+++-- Auch wenn hier tatsächlich zwei Funktionen stehen wird+-- \hsSource{splice} doch als eine Einheit+-- angesehen. \hsSource{splice'} enthält die Funktionalität,+-- \hsSource{splice} ist der öffentliche Bezeichner, der obendrein+-- noch eine grundlegende Fehlerprüfung macht.++-- \hsSource{splice} wird eine \hsSource{rewire} Funktion+-- übergeben. Diese Funktion enthält die Logik, nach der die+-- ``Verdrahtung'' der beiden Schaltkreise erfolgen wird. Hier ist es+-- dann möglich beispielsweise sequentiell oder parallel zu+-- verdrahten. Außerdem erwartet \hsSource{splice} noch zwei+-- Schaltungen, die zusammengeführt werden sollen. Diese beiden werden+-- dann auf die gewählte Art miteinander verbunden. Die übrigen+-- ``Drähte'' werden nach außen geführt, ein neuer Name wird erzeugt+-- und dieser neue Schaltkreis wird dann zurückgegeben.++splice :: ((CircuitDescriptor -> CircuitDescriptor -> ([Edge], (Pins, Pins))), String) +       -> CircuitDescriptor -> CircuitDescriptor -> CircuitDescriptor+splice _           sg NoDescriptor = sg+splice _           NoDescriptor sg = sg+splice (rewire, s) cd_f cd_g       = splice' (rewire, s) cd_f cd_g+++splice' :: ((CircuitDescriptor -> CircuitDescriptor -> ([Edge], (Pins, Pins))), String) +        -> CircuitDescriptor -> CircuitDescriptor -> CircuitDescriptor+splice' (rewire, s) cd_f cd_g +    = MkCombinatorial+        { nodeDesc = MkNode +            { label   = (label.nodeDesc $ cd_f') ++ s ++ (label.nodeDesc $ cd_g')+            , nodeId  = 0+            , sinks   = srcs +            , sources = snks+            }+        , nodes   = cd_f': cd_g' : []+        , edges   = es+        , cycles  = (cycles cd_f) + (cycles cd_g)+        , space   = (space  cd_f) + (space  cd_g)+        }+    where cd_f'              = alterCompIDs 1                    cd_f+          cd_g'              = alterCompIDs (maxCompID cd_f' +1) cd_g+          (es, (srcs, snks)) = rewire cd_f' cd_g'++++-- \subsection{Verdrahtungsvarianten} Die Funktion \hsSource{splice}+-- aus dem Modul \ref{mod:Circuit.Splice} verwendet für das+-- ``verdrahten'' eine der folgenden+-- \hsSource{rewire}-Funktionen. Daneben wird noch eine Zeichenkette+-- zugeordnet, um später debug-Ausgaben erzeugen zu können.++-- Die \hsSource{connect} Funktion verbindet zwei Schaltkreise zu+-- einem neuen. Hierbei wird sequentiell verbunden, als Zeichenkette+-- wird der selbe Operator angegeben, wie er auch aus der+-- \hsSource{Arrow}-Schreibweise schon bekannt ist.++connect :: CircuitDescriptor -> CircuitDescriptor -> CircuitDescriptor+connect = splice (seqRewire, ">>>")+++-- Neben dem sequentiellen verbinden lassen sich Schaltkreise auch+-- parallel verbinden. Dies ist mit der Funktion \hsSource{combine}+-- möglich.  Als Zeichenkette wird auch hier das aus der+-- \hsSource{Arrow}-Schreibweise bekannte Operator-Symbol verwendet.+-- %%% TODO : combine = frame???++combine :: CircuitDescriptor -> CircuitDescriptor -> CircuitDescriptor+combine = splice (parRewire, "&&&")+++-- Eine Variante der \hsSource{combine} Funktion ist die Funktion+-- \hsSource{dupCombine}. Hier werden die Eingänge zunächst dupliziert+-- und dann parallel weiter verbunden.++dupCombine :: CircuitDescriptor -> CircuitDescriptor -> CircuitDescriptor+dupCombine = splice (dupParRewire, ">2>")+++-- Um eine Verzögerung in Hardware zu realisieren ist es notwendig die+-- Daten zu speichern. Dies wird über ein Register erreicht. Nach der+-- gewünschten Anzahl von Zyklen, kann dann das Datum aus dem Register+-- wieder ausgelesen werden, und in der Schaltung weiter verwendet+-- werden.  Die Funktion %%%%%%%%%%%%%%%%%%% %%% TODO : Schaltwerke++delayByRegister :: CircuitDescriptor -> CircuitDescriptor+delayByRegister cd@(MkCombinatorial nd _ _ _ _)+    = MkComposite (cd : reg : [])+    where reg = mkRegister nd++++-- Möchte man einen \begriff{Loop} erstellen, so wird dieser durch ein+-- Register geführt, dass eine Verzögerung um einen Takt+-- ermöglicht. Die Funktion, die ein Bauteil um eine Schleife mit+-- Register erweitert, nennt sich \hsSource{registerloopRewire}. Diese+-- Funktion lässt sich mittels \hsSource{splice} zu der nach Außen+-- verwendeten \hsSource{loopWithRegister} Funktion umbauen.+++loopWithRegister :: CircuitDescriptor -> CircuitDescriptor+loopWithRegister cd +    = MkLoop+        { nodeDesc = MkNode+            { label   = "loop(" ++ (label.nodeDesc $ cd) ++ ")"+            , nodeId  = 0+            , sinks   = srcs+            , sources = snks+            }+        , nodes   = [alterCompIDs 1 cd]+        , edges   = es+        , space   = space cd+        }+    where (es, (srcs, snks)) = registerLoopRewire cd+++-- Unter den \hsSource{rewire}-Funktionen sind Funktionen zu+-- verstehen, die eine Vorstufe für die eigentliche Verbindung (das+-- \begriff{splicen}) darstellen. Zwei Schaltkreise werden jeweils in+-- eine Zwischendarstellung überführt. Die Zwischendarstellung besteht+-- aus einer Liste von neuen Kanten (\hsSource{[Edge]}), zusammen mit+-- den überbleibenden Ein- und Ausgangspins.+-- +-- Alle \hsSource{rewire}-Funktionen nutzen eine Funktion, nämlich+-- \hsSource{wire}. Das verbinden von Drähten mit Komponenten ist,+-- unabhängig davon ob sequentiell oder parallel verbunden werden+-- soll, immer gleich. Eingehende Parameter zu \hsSource{wire} sind+-- die beiden Komponenten Nummern, sowie die Pin-Listen. Auch diese+-- Funktion erzeugt die schon beschriebene Zwischendarstellung.++wire :: Maybe CompID -> Maybe CompID -> Pins -> Pins -> ([Edge], (Pins, Pins))+wire cid_l cid_r pins_l pins_r +    = (edges, (drop cnt pins_l, drop cnt pins_r))+    where points_l = map ((,) (cid_l)) pins_l+          points_r = map ((,) (cid_r)) pins_r+          edges    = map (uncurry MkEdge) $ zip points_l points_r+          cnt      = length edges+  ++-- \hsSource{wire_} ist ein Synonym für \hsSource{fst . wire}.++wire_ :: Maybe CompID -> Maybe CompID -> Pins -> Pins -> [Edge]+wire_ cid_l cid_r pins_l pins_r = fst $ wire cid_l cid_r pins_l pins_r+++-- Bei der Funktion \hsSource{seqRewire} werden die Verbindungen+-- sequentiell erstellt; übrige Ein oder Ausgänge werden zu den gesamt+-- Ein und Ausgängen hinzugefügt.++seqRewire :: CircuitDescriptor -> CircuitDescriptor -> ([Edge], (Pins, Pins))+seqRewire sg_l sg_r+  = ( fromOuterToL ++ fromOuterToR ++ edgs ++ fromRToOuter ++ fromLToOuter+      , (super_srcs, super_snks)+      )+    where (edgs, (srcs_l', snks_r')) =  wire (Just $ nodeId.nodeDesc $ sg_l) (Just $ nodeId.nodeDesc $ sg_r) (sources.nodeDesc $ sg_l) (sinks.nodeDesc $ sg_r)+          super_srcs                 =  [0..(length.sinks.nodeDesc   $ sg_l) + length snks_r' -1]+          super_snks                 =  [0..(length.sources.nodeDesc $ sg_r) + length srcs_l' -1]+          ( fromOuterToL, (super_srcs', _)) =  wire Nothing (Just $ nodeId.nodeDesc $ sg_l) super_srcs  (sinks.nodeDesc $ sg_l)+          ( fromOuterToR, (_          , _)) =  wire Nothing (Just $ nodeId.nodeDesc $ sg_r) super_srcs' (drop (length fromOuterToL) $ sinks.nodeDesc $ sg_r)+          ( fromRToOuter, (_, super_snks')) =  wire (Just $ nodeId.nodeDesc $ sg_r) Nothing (sources.nodeDesc $ sg_r) super_snks+          ( fromLToOuter, (_, _))           =  wire (Just $ nodeId.nodeDesc $ sg_l) Nothing (drop (length fromRToOuter) $ sources.nodeDesc $ sg_l) super_snks'+++-- Bei der \hsSource{parRewire} Funktion werden beide Bausteine+-- ``übereinander'' angeordnet. Die Eingänge beider Komponenten, sowie+-- deren Ausgänge werden parallel geschaltet.++parRewire :: CircuitDescriptor -> CircuitDescriptor -> ([Edge], (Pins, Pins))+parRewire sg_u sg_d+    = ( goingIn_edges ++ goingOut_edges+      , (super_srcs, super_snks)+      )+    where super_srcs = [0..(length $ (sinks.nodeDesc $   sg_u) ++ (sinks.nodeDesc $   sg_d)) -1]+          super_snks = [0..(length $ (sources.nodeDesc $ sg_u) ++ (sources.nodeDesc $ sg_d)) -1]+          goingIn_edges  =  (wire_ Nothing (Just $ nodeId.nodeDesc $ sg_u)                            (super_srcs) (sinks.nodeDesc $ sg_u))+                         ++ (wire_ Nothing (Just $ nodeId.nodeDesc $ sg_d) (drop (length.sinks.nodeDesc $ sg_u) super_srcs) (sinks.nodeDesc $ sg_d))+          goingOut_edges =  (wire_ (Just $ nodeId.nodeDesc $ sg_u) Nothing (sources.nodeDesc $ sg_u)                              (super_snks))+                         ++ (wire_ (Just $ nodeId.nodeDesc $ sg_d) Nothing (sources.nodeDesc $ sg_d) (drop (length.sources.nodeDesc $ sg_u) super_snks))+++-- Die Funktion \hsSource{dupParRewire} funktioniert dabei analog zur+-- Funktion \hsSource{parRewire}. Lediglich die Eingänge werden+-- zunächst dupliziert und dann auf beide Komponenten geschaltet.++dupParRewire :: CircuitDescriptor -> CircuitDescriptor -> ([Edge], (Pins, Pins))+dupParRewire sg_u sg_d+    = ( goingIn_edges ++ goingOut_edges+      , (super_srcs, super_snks)+      )+    where super_srcs = [0..(length.sinks.nodeDesc $ sg_u) -1]+          super_snks = [0..(length $ (sources.nodeDesc $ sg_u) ++ (sources.nodeDesc $ sg_d)) -1]+          goingIn_edges  =  (wire_ Nothing (Just $ nodeId.nodeDesc $ sg_u) super_srcs (sinks.nodeDesc $ sg_u))+                         ++ (wire_ Nothing (Just $ nodeId.nodeDesc $ sg_d) super_srcs (sinks.nodeDesc $ sg_d))+          goingOut_edges =  (wire_ (Just $ nodeId.nodeDesc $ sg_u) Nothing (sources.nodeDesc $ sg_u)                              (super_snks))+                         ++ (wire_ (Just $ nodeId.nodeDesc $ sg_d) Nothing (sources.nodeDesc $ sg_d) (drop (length.sources.nodeDesc $ sg_u) super_snks))++++registerLoopRewire :: CircuitDescriptor -> ([Edge], (Pins, Pins))+registerLoopRewire cd+    = (es, (srcs, snks))+    where reg = mkRegister $ nodeDesc emptyCircuit+          (es1, (srcs1, snks1)) = seqRewire cd reg+          (es2, (srcs2, snks2)) = seqRewire reg cd+          es   = es1 ++ es2+          srcs = nub $ filter (flip elem srcs2) srcs1 ++ filter (flip elem srcs1) srcs2+          snks = nub $ filter (flip elem snks2) snks1 ++ filter (flip elem snks1) snks2
+ src/System/ArrowVHDL/Circuit/Stream.hs view
@@ -0,0 +1,12 @@+-- Das Modul \hsSource{Circuit.Stream} stellt ein Wrapper-Modul nach dem Fassaden Entwurfsmuster dar.++module System.ArrowVHDL.Circuit.Stream+    ( Stream(..)+    )+where+++-- Folgenden Module werden benötigt, um die Arrows definieren zu können:++import System.ArrowVHDL.Circuit.Stream.Datatype+import System.ArrowVHDL.Circuit.Stream.Instance
+ src/System/ArrowVHDL/Circuit/Stream/Datatype.hs view
@@ -0,0 +1,18 @@+-- Das Modul \hsSource{Circuit.Stream.Datatype} beschreibt, was ein Stream-Datentyp ist.++module System.ArrowVHDL.Circuit.Stream.Datatype+where+++-- In Schaltkreisen sind Schleifen nicht über den normalen \hsSource{ArrowLoop} Ansatz realisierbar. Das Problem liegt darin, dass zwischen+-- zwei Berechnungen keine Verzögerung stattfindet. Wollte man das erreichen, so benötigt man mindestens \begriff{Register}, die einen+-- Taktzyklus verzögern. Damit ist dann festgelegt, dass im Grunde Schleifen in Hardware nur dann Sinn ergeben, wenn ein kontinuierlicher+-- Datenstrom verarbeitet werden kann. ++-- Auch für andere Ansätze wird eine \hsSource{Stream}-Arrow notwendig. Dies kann beispielsweise der Fall sein falls Zwischenergebnisse+-- Innerhalb des Schaltkreises ermittelt werden sollen. ++-- Zunächst wird der Datentyp definiert. \hsSource{Stream} hat einen Typkonstruktor \hsSource{SF} und besteht aus einer Funktion, welche aus+-- einer Liste von b's (\hsSource{[b]}) eine Liste von c's \hsSource{[c]}) erzeugt. ++newtype Stream b c = SF { runStream :: ([b] -> [c]) }
+ src/System/ArrowVHDL/Circuit/Stream/Instance.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE Arrows,+             OverlappingInstances, +             UndecidableInstances,+             IncoherentInstances,+             NoMonomorphismRestriction,+             MultiParamTypeClasses,+             FlexibleInstances,+             RebindableSyntax #-}++-- Das Modul \hsSource{Circuit.Stream.Instance} beschreibt, wie die Arrow-Klasse zu implementieren sind um damit später Schaltkreise beschreiben,+-- bearbeiten oder benutzen zu können.++module System.ArrowVHDL.Circuit.Stream.Instance+where+++-- Folgenden Module werden benötigt, um die Arrows definieren zu können:++import Prelude hiding (id, (.))+import qualified Prelude as Pr++import Control.Category ++import System.ArrowVHDL.Circuit.Arrow++import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Graphs+import System.ArrowVHDL.Circuit.Workers (flatten)++import System.ArrowVHDL.Circuit.Stream.Datatype++++-- Im nächsten Schritt wird \hsSource{Stream} dann zu einer Kategorie ernannt, indem die \hsSource{Category}-Typklasse für \hsSource{Stream}+-- implementiert wird. Erst wenn \hsSource{Stream} eine Kategorie ist, lässt sich \hsSource{Stream} in einen Arrow befördern.++instance Category Stream where+    id              +      = SF (id)++    (SF f) . (SF g) +      = SF (f . g) +++-- Nachdem \hsSource{Stream} eine Kategorie ist, kann \hsSource{Stream} als Arrow implementiert werden. Ähnlich wie bei der Implementierung der+-- Arrow Instanz von \hsSource{Grid} ist es auch bei \hsSource{Stream} notwendig, alle Funktionsbeschreibungen anzugeben. Die abgeleiteten+-- Funktionen der minimal Definition, reichen nicht aus. ++instance Arrow Stream where+    arr f             +      = SF $ map f -- ?? (SF . map) f ??++    first  (SF f)     +      = SF $ (uncurry zip) . (\(bs, cs) -> (f bs, cs)) . unzip ++    second (SF g)     +      = SF $ (uncurry zip) . (\(bs, cs) -> (bs,  g cs)) . unzip ++    (SF f) *** (SF g) +      = SF $ (uncurry zip) . (\(bs, cs) -> (f bs, g cs)) . unzip+++-- Da \hsSource{Stream} ein Arrow ist und Kontinuierliche Datenströme für das Looping notwendig sind, kann für \hsSource{Stream} auch die+-- \hsSource{ArrowLoop} Instanz angegeben werden.++instance ArrowLoop Stream where+    loop (SF f) +      = SF $ (\bs -> +               let (cs, ds) = unzip . f $ zip bs (stream ds) +               in  cs+             )+      where stream ~(x:xs) = x:stream xs+++-- Mit der \hsSource{Stream} Instanz von \hsSource{ArrowLoop} ist es nun auch möglich, die \hsSource{ArrowCircuit} Instanz zu implementieren.+-- Diese ist eine direkte Umsetzung des \hsSource{delay}'s auf die Listenfunktionalität. ++instance ArrowCircuit Stream where+    delay x = SF (x:)
+ src/System/ArrowVHDL/Circuit/Tests.hs view
@@ -0,0 +1,95 @@+-- Dieses Modul beschreibt eine Reihe von Funktionen zum prüfen von Eigenschaften. Diese Funktionen haben eine Gemeinsamkeit, nämlich dass sie+-- letztlich immer einen \hsSource{Bool}-Wert erzeugen. +++module System.ArrowVHDL.Circuit.Tests +where++-- Lediglich das Modul \hsSource{Circuit.Descriptor} wird benötigt+++import System.ArrowVHDL.Circuit.Descriptor+++-- Die Funktion \hsSource{isFromOrToComp} ermittelt ob eine übergebene Kante eine Verbindung zu einer Komponente, die über ihre Komponenten ID+-- identifiziert wird, darstellt.++isFromOrToComp :: CompID -> Edge -> Bool+isFromOrToComp cid (MkEdge (Nothing, pi) (Just co, po)) = cid == co+isFromOrToComp cid (MkEdge (Just ci, pi) (Nothing, po)) = cid == ci+isFromOrToComp cid (MkEdge (Just ci, pi) (Just co, po)) = cid == co +++-- Jeder Schaltkreis besitzt eine innere Verschaltung und daneben eine Verbindung zur Außenwelt. Eine Kante kann von ``Außen'' her kommen, oder+-- nach ``Außen'' gehen. Genau diese Kanten sind die Pins eines tatsächlichen Chips. +++-- Mit \hsSource{isToOuter} wird getestet, ob es sich um eine abgehende Kante, also einen ``outgoing''-Pin handelt.++isToOuter :: Edge -> Bool+isToOuter (MkEdge (_, _) (Nothing, _)) = True+isToOuter _                            = False+++-- \par Das Pendant zu abgehenden Kanten sind eingehende Kanten. Diese werden auch als Inputs bezeichnet. \hsSource{isFromOuter} testet, ob+-- eine Kante eingehend ist.++isFromOuter :: Edge -> Bool+isFromOuter (MkEdge (Nothing, _) (_, _)) = True+isFromOuter _                            = False+++++-- Mit der Funktion \hsSource{hasLabel} wird überprüft, ob ein Schaltkreis den übergebenen Namen trägt.++hasLabel :: String -> CircuitDescriptor -> Bool+hasLabel s+    = ((== s).label.nodeDesc)+++-- \hsSource{isAtomic} überprüft, ob ein Baustein atomar ist, also ob er aus weiteren Bausteinen zusammengesetzt ist, oder nicht.++isAtomic :: CircuitDescriptor -> Bool+isAtomic g+    = if (length (nodes g) == 0) then True else False+++-- Die Funktion \hsSource{isSuperNodeOf} testet, ob eine Komponente eine bestimmte andere Komponente, identifiziert durch ihre Komponenten ID,+-- enthält.++isSuperNodeOf :: CircuitDescriptor -> CompID -> Bool+isSuperNodeOf g cid +    = if length (filter (== cid) subNodes) > 0+        then True+        else False+    where subNodes = map (nodeId.nodeDesc) $ nodes g+++-- Mit der Funktion \hsSource{isGenerated} lässt sich herausfinden, ob einen Komponente eine vom Entwickler entwickelte Komponente ist, oder ob+-- diese Komponente automatisch vom System erzeugt wurde.++isGenerated :: CircuitDescriptor -> Bool+isGenerated s = ((== '|').head.label.nodeDesc) s && ((== '|').head.reverse.label.nodeDesc) s++++-- %%% TODO : isID ist nur eine debugging funktion und muss rausgenommen werden++isID :: CircuitDescriptor -> Bool+isID = hasLabel "-ID-"++-- In einem weiteren Test wird die Art der Schaltung überprüft. Handelt es sich bei dem vorliegenden \hsSource{CircuitDescriptor} um einen+-- Kombinatorischen Schaltkreis, um ein Register oder um eine Schleife?++isCombinatorial :: CircuitDescriptor -> Bool+isCombinatorial (MkCombinatorial _ _ _ _ _) = True+isCombinatorial otherwise           = False++isRegister :: CircuitDescriptor -> Bool+isRegister (MkRegister _ _) = True+isRegister otherwise      = False++isLoop :: CircuitDescriptor -> Bool+isLoop (MkLoop _ _ _ _) = True+isLoop otherwise        = False
+ src/System/ArrowVHDL/Circuit/Tools.hs view
@@ -0,0 +1,149 @@+-- Dieses Modul stellt Funktionen zur Verfügung die beim erstellen von Beispielen nützlich sind. ++module System.ArrowVHDL.Circuit.Tools+where+++-- Eingebunden werden für die Demo-Funktionen aus den+-- Systembibliotheken die folgenden Module:++import System.IO (writeFile)+import System.Cmd (system)++-- Daneben wird noch der \begriff{except}-Operator (\hsSource{(\\)})+-- aus dem Listen-Modul benötigt:++import Data.List ((\\))+++-- Schließlich werden eine ganze Reihe von Modulen aus der+-- \hsSource{Circuit}-Reihe verwendet:++import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Show+import System.ArrowVHDL.Circuit.Graphs+import System.ArrowVHDL.Circuit.Auxillary+import System.ArrowVHDL.Circuit.Show.DOT+import System.ArrowVHDL.Circuit.Workers (mergeEdges)+import System.ArrowVHDL.Circuit.Tests+++-- \subsection{Demo Funktionen} Mit \hsSource{write} und+-- \hsSource{genPicture} werden zwei Funktionen definiert, die auf das+-- Dateisystem zugreifen, und letztliche dazu verwendet werden, eine+-- Grafik einer Schaltung zu erstellen. Dazu wird mittels+-- \hsSource{show} die \begriff{.dot}-Darstellung des übergebenen+-- Schaltkreises erzeugt und im \hsSource{/tmp}-Folder abgespeichert.++-- \hsSource{genPicture} greift dann auf die soeben erzeugte Datei zu,+-- und erzeugt aus dem \begriff{.dot}-File ein Bild mit der+-- Grafik. Hierbei wird vorausgesetzt, das auf dem System die+-- \begriff{graphviz}-Umgebung vorinstalliert ist.++write x    = writeFile "/tmp/test.dot" (Circuit.Show.DOT.showCircuit x)+genPicture = system "dot /tmp/test.dot -Tjpg -o /tmp/test.jpg"++++-- Mit der Funktion \hsSource{toCircuit} lässt sich aus einer minimal+-- Definition ein gültiger Schaltkreis erzeugen. Die minimale+-- Definition muss dabei wenigstens einen Namen, sowie die Anzahl der+-- eingehenden und Ausgehenden Pins enthalten.++toCircuit :: (String, Int, Int) -> CircuitDescriptor+toCircuit (name, inPins, outPins)+    = emptyCircuit { nodeDesc = nodedesc+                   }+      where nodedesc = MkNode { label   = name +                              , nodeId  = 0 +                              , sinks   = [0..(inPins -1)]+                              , sources = [0..(outPins -1)]+                              } +++-- Die Funktion \hsSource{filterByName} ist ein Beispiel für die+-- Mächtigkeit des neuartigen Ansatzes. \hsSource{filterByName} geht+-- hier über eine Schaltung hinweg, und nimmt alle Vorkommenden+-- Bausteinen mit einem gewissen Namen heraus. So lassen sich zum+-- Testen sehr leicht von den enthaltenen Schaltungen, gewisse selbige+-- durch eine andere Version ersetzen.++filterByName :: CircuitDescriptor -> String -> CircuitDescriptor+filterByName s n +    = if ((label . nodeDesc) s == n) && (length (nodes s) < 1) +        then NoDescriptor+        else s { nodes = (map (flip filterByName n) $ nodes s) }++ +-- Zur Anwendung wird \hsSource{filterByName} in der nächsten+-- Funktion, nämlich in \hsSource{replace} gebracht. Hier übergibt man+-- die Schaltung in der man ändern möchte. Außerdem übergibt man ein+-- Tupel bestehenden aus einem \hsSource{from}-Baustein und einem+-- \hsSource{to}-Baustein, wobei nach dem \hsSource{from}-Baustein+-- gesucht wird, und dieser dann mit dem \hsSource{to}-Baustein+-- ersetzt wird. Als Ergebnis erhält man eine veränderte Schaltung++replace :: CircuitDescriptor -> (CircuitDescriptor, CircuitDescriptor) -> CircuitDescriptor+replace s ft@(from, to) +    | not $ isAtomic s+    = s { nodes = map (flip replace $ ft) (nodes s) }+    +    |  (label . nodeDesc) s           == (label . nodeDesc) from+    && length (sinks   . nodeDesc $ s) == length (sinks   . nodeDesc $ from)+    && length (sources . nodeDesc $ s) == length (sources . nodeDesc $ from)+    && length (sinks   . nodeDesc $ s) == length (sinks   . nodeDesc $ to)+    && length (sources . nodeDesc $ s) == length (sources . nodeDesc $ to)+    = to { nodeDesc = (nodeDesc to) { nodeId = (nodeId . nodeDesc) s } }+  +    | otherwise = s++-- %% TODO : Programmiere: mark / cut / trim++++-- Die Funktion \hsSource{bypass} ermöglicht eine ähnlich+-- Funktionalität, wie auch schon \hsSource{filterByName} oder+-- \hsSource{replace}.  Allerdings nimmt \hsSource{bypass} nur die+-- gefundenen Bausteine aus der Schaltung heraus.+-- +-- %%% TODO : Erklären was rebuildIf macht, und warum ;) +-- %%% TODO : grep wires usw. ist teil von rebuildIf++bypass :: CircuitDescriptor -> CircuitDescriptor -> CircuitDescriptor+bypass s item +    = s { nodes = ns+        , edges = es+        }+    where (es, ns) = foldl (rebuildIf (\x -> label (nodeDesc x) == label (nodeDesc item))) (edges s, []) $ nodes s+++rebuildIf :: (CircuitDescriptor -> Bool) ->  ([Edge], [CircuitDescriptor]) -> CircuitDescriptor -> ([Edge], [CircuitDescriptor])+rebuildIf isIt (super_es, new_ns) NoDescriptor = (super_es, new_ns)+rebuildIf isIt (super_es, new_ns) n+    |  isIt n       && length (sinks . nodeDesc $ n) == length (sources . nodeDesc $ n)+    = (new_es , new_ns)+  +    | otherwise +    = (super_es, new_ns ++ [n'])+  +    where new_es  = (super_es \\ (lws ++ rws)) ++ nws+          lws     = leftWires super_es (nodeId . nodeDesc $ n)+          rws     = rightWires super_es (nodeId . nodeDesc $ n)+          nws     = zipWith MkEdge (map sourceInfo lws) (map sinkInfo rws)+          (es,ns) = foldl (rebuildIf isIt) (edges n, []) $ nodes n+          n'      = n { nodes = ns+                      , edges = es+                      }+++grepWires :: (Edge -> Anchor) -> [Edge] -> CompID -> [Edge]+grepWires f es cid = filter (\e -> fst (f e) == Just cid) es++leftWires :: [Edge] -> CompID -> [Edge]+leftWires = grepWires sinkInfo++rightWires :: [Edge] -> CompID -> [Edge]+rightWires = grepWires sourceInfo++solderWires :: ([Edge], [Edge]) -> [Edge]+solderWires = mergeEdges
+ src/System/ArrowVHDL/Circuit/Workers.hs view
@@ -0,0 +1,153 @@+-- In diesem Modul werden eine Reihe von \begriff{worker}-Funktionen definiert die alle einen übergebenen Wert verändern und die geänderte+-- Variante zurückliefern. ++module System.ArrowVHDL.Circuit.Workers+where++-- Zur Funktionsdefinition werden Funktionen aus folgenden Modulen benötigt.++import Data.List (nub, (\\))++import GHC.Exts (sortWith)++import System.ArrowVHDL.Circuit.Descriptor+import System.ArrowVHDL.Circuit.Sensors+import System.ArrowVHDL.Circuit.Tests++++-- \subsection{CircuitDescriptor Funktionen}+-- Dieser Abschnitt befasst sich mit Funktionen, die auf \hsSource{CircuitDescriptor}en arbeiten. ++-- Mit der Funktion \hsSource{alterCompIDs} lassen sich alle Komponenten IDs innerhalb eines \hsSource{CircuitDescriptor}s verändern. Der erste+-- Parameter legt dabei die kleinst mögliche ID fest. ++alterCompIDs :: Int -> CircuitDescriptor -> CircuitDescriptor+alterCompIDs i sg+    = sg { nodeDesc = nd { nodeId = nodeId nd + i }+         , nodes  = map (alterCompIDs i) $ nodes sg+         , edges  = map (\ (MkEdge (ci,pi) (co,po))+                        -> (MkEdge (maybe ci (Just.(+i)) $ ci ,pi)+                                   (maybe co (Just.(+i)) $ co ,po))+                        ) $ edges sg+         }+     where nd = nodeDesc sg+++-- Die Funktion \hsSource{dropCircuit} ermöglicht es, einzelne Schaltkreis-Beschreibungen aus dem \hsSource{CircuitDescriptor} zu entfernen.+-- Hierzu wird eine match-Funktion als erster Parameter erwartet.++dropCircuit :: (CircuitDescriptor -> Bool) -> CircuitDescriptor -> CircuitDescriptor+dropCircuit f sg+    = sg { nodes = newNodes+         , edges = newEdges+         }+    where specific = filter f (nodes sg)+          newEdges = foldl (flip dropEdgesBordering) (edges sg) (map (nodeId.nodeDesc) specific)+          newNodes = map (dropCircuit f) $ nodes sg \\ specific+++-- flatten} ist eine Funktion, welche die interne Struktur des \hsSource{CircuitDescriptor}s \begriff{glättet}. Jeder+-- CircuitDescriptor} der nicht Atomar ist, enthält weitere Unterstrukturen. Diese beschreiben, woraus dieser+-- CircuitDescriptor} aufgebaut wird. Enthält der \hsSource{CircuitDescriptor} unnötige Verschachtelungen, werden diese mittels+-- flatten} entfernt. ++-- Als Sonderfall gelten die Schaltungen, die Schleifen darstellen. Hier gibt es keine überflüssigen Verschachtelungen, mindestens aber muss+-- der Algorithmus zum erkennen solcher ein anderer sein, so dass \hsSource{flatten} auf diese Teilbereiche zunächst nicht angewandt werden+-- sollte.  +flatten :: CircuitDescriptor -> CircuitDescriptor+flatten g+    | isLoop g+    = g++    | otherwise+    = g { nodes = nub $ atomCIDs+        , edges =       esBetweenAtoms+        }+    where atomCIDs       = filter isAtomic $ allCircuits g+          esFromAtoms    = concat $ map (fromCompEdges g . nodeId . nodeDesc) atomCIDs+          esFromOuter    = filter isFromOuter $ edges g+          esBetweenAtoms = zipWith MkEdge (map sourceInfo $ esFromOuter ++ esFromAtoms) (map nextAtomOrOut $ esFromOuter ++ esFromAtoms)+          nextAtomOrOut  = (\e -> let (c, p) = nextAtomic g e +                                  in  if c == mainID then (Nothing, p) else (Just c, p))+          mainID         = nodeId.nodeDesc $ g+++-- Die Funktionen \hsSource{dropGenerated} sowie \hsSource{dropID} stellen Spezialfälle der \hsSource{dropCircuit} Funktion dar.+-- dropGenerated} löscht sämtliche \hsSource{CircuitDescriptor}en, die automatisch generiert wurden. Ebenso löscht \hsSource{dropID}+-- CircuitDescriptor}en, die den \hsSource{isID}-Test bestehen. \hsSource{isID} sowie \hsSource{isGenerated} sind im Modul+-- \ref{mod:Circuit.Tests} beschrieben.++dropGenerated :: CircuitDescriptor -> CircuitDescriptor+dropGenerated = dropCircuit isGenerated++dropID :: CircuitDescriptor -> CircuitDescriptor+dropID = dropCircuit isID++++-- Diese Funktionen arbeiten auf \hsSource{CircuitDescriptor}en, und erzeugen Kanten, oder es handelt sich um Funktionen, die aus bestehenden+-- Kanten neue generieren. +++-- Mit der Funktion \hsSource{connectCID} lassen sich zwei \hsSource{CircuitDescriptor}en miteinander verbinden. Dabei werden zwei+-- \hsSource{CircuitDescriptor}en übergeben, sowie die Quell-Komponenten ID und die Ziel-Komponenten ID zusammen mit einer Ziel-Pin ID. Erzeugt+-- wird eine Kante, welche die Verbindung zwischen beiden \hsSource{CircuitDescriptor}en darstellt. Von der Quelle wird keine \hsSource{PinID}+-- benötigt, da hier auf den nächst freien Pin zurückgegriffen wird. Auf der Ziel-Seite ist es dann aber notwendig, einen Ziel-Pin zu+-- definieren.++connectCID :: CircuitDescriptor -> CircuitDescriptor -> CompID -> (CompID, PinID) -> Edge+connectCID old_g g cidF (cidT,pidT)+    = MkEdge (Just cidF, nextFpin) (Just cidT, pidT)+    where nextFpin  = head $ drop cntEsFrom $ sources.nodeDesc $ getComp old_g cidF+          cntEsFrom = length $ filter (\x -> (not.isFromOuter $ x) && (srcComp x == cidF)) $ edges g+++-- Zum entfernen von Kanten die an eine Komponente angrenzen, ist die Funktion \hsSource{dropEdgesBordering} da. Übergeben wird die ID der+-- Komponente, die heraus gelöst werden soll, sowie die Liste mit den betroffenen Kanten. Es wird dann eine neue List mit Kanten erstellt, die+-- nicht mehr zu der Komponente mit der besagten ID führen. Alle Kanten die nicht mehr an einer Komponente andocken, werden zusammengefügt.+-- Diese Funktion kann nur dann funktionieren, wenn die zu lösende Komponente genausoviele eingehende Pins, wie ausgehende Pins besitzt. +-- %%% TODO : Components with different InPinCount and OutPinCount have a PROBLEM ++dropEdgesBordering :: CompID -> [Edge] -> [Edge]+dropEdgesBordering cid es+    = (es ++ mergeEdges (toIt, fromIt)) \\ (toIt ++ fromIt)+    where toIt   = filter ((== (Just cid)).fst.sinkInfo)   $ es+          fromIt = filter ((== (Just cid)).fst.sourceInfo) $ es+++-- \hsSource{mergeEdges} ist eine Funktion, die zwei Listen mit Kanten entgegennimmt und diese beiden zusammenfasst. Kanten die auf einen Pin+-- enden und Kanten die vom gleichen Pin starten, werden zu einer Kante zusammengefasst. ++mergeEdges :: ([Edge], [Edge]) -> [Edge]+mergeEdges (xs, ys)+    = zipWith (\x y -> MkEdge (sourceInfo x) (sinkInfo y)) xs' ys'+    where x_snkPins = map snkPin xs+          y_srcPins = map srcPin ys+          xs'       = sortWith snkPin $ filter (\edg -> (snkPin edg) `elem` y_srcPins) xs+          ys'       = sortWith srcPin $ filter (\edg -> (srcPin edg) `elem` x_snkPins) ys+++-- Mit der \hsSource{fillEdgeInfoCompID} Funktion, lassen sich die Quell- und Ziel-Komponenten IDs in Kanten setzen, in denen bis dahin+-- \hsSource{Nothing} als Wert gespeichert ist. Dies ist dann notwendig, wenn eine neue Komponente in eine bestehende Struktur eingefügt wird.+-- Dies wird dann benötigt, wenn eine Komponente in eine Struktur eingefügt werden soll. Eine noch nicht integrierte Komponente bekommt ihre %% TODO : Werte ist sicher nicht das richtige wort hier+-- Werte von einer unbekannte Komponente (\hsSource{Nothing}) und liefert die Ergebnisse auch an \hsSource{Nothing}. Wird sie nun eine+-- Unterkomponente, so kann das \hsSource{Nothing} durch eine tatsächliche Komponenten ID ersetzt werden. ++fillEdgeInfoCompID :: CompID -> Edge -> Edge+fillEdgeInfoCompID cid (MkEdge (Nothing, srcPid) (snkInfo)) = (MkEdge (Just cid, srcPid) (snkInfo))+fillEdgeInfoCompID cid (MkEdge (srcInfo) (Nothing, snkPid)) = (MkEdge (srcInfo) (Just cid, snkPid))+fillEdgeInfoCompID _   e = e+++-- Ein ähnliches Problem wie \hsSource{fillEdgeInfoCompID} wird auch von den Funktionen \hsSource{fillSrcInfoCompID} und+-- \hsSource{fillSnkInfoCompID} gelöst. Diese unterscheiden sich lediglich darin, dass diese Funktionen jeweils nur die Quell-Pins oder nur die+-- Ziel-Pins betreffen. ++fillSrcInfoCompID :: CompID -> Edge -> Edge+fillSrcInfoCompID cid (MkEdge (Nothing, srcPid) (snkCid, snkPid))+    = (MkEdge (Just cid, srcPid) (snkCid, snkPid))++fillSnkInfoCompID :: CompID -> Edge -> Edge+fillSnkInfoCompID cid (MkEdge (srcCid, srcPid) (Nothing, snkPid))+    = (MkEdge (srcCid, srcPid) (Just cid, snkPid))
+ src/System/ArrowVHDL/TEA.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE Arrows, +             NoMonomorphismRestriction,+             RebindableSyntax #-}+             -- GADTs #-}+module System.ArrowVHDL.TEA where++import Data.Char (digitToInt, ord, chr)+import qualified Data.Bits as B+import Data.Word (Word32(..))+import Prelude hiding (cycle)++import Control.Category+import System.ArrowVHDL.Circuit+import System.ArrowVHDL.Circuit.Arrow+import System.ArrowVHDL.Circuit.Defaults hiding (Value, Key)++type Key     = (Word32, Word32, Word32, Word32)+type HalfKey = (Word32, Word32)+type Value   = (Word32, Word32)+type Round   = Int++type TL4+    = (Bool, (Bool, (Bool, (Bool))))++type TL32 +    = (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, +      (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, +      (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool,+      (Bool, (Bool, (Bool, (Bool, (Bool, (Bool, (Bool,  Bool+      )))))))))))))))))))))))))))))))+type KeyTL     = (TL32, TL32, TL32, TL32)+type HalfKeyTL = (TL32, TL32)+type ValueTL   = (TL32, TL32)+type RoundTL   = TL32++-- aXorTL4+--   =     aXor +--     >:> aXor +--     >:> aXor +--     >:> aXor+--   where +--     aA >:> aB = ((aFst *** aFst) >>> aA) &&& ((aSnd *** aSnd) >>> aB)+--     infixr 4 >:>++-- aXorTL32+--   =     aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor+--     >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor +--     >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor +--     >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor >:> aXor +--   where +--     aA >:> aB = ((aFst *** aFst) >>> aA) &&& ((aSnd *** aSnd) >>> aB)+--     infixr 4 >:>++-- aOrTL32+--   =     aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr+--     >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr +--     >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr +--     >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr >:> aOr +--   where +--     aA >:> aB = ((aFst *** aFst) >>> aA) &&& ((aSnd *** aSnd) >>> aB)+--     infixr 4 >:>++magicConstant = 0x9e3779b9++-- |`delta` is the function, that considering the round number,+-- calculates the magic number.+delta :: Int -> Word32+delta r = fromIntegral r * magicConstant+++-- |Here comes a function `cycleN` that calculates the cypher of the+-- TEA. It therefore takes a round counter and calculates the TEA with+-- exact that amount of rounds.+cycleN :: Int -> Key -> Value -> Value+cycleN n = cycleN' (1, n)++-- |Another more specific version of `cycleN` is `cycleN'`. This+-- function has a more complex round counter (Tuple of Int vs. single+-- Int). The first element of the tuple is the actual round counter;+-- the second element count's backward and acts as the recursion+-- break.+cycleN' :: (Round, Int) -> Key -> Value -> Value+cycleN' (_,0) _ v = v+cycleN' (r,n) k v = cycleN' (r+1, n-1) k (cycle r k v)++-- |`cycle` without any naming suffixes is the function that actually+-- calculates one round of the TEA.+cycle :: Round -> Key -> Value -> Value+cycle r (k0, k1, k2, k3) value+  = let value' = feistel1 value+    in           feistel2 value'+  where feistel1 = feistel r (k0, k1)+        feistel2 = feistel r (k2, k3)++-- |The `feistel` function contains the logic of the TEA. It is+-- similar to the depicted definition inside the wikipedia-article on+-- TEA: https://en.wikipedia.org/wiki/Tiny_Encryption_Algorithm+feistel :: Round -> HalfKey -> Value -> Value+feistel r (kA, kB) (vA, vB)+  = (vB, vA + tB)+  where t1 = kA + (vB `B.shift`    4)+        t2 = vB + delta r+        t3 = kB + (vB `B.shift` (-5))+        tB = t1 `B.xor` t2 `B.xor` t3++-- |The `feistel'functional` function contains the logic of the TEA. It is+-- similar to the depicted definition inside the wikipedia-article on+-- TEA: https://en.wikipedia.org/wiki/Tiny_Encryption_Algorithm+feistel'functional :: Round -> HalfKey -> Value -> Value+feistel'functional r (kA, kB) (vA, vB)+  = (vB, vA + tB)+  where t1 = kA + (vB `B.shift`    4)+        t2 = vB + delta r+        t3 = kB + (vB `B.shift` (-5))+        tB = t1 `B.xor` t2 `B.xor` t3++feistel'arrow :: Round -> HalfKey -> Value -> Value+feistel'arrow r key val+  = runGrid aTEA $ (key, val)+  where aTEA :: (Arrow a) => Grid a (HalfKey, Value) Value                  -- ((K0, K1), (V0, V1))+        aTEA =   aDistr                                                     -- (((K0, K1), V0), ((K0, K1), V1))+             >>> first                                                      +                 (   aSnd                                                   -- (V0, ((K0, K1), V1))+                 )+             >>> second+                 ( (     aFlip -- &&& aSnd                                  -- (V0, ((V1, (K0, K1)), V1))+                     >>> aDistr &&& aFst                                    -- (V0, ((((V1, K0), (V1, K1)), V1), V1))+                     >>> (   ((first aSHL4)+                         *** (first aSHR5))+                         *** aXorDeltaR+                         )                                                  -- (V0, ((((S1, K0), (S1, K1)), T3), V1))+                     >>> first (aXor *** aXor)                              -- (V0, (((T1, T2), T3), V1))+                     >>> first aXor                                         -- (V0, ((T12, T3), V1))+                     >>> aXor                                               -- (V0, (TB, V1))+                   )+                   &&& aSnd+                 )+             >>> a_aBC2ABc+             >>> first aXor+             >>> aFlip+        aSHL4 :: (Arrow a, B.Bits b) => Grid a b b+        aSHL4 = (aId &&& (aConst (4 :: Int))) >>> aShiftL++        aSHR5 :: (Arrow a, B.Bits b) => Grid a b b+        aSHR5 = (aId &&& (aConst (5 :: Int))) >>> aShiftR++        aXorDeltaR :: (Arrow a) => Grid a Word32 Word32+        aXorDeltaR = (aId &&& (aConst (delta r))) >>> aXor+++-- key :: Key+-- key   = (65, 65, 65, 65) -- AAAA++-- testMessage = "Hello World!"++-- msg2vals :: String -> [Value]+-- msg2vals []          = []+-- msg2vals (s0:[])     = msg2vals [s0, '\0']+-- msg2vals (s0:s1:ses)+--   = (fromIntegral $ ord s0, fromIntegral $ ord s1) : (msg2vals ses)++-- vals2msg :: [Value] -> String+-- vals2msg [] = ""+-- vals2msg ((v0,v1):vs) = (chr (fromIntegral v0): (chr (fromIntegral v1) : (vals2msg vs)))++-- aFeistel +--   = proc ((v0, v1), (k0, k1)) -> do+--       vsl <- aShl -< (v1, 4)+--       vsr <- aShr -< (v1, 5)++--       t1  <- aXor -< (k0, vsl)+--       t2  <- aXor -< (d,  v1)+--       t3  <- aXor -< (k1, vsr)++--       t4  <- aOr  -< (t1, t2)+--       t5  <- aOr  -< (t4, t3)++--       v0' <- aId  -< (v1)+--       v1' <- aXor -< (v0, t5)+--       returnA    -< (v0', v1')+--   where +--     aShl = aShiftL+--     aShr = aShiftR+--     d    = (delta 0)++-- aCycle +--   = proc ((v0, v1), ((k0, k1), (k2, k3))) -> do+--       (v0', v1')   <- aFeistel -< ((v0, v1),   (k0, k1))+--       (v0'', v1'') <- aFeistel -< ((v0', v1'), (k2, k3))+--       returnA                  -< (v0'', v1'')+++aShiftL4_XorKey+  =   first +      (     aDup+        >>> second (aConst 4)+        >>> aShiftL+      )+    >>> aAdd+    -- >>> aXor++aShiftR5_XorKey+  =   first +      (     aDup+        >>> second (aConst 5)+        >>> aShiftR+      )+    >>> aAdd+    -- >>> aXor++aXorDelta+    =   aId &&& (aConst 2654435769)+    >>> aAdd+    -- >>> aXor++aFeistelTest+  = (aFst >>> aSnd) &&& (aFst >>> aFst) &&& (first aSnd)+   >>> second +       ( second +         (   aDistr &&& aFst+         >>> (aShiftL4_XorKey *** aShiftR5_XorKey) *** aXorDelta+         >>> first aOr+         >>> aOr+         )+       )+   >>> second aAdd++aCycleTest+  =    a_aBC2ABc+   >>> first aFeistelTest+   >>> aFeistelTest+
+ src/System/ArrowVHDL/Test.hs view
@@ -0,0 +1,12 @@+module System.ArrowVHDL.Test where++import Prelude++import Control.Category ((>>>))++import System.ArrowVHDL.Circuit+import System.ArrowVHDL.Circuit.Arrow+import System.ArrowVHDL.Circuit.IEEE_STD_LOGIC_1164++aBlub :: (Arrow a) => Grid a (Bool, Bool) Bool+aBlub = aXor >>> aNot