--------------------------------------------------------------------------------
-- |
-- Module       :  Language.Netlist.Util
-- Copyright    :  (c) Signali Corp. 2010
-- License      :  All rights reserved
--
-- Maintainer   : pweaver@signalicorp.com
-- Stability    : experimental
-- Portability  : non-portable
--
-- Utility functions for constructing Netlist AST elements.
--------------------------------------------------------------------------------

module Language.Netlist.Util where

import Language.Netlist.AST

-- -----------------------------------------------------------------------------

data Direction = Up | Down

unsizedInteger :: Integer -> Expr
unsizedInteger :: Integer -> Expr
unsizedInteger = Integer -> Expr
forall a. Integral a => a -> Expr
unsizedIntegral

unsizedIntegral :: Integral a => a -> Expr
unsizedIntegral :: forall a. Integral a => a -> Expr
unsizedIntegral = Maybe Size -> ExprLit -> Expr
ExprLit Maybe Size
forall a. Maybe a
Nothing (ExprLit -> Expr) -> (a -> ExprLit) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ExprLit
ExprNum (Integer -> ExprLit) -> (a -> Integer) -> a -> ExprLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger

sizedInteger :: Int -> Integer -> Expr
sizedInteger :: Size -> Integer -> Expr
sizedInteger = Size -> Integer -> Expr
forall a. Integral a => Size -> a -> Expr
sizedIntegral

sizedIntegral :: Integral a => Int -> a -> Expr
sizedIntegral :: forall a. Integral a => Size -> a -> Expr
sizedIntegral Size
sz = Maybe Size -> ExprLit -> Expr
ExprLit (Size -> Maybe Size
forall a. a -> Maybe a
Just Size
sz) (ExprLit -> Expr) -> (a -> ExprLit) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ExprLit
ExprNum (Integer -> ExprLit) -> (a -> Integer) -> a -> ExprLit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger

-- | Given a direction and size, maybe generate a 'Range', where a size of 1
-- yields 'Nothing'.
makeRange :: Direction -> Size -> Maybe Range
makeRange :: Direction -> Size -> Maybe Range
makeRange Direction
_ Size
1 = Maybe Range
forall a. Maybe a
Nothing
makeRange Direction
d Size
sz
  | Size
sz Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
1
  = let upper :: Expr
upper = Size -> Expr
forall a. Integral a => a -> Expr
unsizedIntegral (Size
sz Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1)
        lower :: Expr
lower = Integer -> Expr
unsizedInteger Integer
0
    in Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ case Direction
d of
                Direction
Up    -> Expr -> Expr -> Range
Range Expr
lower Expr
upper
                Direction
Down  -> Expr -> Expr -> Range
Range Expr
upper Expr
lower

  | Bool
otherwise
  = [Char] -> Maybe Range
forall a. HasCallStack => [Char] -> a
error ([Char]
"makeRange: invalid size: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Size -> [Char]
forall a. Show a => a -> [Char]
show Size
sz)

-- | Concatenate a list of expressions, unless there is just one expression.
exprConcat :: [Expr] -> Expr
exprConcat :: [Expr] -> Expr
exprConcat [Expr
e] = Expr
e
exprConcat [Expr]
es  = [Expr] -> Expr
ExprConcat [Expr]
es

-- | Make a 'Seq' statement from a list of statements, unless there is just one
-- statement.
statements :: [Stmt] -> Stmt
statements :: [Stmt] -> Stmt
statements [Stmt
x] = Stmt
x
statements [Stmt]
xs  = [Stmt] -> Stmt
Seq [Stmt]
xs

-- -----------------------------------------------------------------------------

-- | generate a process declaration for a generic register based on the following:
--
--  * the register name (as an expression)
--
--  * clock expression
--
--  * width of the register
--
--  * optional asynchronous reset and initial value
--
--  * optional clock enable
--
--  * optional synchronous restart and initial value
--
--  * optional load enable
--
--  * when enabled, the expression to assign to the identifier
--
-- You can implement a shift register by passing in a concatenation for the
-- register expression and the input expression, though that is not compatible
-- with VHDL.
--

-- TODO
--  * support negative-edge triggered clock/reset, active-low reset/restart
--  * support true clock enable (as opposed to load enable)?

generateReg :: Expr -> Expr -> Maybe (Expr, Expr) -> Maybe (Expr, Expr) ->
               Maybe Expr -> Expr -> Decl
generateReg :: Expr
-> Expr
-> Maybe (Expr, Expr)
-> Maybe (Expr, Expr)
-> Maybe Expr
-> Expr
-> Decl
generateReg Expr
x Expr
clk Maybe (Expr, Expr)
mb_reset Maybe (Expr, Expr)
mb_restart Maybe Expr
mb_enable Expr
expr
  = Event -> Maybe (Event, Stmt) -> Stmt -> Decl
ProcessDecl (Expr -> Edge -> Event
Event Expr
clk Edge
PosEdge) Maybe (Event, Stmt)
mb_reset' Stmt
stmt2
  where
    mb_reset' :: Maybe (Event, Stmt)
mb_reset' = case Maybe (Expr, Expr)
mb_reset of
                  Just (Expr
reset, Expr
initial) -> (Event, Stmt) -> Maybe (Event, Stmt)
forall a. a -> Maybe a
Just (Expr -> Edge -> Event
Event Expr
reset Edge
PosEdge, Expr -> Expr -> Stmt
Assign Expr
x Expr
initial)
                  Maybe (Expr, Expr)
Nothing               -> Maybe (Event, Stmt)
forall a. Maybe a
Nothing

    stmt2 :: Stmt
stmt2 = case Maybe (Expr, Expr)
mb_restart of
              Just (Expr
restart, Expr
initial)
                -> Expr -> Stmt -> Maybe Stmt -> Stmt
If Expr
restart (Expr -> Expr -> Stmt
Assign Expr
x Expr
initial) (Stmt -> Maybe Stmt
forall a. a -> Maybe a
Just Stmt
stmt1)
              Maybe (Expr, Expr)
Nothing
                -> Stmt
stmt1

    stmt1 :: Stmt
stmt1 = case Maybe Expr
mb_enable of
              Just Expr
enable  -> Expr -> Stmt -> Maybe Stmt -> Stmt
If Expr
enable Stmt
stmt0 Maybe Stmt
forall a. Maybe a
Nothing
              Maybe Expr
Nothing      -> Stmt
stmt0

    stmt0 :: Stmt
stmt0 = Expr -> Expr -> Stmt
Assign Expr
x Expr
expr

-- -----------------------------------------------------------------------------