packages feed

hsverilog (empty) → 0.1.0

raw patch · 13 files changed

+942/−0 lines, 13 filesdep +basedep +containersdep +hspecsetup-changed

Dependencies added: base, containers, hspec, hspec-contrib, hspec-expectations-lifted, hsverilog, shakespeare, text, transformers

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+## 0.1.0++* First Release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Junji Hashimoto++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Junji Hashimoto nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,29 @@+# HsVerilog: Synthesizable Verilog DSL supporting for multiple clock and reset++[![Hackage version](https://img.shields.io/hackage/v/hsverilog.svg?style=flat)](https://hackage.haskell.org/package/hsverilog)  [![Build Status](https://travis-ci.org/junjihashimoto/hsverilog.png?branch=master)](https://travis-ci.org/junjihashimoto/hsverilog) [![Coverage Status](https://coveralls.io/repos/junjihashimoto/hsverilog/badge.png)](https://coveralls.io/r/junjihashimoto/hsverilog)++## Getting started++Install this from Hackage.++    cabal update && cabal install hsverilog++## Usage++Syntax is similar to Verilog.+See tests/test.hs and following examples.+++### counter circuit++```+circuit "counter" $ do+  clk <- input "clk" Bit+  rstn <- input "rstn" Bit+  _ <- output "dout" $ 7><0+  reg "dout" (7><0) [Posedge clk,Negedge rstn] $ \dout ->+    If (Not (S rstn)) 0 $+      If (Eq dout 7) +        0+        (dout + 1)+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hsverilog.cabal view
@@ -0,0 +1,61 @@+-- Initial hspec-server.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                hsverilog+version:             0.1.0+synopsis:            Synthesizable Verilog DSL supporting for multiple clock and reset+description:         Synthesizable Verilog DSL supporting for multiple clock and reset+license:             BSD3+license-file:        LICENSE+author:              Junji Hashimoto+maintainer:          junji.hashimoto@gmail.com+stability:           Experimental+category:            Hardware+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++bug-reports:         https://github.com/junjihashimoto/hsverilog/issues++extra-source-files:+  ChangeLog.md+  README.md++source-repository head+  type:           git+  location:       https://github.com/junjihashimoto/hsverilog.git++library+  exposed-modules:     HsVerilog+                     , HsVerilog.Type+                     , HsVerilog.Verilog+                     , HsVerilog.Verilog.Internal+                     , HsVerilog.Verilog.DSL+                     , HsVerilog.Library+                     , HsVerilog.Simulation+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.6 && <5+                     , transformers+                     , shakespeare+                     , text+                     , containers+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite test+    type:              exitcode-stdio-1.0+    main-is:           test.hs+    hs-source-dirs:    tests,dist/build/autogen+    ghc-options:       -Wall++    build-depends: base+                 , hsverilog+                 , hspec+                 , hspec-contrib+                 , hspec-expectations-lifted+                 , shakespeare+                 , transformers+                 , text+                 , containers+    Default-Language:   Haskell2010
+ src/HsVerilog.hs view
@@ -0,0 +1,12 @@+module HsVerilog (+  module HsVerilog.Type+, module HsVerilog.Verilog+, module HsVerilog.Simulation+, module HsVerilog.Library+) where++import HsVerilog.Type+import HsVerilog.Verilog+import HsVerilog.Simulation+import HsVerilog.Library+
+ src/HsVerilog/Library.hs view
@@ -0,0 +1,28 @@+{-#LANGUAGE OverloadedStrings#-}+module HsVerilog.Library where++import HsVerilog.Type+import HsVerilog.Verilog++dff :: Circuit+dff = circuit "dff" $ do+  clk <- input "clk" Bit+  rstn <- input "rstn" Bit+  din <- input "din" Bit+  _dout <- output "dout" Bit+  reg' "dout" Bit [Posedge clk,Negedge rstn] $+    If (Not (S rstn))+      (C 0)+      (S din)++dff8 :: Circuit+dff8 = circuit "dff8" $ do+  clk <- input "clk" Bit+  rstn <- input "rstn" Bit+  din <- input "din" $ Range 7 0+  _dout <- output "dout" $ Range 7 0+  reg' "dout" (Range 7 0) [Posedge clk,Negedge rstn] $+    If (Not (S rstn))+      (C 0)+      (S din)+
+ src/HsVerilog/Simulation.hs view
@@ -0,0 +1,160 @@++module HsVerilog.Simulation where++import qualified Data.Text as T+import Control.Monad.Trans.State+import Control.Monad.Trans.Reader+import Control.Monad.IO.Class+import Control.Monad+import qualified Data.Map as M++import HsVerilog.Type++val' :: Exp -> Reader Circuit Integer+val' (If a b c) = do+  v <- val' a+  if v /= 0 then val' b else val' c+val' (Mux a b c) = val' $ If a b c+val' (Not a) = do+  v <- val' a+  return $ if v == 0 then 1 else 0+val' (Or a b) = do+  a' <- val' a+  b' <- val' b+  case (a',b') of+    (0,0) -> return 0+    (0,_) -> return 1+    (_,0) -> return 1+    (_,_) -> return 1+val' (BitOr a b) = do+  a' <- val' a+  b' <- val' b+  case (a',b') of+    (0,0) -> return 0+    (0,_) -> return 1+    (_,0) -> return 1+    (_,_) -> return 1+val' (And a b) = do+  a' <- val' a+  b' <- val' b+  case (a',b') of+    (0,0) -> return 0+    (0,_) -> return 0+    (_,0) -> return 0+    (_,_) -> return 1+val' (BitAnd a b) = do+  a' <- val' a+  b' <- val' b+  case (a',b') of+    (0,0) -> return 0+    (0,_) -> return 0+    (_,0) -> return 0+    (_,_) -> return 1+val' (Add a b) = do+  a' <- val' a+  b' <- val' b+  return $ a' + b'+val' (Sub a b) = do+  a' <- val' a+  b' <- val' b+  return $ a' - b'+val' (Mul a b) = do+  a' <- val' a+  b' <- val' b+  return $ a' * b'+val' (Div a b) = do+  a' <- val' a+  b' <- val' b+  return $ a' `div` b'+val' (Eq a b) = do+  a' <- val' a+  b' <- val' b+  return $ if a' == b' then 1 else 0+val' (S a) = do+  cir <- ask+  return $ sval $ (sym cir (sname a))+val' (C a) = return $ a+val' (NonBlockAssign _ _) = error "do not eval this"+val' (BlockAssign _ _) = error "do not eval this"++sym' :: Circuit -> M.Map T.Text Signal+sym' cir = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [cinput,(map alsig).creg,(map assig).cassign]+sym :: Circuit -> T.Text -> Signal+sym cir name = sym' cir M.! name+  +val :: Circuit -> Exp -> Integer+val cir exp' = flip runReader cir $ val' exp'++readReg :: Monad m => T.Text ->  StateT Circuit m Integer+readReg name = do+  cir <- get+  let m = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [(map alsig).creg]+  return $ sval $ m M.! name++readInput :: Monad m => T.Text ->  StateT Circuit m Integer+readInput name = do+  cir <- get+  let m = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [cinput]+  return $ sval $ m M.! name++readOutput :: Monad m => T.Text ->  StateT Circuit m Integer+readOutput name = do+  cir <- get+  let m = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [coutput]+  return $ sval $ m M.! name++readAssign :: Monad m => T.Text ->  StateT Circuit m Integer+readAssign name = do+  cir <- get+  let m = M.fromList $ map (\sig -> (sname sig,sig)) $ concat $ map (\f -> f cir) [(map assig).cassign]+  return $ sval $ m M.! name++(<==) :: Monad m => T.Text -> Integer -> StateT Circuit m ()+(<==) name v = do+  cir <- get+  let inps = map (update v) $ cinput cir+  put $ cir {cinput=inps}+  where+    update v' sig@(Signal name' _range _) | name' == name = sig{sval=v'}+                                          | otherwise = sig++simM :: Monad m => Circuit -> StateT Circuit m a -> m Circuit+simM circuit act = do+  (_,cir) <- flip runStateT circuit act+  return cir++print' :: MonadIO m => StateT Circuit m ()+print' = do+  cir <- get+  liftIO $ print cir++updateReg :: Monad m => StateT Circuit m ()+updateReg = do+  cir <- get+  regs <- forM (creg cir) $ \r -> do+    return $ r {alsig = (alsig r) {sval = val cir (alexp r)}}+  put $ cir { creg = regs }++-- updateInput :: Circuit -> Circuit+-- updateInput cir = flip runReader cir $ do+--   regs <- forM (creg cir) $ \r -> do+--     return $ r {alsig = (alsig r) {sval = val cir (alexp r)}}+--   return $ cir { creg = regs }++-- updateOutput :: Circuit -> Circuit+-- updateOutput cir = flip runReader cir $ do+--   regs <- forM (creg cir) $ \r -> do+--     return $ r {alsig = (alsig r) {sval = val cir (alexp r)}}+--   return $ cir { creg = regs }++-- updateAssign :: Circuit -> Circuit+-- updateAssign cir = flip runReader cir $ do+--   regs <- forM (creg cir) $ \r -> do+--     return $ r {alsig = (alsig r) {sval = val cir (alexp r)}}+--   return $ cir { creg = regs }++-- updateWire :: Circuit -> Circuit+-- updateWire cir = flip runReader cir $ do+--   regs <- forM (creg cir) $ \r -> do+--     return $ r {alsig = (alsig r) {sval = val cir (alexp r)}}+--   return $ cir { creg = regs }
+ src/HsVerilog/Type.hs view
@@ -0,0 +1,83 @@+{-#LANGUAGE TypeFamilies#-}+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE OverloadedStrings#-}++module HsVerilog.Type where++import qualified Data.Text as T+import qualified Data.Map as M++class Verilog a where+  toVerilog :: a -> T.Text++data Range =+    Range Integer Integer+  | RangeBit Integer+  | Bit+  deriving (Show,Read,Eq)++data Signal = Signal {+  sname :: T.Text+, sbits :: Range+, sval :: Integer+} deriving (Show,Read,Eq)++type InstanceName = T.Text++data Instance = Instance {+  iname :: InstanceName+, icircuit :: Circuit  +} deriving (Show,Read,Eq)++data Stim =+    Posedge Signal+  | Negedge Signal+  deriving (Show,Read,Eq)++data Always = Always {+  alsig :: Signal+, alstim :: [Stim]+, alexp  :: Exp+} deriving (Show,Read,Eq)++data Assign = Assign {+  assig :: Signal+, asexp :: Exp  +} deriving (Show,Read,Eq)++data Exp = +    If Exp Exp Exp+  | Mux Exp Exp Exp+  | Not Exp+  | Or Exp Exp+  | BitOr Exp Exp+  | And Exp Exp+  | BitAnd Exp Exp+  | Add Exp Exp+  | Sub Exp Exp+  | Mul Exp Exp+  | Div Exp Exp+  | Eq Exp Exp+  | S Signal+  | C Integer+  | NonBlockAssign Exp Exp+  | BlockAssign Exp Exp+  deriving (Show,Read,Eq)++instance Num Exp where+  fromInteger a = C a+  (+) a b = Add a b+  (-) a b = Sub a b+  (*) a b = Mul a b++data Circuit = Circuit {+  cname   :: T.Text+, cinput  :: [Signal]+, coutput :: [Signal]+, cinout :: [Signal]+, creg :: [Always]+, cassign :: [Assign]+, cinstance :: [Instance]+, cinstanceConnect :: M.Map InstanceName [(Signal,Signal)]+} deriving (Show,Read,Eq)
+ src/HsVerilog/Verilog.hs view
@@ -0,0 +1,12 @@+{-#LANGUAGE TypeFamilies#-}+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE OverloadedStrings#-}++module HsVerilog.Verilog  (+  module HsVerilog.Verilog.Internal+, module HsVerilog.Verilog.DSL+) where++import HsVerilog.Verilog.Internal+import HsVerilog.Verilog.DSL
+ src/HsVerilog/Verilog/DSL.hs view
@@ -0,0 +1,136 @@+{-#LANGUAGE TypeFamilies#-}+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE OverloadedStrings#-}++module HsVerilog.Verilog.DSL (+  signal+, initCircuit+, circuit+, circuitM+, input+, output+, inout+, reg+, reg'+, assign+, wire+, inst+, connect+, (.:)+, (><)+) where++import HsVerilog.Type+import Prelude hiding (exp)+--import Text.Shakespeare.Text+import qualified Data.Text as T+--import qualified Data.Text.IO as T+import Control.Monad.Trans.State+--import Control.Monad.Trans.Reader+--import Control.Monad+import Data.Monoid+import qualified Data.Map as M+++signal :: T.Text -> Range -> Signal+signal name bit = Signal name bit 0++initCircuit :: T.Text -> Circuit+initCircuit name = Circuit name [] [] [] [] [] [] M.empty++circuit :: T.Text -> State Circuit a -> Circuit+circuit name act = flip evalState (initCircuit name) $ do+  _ <- act+  get++circuitM :: Monad m => T.Text -> StateT Circuit m a -> m Circuit+circuitM name act = do+  (_,cir) <- flip runStateT (initCircuit name) act+  return cir+++input :: Monad m => T.Text -> Range -> StateT Circuit m Signal+input name bits = do+  cir <- get+  let sig=signal name bits+  put $ cir { cinput = cinput cir ++ [sig]}+  return sig++output :: Monad m => T.Text -> Range -> StateT Circuit m Signal+output name bits = do+  cir <- get+  let sig=signal name bits+  put $ cir { coutput = coutput cir ++ [sig]}+  return sig++inout :: Monad m => T.Text -> Range -> StateT Circuit m Signal+inout name bits = do+  cir <- get+  let sig=signal name bits+  put $ cir { cinout = cinout cir ++ [sig]}+  return sig++reg :: Monad m => T.Text -> Range -> [Stim] -> (Exp -> Exp) -> StateT Circuit m (Signal)+reg name bits stim exp = do+  cir <- get+  let sig=signal name bits+  put $ cir { creg = creg cir ++ [Always sig stim (exp (S sig))]}+  return sig++reg' :: Monad m => T.Text -> Range -> [Stim] -> Exp -> StateT Circuit m (Signal)+reg' name bits stim exp = do+  cir <- get+  let sig=signal name bits+  put $ cir { creg = creg cir ++ [Always sig stim exp]}+  return sig++assign :: Monad m => Signal -> Exp -> StateT Circuit m Signal+assign sig exp = do+  cir <- get+  put $ cir { cassign = cassign cir ++ [Assign sig exp]}+  return sig+++wire :: Instance -> T.Text -> Signal+wire inst' name =+  let sig = (portMap (icircuit inst')) M.! name+  in sig {sname = iname inst' <> "_" <> sname sig}++inst :: Monad m => Circuit -> T.Text -> [(T.Text,Signal)] -> StateT Circuit m Instance+inst circ name conn = do+  cir <- get+  let m = portMap cir+  let inst'=Instance name circ+  put $ cir { cinstance = cinstance cir ++ [inst']}+  let signals=(map (\(n,s) ->(m M.! n,s)) conn) <> instOutputPort name circ+  cir' <- get+  put $ cir' { cinstanceConnect = cinstanceConnect cir' <> M.singleton name signals}+  return $ inst'++connect :: Monad m => Instance -> T.Text -> Signal -> StateT Circuit m ()+connect inst' instPort otherPort = do+  cir <- get+  let m = portMap (icircuit inst')+  let sig= m M.! instPort+  put $ cir { cinstanceConnect =  M.update (\v -> Just (v ++ [(sig,otherPort)])) (iname inst') (cinstanceConnect cir) }+  return ()++(.:) :: Instance -> T.Text -> Signal+(.:) = wire+infix 8 .:++(><):: Integer -> Integer -> Range+(><) = Range+infix 8 ><++portMap :: Circuit -> M.Map T.Text Signal+portMap cir = M.fromList $ map (\sig -> (sname sig,sig)) (portList cir)+portList :: Circuit -> [Signal]+portList cir = cinput cir ++ coutput cir++instOutputPort :: T.Text -> Circuit -> [(Signal,Signal)]+instOutputPort name cir =+  let op  = coutput cir+      ren v = (v,v{sname=name <> "_" <> sname v})+  in map ren op
+ src/HsVerilog/Verilog/Internal.hs view
@@ -0,0 +1,148 @@+{-#LANGUAGE TypeFamilies#-}+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE OverloadedStrings#-}++module HsVerilog.Verilog.Internal where++import Text.Shakespeare.Text+import Prelude hiding (exp)+import HsVerilog.Type+import qualified Data.Text as T+--import qualified Data.Text.IO as T+--import Control.Monad.Trans.State+--import Control.Monad.Trans.Reader+--import Control.Monad+import Data.Monoid+import Data.List+import qualified Data.Map as M+--import HsVerilog.Verilog++instance ToText Integer where+  toText = toText.show++instance Verilog Range where+  toVerilog (Range f t) = [st|[#{f}:#{t}]|]+  toVerilog (RangeBit f) = [st|[#{f}]|]+  toVerilog Bit = ""++instance Verilog Exp where+  toVerilog (If a b c) = [st|+  if (#{toVerilog a})+    #{toVerilog b}+  else+    #{toVerilog c}+|]+  toVerilog (Mux a b c) = [st|(#{toVerilog a}?#{toVerilog b}:#{toVerilog c})|]+  toVerilog (Not a)     = [st|!#{toVerilog a}|]+  toVerilog (Or a b)    = [st|(#{toVerilog a} || #{toVerilog b})|]+  toVerilog (BitOr a b) = [st|(#{toVerilog a} | #{toVerilog b})|]+  toVerilog (And a b)   = [st|(#{toVerilog a} && #{toVerilog b})|]+  toVerilog (BitAnd a b)= [st|(#{toVerilog a} & #{toVerilog b})|]+  toVerilog (Add a b)   = [st|(#{toVerilog a} + #{toVerilog b})|]+  toVerilog (Mul a b)   = [st|(#{toVerilog a} * #{toVerilog b})|]+  toVerilog (Div a b)   = [st|(#{toVerilog a} / #{toVerilog b})|]+  toVerilog (Eq a b)    = [st|(#{toVerilog a} == #{toVerilog b})|]+  toVerilog (S (Signal name range _))= [st|#{name}#{toVerilog range}|]+  toVerilog (C v)       = [st|#{v}|]+  toVerilog (NonBlockAssign a b) = [st|    #{toVerilog a} <= #{toVerilog b};|]+  toVerilog (BlockAssign a b)    = [st|#{toVerilog a} = #{toVerilog b};|]++nonblockExp' sig a@(If _ _ _) = nonblockExp sig a+nonblockExp' sig a = (NonBlockAssign sig a)++nonblockExp sig (If a b@(If _ _ _) c@(If _ _ _)) = +  If a (nonblockExp sig b) (nonblockExp sig c) +nonblockExp sig (If a b c@(If _ _ _)) =+  If a (NonBlockAssign sig b) (nonblockExp sig c)+nonblockExp sig (If a b@(If _ _ _) c) =+  If a (nonblockExp sig b) (NonBlockAssign sig c)+nonblockExp sig (If a b c) =+  If a (NonBlockAssign sig b) (NonBlockAssign sig c)+nonblockExp sig a = a++instance Verilog Stim where+  toVerilog (Posedge sig) = [st|posedge #{sname sig}|]+  toVerilog (Negedge sig) = [st|negedge #{sname sig}|]++instance Verilog Always where+  toVerilog (Always sig stims exp) = [st|+  always @(#{stimstr}) begin+#{toVerilog nbexp}+  end+|]+    where+      stimstr = T.intercalate " or " $ map (\stim -> toVerilog stim) $ stims+      nbexp = nonblockExp' (S sig) exp++instance Verilog Assign where+  toVerilog (Assign sig exp) = [st|  assign #{toVerilog (S sig)} = #{toVerilog exp}|]++-- instance Verilog Instance where+--   toVerilog (Instance name cir connects) = [st|  #{cname cir} #{name}(#{conn});|]+--     where+--       conn = T.intercalate ",\n" $ map (\((Signal fn frange _),(Signal tn trange _))-> [st|.#{fn}(#{tn}#{toVerilog trange})|]) $ connects++instance Verilog Circuit where+  toVerilog cir = [st|+module #{cname cir} (#{portlist cir});+#{iplist cir}#{oplist cir}#{inoutplist cir}+#{wirelist cir}+#{reglist cir}+#{assignlist cir}+#{alwayslist cir}+#{instlist cir}+endmodule+|]++portList :: Circuit -> [Signal]+portList cir = cinput cir ++ coutput cir++portMap :: Circuit -> M.Map T.Text Signal+portMap cir = M.fromList $ map (\sig -> (sname sig,sig)) (portList cir)++portlist :: Circuit -> T.Text+portlist cir  = T.intercalate ", " $ map sname $ portList cir++iplist :: Circuit -> T.Text+iplist cir   = T.unlines $ map (\(Signal n range _) -> [st|  input #{toVerilog range} #{n};|]) $ cinput cir++oplist :: Circuit -> T.Text+oplist cir    = T.unlines $ map (\(Signal n range _) -> [st|  output #{toVerilog range} #{n};|])$ coutput cir++inoutplist :: Circuit -> T.Text+inoutplist cir = T.unlines $ map (\(Signal n range _) -> [st|  inout #{toVerilog range} #{n};|]) $ cinout cir++reglist :: Circuit -> T.Text+reglist cir  = T.unlines $ map (\(Signal n range _) -> [st|  reg #{toVerilog range} #{n};|])   $ map alsig $ creg cir++instOutputPort :: T.Text -> Circuit -> [(Signal,Signal)]+instOutputPort name cir =+  let op  = coutput cir+      ren v = (v,v{sname=name <> "_" <> sname v})+  in map ren op++wireToVerilog :: Signal -> T.Text+wireToVerilog (Signal n range _) = [st|  wire #{toVerilog range} #{n};|]++wireSignals :: Circuit -> [Signal]+wireSignals cir =+  let assignWire = (fmap assig $ cassign cir) \\ (coutput cir)+      instWire = map snd $ concat $ map (\inst -> instOutputPort (iname inst) (icircuit inst)) (cinstance cir)+  in assignWire ++ instWire++wirelist :: Circuit -> T.Text+wirelist cir = T.intercalate "\n" $ fmap wireToVerilog $ wireSignals cir++alwayslist cir = T.unlines $ map toVerilog $ creg cir++assignlist cir = T.unlines $ map toVerilog $ cassign cir++instToVerilog :: Circuit -> Instance -> T.Text+instToVerilog cir inst = [st|  #{cname (icircuit inst)} #{name}(#{conn});|]+  where+    name = iname inst+    conn = T.intercalate ",\n" $ map (\((Signal fn frange _),(Signal tn trange _))-> [st|.#{fn}(#{tn}#{toVerilog trange})|]) $ cinstanceConnect cir M.! name++instlist :: Circuit -> T.Text+instlist cir = T.unlines $ map (\ist -> instToVerilog cir ist) $ cinstance cir
+ tests/test.hs view
@@ -0,0 +1,238 @@+{-#LANGUAGE TypeFamilies#-}+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE OverloadedStrings#-}+++import qualified Data.Text as T+import qualified Data.Map as M+import Test.Hspec hiding (shouldBe,shouldReturn)+import Test.Hspec.Expectations.Lifted+import HsVerilog+import Text.Shakespeare.Text+import Control.Monad++trimSpace' :: T.Text -> String+trimSpace' x = dropWhile (== ' ') $ trimSpace $ T.unpack x+trimSpace :: String -> String+trimSpace [] = []+trimSpace (' ':'\n':xs) = trimSpace (' ':xs)+trimSpace (' ':'\t':xs) = trimSpace (' ':xs)+trimSpace (' ':' ':xs) = trimSpace (' ':xs)+trimSpace (' ':';':xs) = trimSpace (';':xs)+trimSpace (' ':'@':xs) = trimSpace ('@':xs)+trimSpace (' ':'(':xs) = trimSpace ('(':xs)+trimSpace (' ':')':xs) = trimSpace (')':xs)+trimSpace (' ':',':xs) = trimSpace (',':xs)+trimSpace ('\t':xs) = trimSpace (' ':xs)+trimSpace ('\n':xs) = trimSpace (' ':xs)+trimSpace (x:xs) = x:trimSpace xs++(=~) :: Verilog a => a -> T.Text -> Expectation+(=~) org exp' = (trimSpace' (toVerilog org)) `shouldBe` trimSpace' exp'+infix 1 =~++dff2 :: Circuit+dff2 = circuit "dff2" $ do+  clk <- input "clk" Bit+  rstn <- input "rstn" Bit+  din <- fmap S $ input "din" Bit+  _dout <- output "dout" Bit+  reg' "dout" Bit [Posedge clk,Negedge rstn] $+    If (Not (S rstn))+      0+      din++main :: IO ()+main = hspec $ do+  describe "verilog" $ do+    it "dff and simple register" $+      dff2 =~+      [sbt|module dff2 (clk, rstn, din, dout);+          |  input clk;+          |  input rstn;+          |  input din;+          |  output dout;+          |  reg dout;+          |  always @(posedge clk or negedge rstn) begin+          |    if (!rstn)+          |      dout <= 0;+          |    else+          |      dout <= din;+          |  end+          |endmodule+          |]+    it "counter and simple register" $ do+      counter <- circuitM "counter" $ do+        clk <- input "clk" Bit+        rstn <- input "rstn" Bit+        _ <- output "dout" $ 7><0+        reg "dout" (7><0) [Posedge clk,Negedge rstn] $ \dout ->+          If (Not (S rstn)) 0 $+            If (Eq dout 7) +              0+              (dout + 1)+      counter =~ +        [sbt|module counter (clk, rstn, dout);+            |  input  clk;+            |  input  rstn;+            |  output [7:0] dout;+            |  reg [7:0] dout;+            |  always @(posedge clk or negedge rstn) begin+            |    if (!rstn)+            |      dout[7:0] <= 0;+            |    else if ((dout[7:0] == 7))+            |      dout[7:0] <= 0;+            |    else+            |      dout[7:0] <= (dout[7:0] + 1);+            |  end+            |endmodule+            |]+    it "state machine(I think this is dirty.)" $ do+      cir <- circuitM "StateMachine" $ do+        clk <- input "clk" Bit+        rstn <- input "rstn" Bit+        let idx :: String -> Exp+            idx state = (M.fromList $ zip ["init","run0","run1"] (map C [0..])) M.! state+        reg "state" (7><0) [Posedge clk,Negedge rstn] $ \state ->+          If (Not (S rstn)) (idx "init") $+          If (Eq state (idx "init")) (idx "run0") $+          If (Eq state (idx "run0")) (idx "run1") $ idx "init"+      cir =~ +        [sbt|module StateMachine (clk, rstn);+            |  input  clk;+            |  input  rstn;+            |  reg [7:0] state;+            |  always @(posedge clk or negedge rstn) begin+            |    if (!rstn)+            |      state[7:0] <= 0;+            |    else if ((state[7:0] == 0))+            |      state[7:0] <= 1;+            |    else if ((state[7:0] == 1))+            |      state[7:0] <= 2;+            |    else+            |      state[7:0] <= 0;+            |  end+            |endmodule+            |]+    it "instance" $ do+      testTop <- circuitM "Top" $ do+        clk <- input "clk" Bit+        din <- input "din" Bit+        rstn <- input "rstn" Bit+        dout <- output "dout" Bit+        i0 <- inst dff2 "dff0" [("clk",clk),+                                ("din",din),+                                ("rstn",rstn)]+        i1 <- inst dff2 "dff1" [("clk",clk),+                                ("din",i0.:"dout"),+                                ("rstn",rstn)]+        assign dout (S (i1.:"dout"))+      testTop =~ +        [sbt|module Top (clk, din, rstn, dout);+            |  input  clk;+            |  input  din;+            |  input  rstn;+            |  output  dout;+            |  wire  dff0_dout;+            |  wire  dff1_dout;+            |  assign dout = dff1_dout+            |  dff2 dff0(.clk(clk),+            |            .din(din),+            |            .rstn(rstn),+            |            .dout(dff0_dout));+            |  dff2 dff1(.clk(clk),+            |            .din(dff0_dout),+            |            .rstn(rstn),+            |            .dout(dff1_dout));+            |endmodule+            |]+    it "instance loop" $ do+      testTop <- circuitM "Top" $ do+        clk <- input "clk" Bit+        rstn <- input "rstn" Bit+        i0 <- inst dff2 "dff0" [("clk",clk),+                                ("rstn",rstn)]+        i1 <- inst dff2 "dff1" [("clk",clk),+                                ("rstn",rstn)]+        connect i0 "din" $ i1.:"dout"+        connect i1 "din" $ i0.:"dout"+      testTop =~ +        [sbt|module Top (clk, rstn);+            |  input  clk;+            |  input  rstn;+            |  wire  dff0_dout;+            |  wire  dff1_dout;+            |  dff2 dff0(.clk(clk),+            |            .rstn(rstn),+            |            .dout(dff0_dout),+            |            .din(dff1_dout));+            |  dff2 dff1(.clk(clk),+            |            .rstn(rstn),+            |            .dout(dff1_dout),+            |            .din(dff0_dout));+            |endmodule+            |]+    it "assign" $ do+      cir <- circuitM "mulAdd" $ do+        din0 <- fmap S $ input "din0" Bit+        din1 <- fmap S $ input "din1" Bit+        din2 <- fmap S $ input "din2" Bit+        dout <- output "dout" Bit+        assign dout $ (din0 * din1) + din2+      cir =~+        [sbt|module mulAdd (din0, din1, din2, dout);+            |  input  din0;+            |  input  din1;+            |  input  din2;+            |  output dout;+            |  assign dout = ((din0 * din1) + din2)+            |endmodule+            |]+    it "range" $ do+      cir <- circuitM "mulAdd" $ do+        din0 <- fmap S $ input "din0" $ 7><0+        din1 <- fmap S $ input "din1" $ 7><0+        din2 <- fmap S $ input "din2" $ 7><0+        dout <- output "dout" $ 7><0+        assign dout $ din0 * din1 + din2+      cir =~+        [sbt|module mulAdd (din0, din1, din2, dout);+            |  input [7:0] din0;+            |  input [7:0] din1;+            |  input [7:0] din2;+            |  output [7:0] dout;+            |  assign dout[7:0] = ((din0[7:0] * din1[7:0]) + din2[7:0])+            |endmodule+            |]+  describe "simulation: Exp" $ do+  --   it "Add" $ do+  --      val (initCircuit "hoge") (2 + 1) `shouldBe` 3+  --   it "Mul" $+  --      val (initCircuit "hoge") (2 * 2) `shouldBe` 4+    it "count up" $ do+      print "123"+      counter <- circuitM "counter" $ do+        clk <- input "clk" Bit+        rstn <- input "rstn" Bit+        _ <- output "dout" $ 7><0+        reg "dout" (7><0) [Posedge clk,Negedge rstn] $ \dout ->+          If (Not (S rstn)) 0 $+            If (Eq dout 7) +              0+              (dout + 1)+      simM counter $ do+        readInput "rstn" `shouldReturn` 0+        "rstn" <== 1+        readInput "rstn" `shouldReturn` 1+        readReg "dout" `shouldReturn` 0+        updateReg+        readReg "dout" `shouldReturn` 1+        updateReg+        readReg "dout" `shouldReturn` 2+        updateReg+        readReg "dout" `shouldReturn` 3+        updateReg+        readReg "dout" `shouldReturn` 4+        print'+      return ()