module HsVerilog.Verilog.Internal where
import Text.Shakespeare.Text
import Prelude hiding (exp)
import HsVerilog.Type
import qualified Data.Text as T
import Data.Monoid
import Data.List
import qualified Data.Map as M
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 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